simplify

R/remove.R

@@ -5,70 +5,35 @@
 #' @param x a \code{\link{stanedit}} object
 #' @param what either a vector of line number(s) to remove, or a vector of
 #'   blocks to remove (e.g., "parameters")
-#' @param only only remove lines assigning given names (as a vector of character
-#'   strings)
-#' @param type which types of lines to remove, either "all", "sample" (i.e.,
-#'   lines with a "~") or "assignment" (lines with a "=") (default:
-#'   "all")
-#' @param preserve_shell if TRUE (default: FALSE), preserve the definition of a
-#'   block even if all lines are removed; this is useful to preserve options
-#'   passed to a \code{transition} or \code{ode} block
 #' @return the updated \code{stanedit} object
-#' @importFrom checkmate assert_class
+#' @importFrom checkmate assert_class assert_character assert check_count
+#'   check_character assert_logical
 #' @seealso \code{\link{stanedit}}
 #' @examples
 #' model_file_name <- system.file(package = "stanedit", "regression.stan")
 #' reg <- stanedit(filename = model_file_name)
-#' reg <- remove_lines(reg, "model", only = "y", type = "sample")
+#' reg <- remove_lines(reg, "model")
 #' @export
-remove_lines <- function(x, what, only, type = c("all", "assignment", "sample"),
-                         preserve_shell = FALSE) {
+remove_lines <- function(x, what) {
   assert_class(x, "stanedit")
-  if (missing(what)) {
-    stop("'what' must be given")
-  }
-  type <- match.arg(type)
+  assert(
+    check_count(what, positive = TRUE),
+    check_character(what)
+  )
+
   to_remove <- c()
   if (is.numeric(what)) {
     to_remove <- what
-  } else if (is.character(what)) {
-    to_remove <- find_block(x, what, inner = preserve_shell)
   } else {
-    stop("'what' must be a numeric or character vector.")
-  }
-
-  operators <- list(assignment = "=", sample = "~")
-
-  ## check if we don't want to remove everything
-  if (length(to_remove) > 0 && (type != "all" || !missing(only))) {
-    if (type == "all") {
-      op_types <- unlist(operators)
-    } else {
-      op_types <- operators[[type]]
-    }
-    pattern <- paste0(
-      "^([A-Za-z_0-9[\\]][[:space:]A-Za-z_0-9,[\\]]*)",
-      "(", paste(op_types, collapse = "|"), ")"
-    )
-    assign_lines <- grep(pattern, x[to_remove], perl = TRUE)
-    assign_vars <- sub(paste0(pattern, ".*$"), "\\1",
-      x[to_remove][assign_lines],
-      perl = TRUE
-    )
-    assign_vars <- sub("[[:space:]]", "", sub("\\[.*]", "", assign_vars))
-    if (!missing(only)) {
-      assign_lines <- assign_lines[assign_vars %in% only]
-    }
-    if (is.character(what) && !preserve_shell &&
-      length(assign_lines) == length(to_remove) - 2) {
-      assign_lines <- c(1, assign_lines, length(to_remove))
-    }
-    to_remove <- to_remove[assign_lines]
+    to_remove <- find_block(x, what)
   }
 
-  if (length(to_remove) > 0) {
+  if (length(to_remove) == 0) {
+    warning("Nothing to remove.")
+    return(x)
+  } else {
     x <- x[-to_remove]
+    return(clean_model(x))
   }
 
-  return(clean_model(x))
 }

tests/testthat/test-model-edits.R

@@ -45,14 +45,8 @@ test_that("lines can be inserted", {
 })
 
 test_that("lines can be removed", {
-  reg2 <- remove_lines(reg, "model", only = "y", type = "sample")
-  reg3 <- remove_lines(
-    reg, "model", only = "y", type = "sample", preserve_shell = TRUE
-  )
-  reg4 <- remove_lines(reg, "model", only = "y", type = "assignment")
-  expect_length(get_block(reg2, "model"), 0)
-  expect_length(get_block(reg3, "model", shell = TRUE), 2)
-  expect_equal(reg4, reg)
+  reg2 <- remove_lines(reg, 2)
+  expect_length(get_block(reg2, "data"), 2)
 })