diff --git a/R/remove.R b/R/remove.R index f5224bd..dea0708 100644 --- a/R/remove.R +++ b/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)) } diff --git a/man/remove_lines.Rd b/man/remove_lines.Rd index d1b1cd2..cca649a 100644 --- a/man/remove_lines.Rd +++ b/man/remove_lines.Rd @@ -4,30 +4,13 @@ \alias{remove_lines} \title{Remove line(s) and/or block(s) in a libbi model} \usage{ -remove_lines( - x, - what, - only, - type = c("all", "assignment", "sample"), - preserve_shell = FALSE -) +remove_lines(x, what) } \arguments{ \item{x}{a \code{\link{stanedit}} object} \item{what}{either a vector of line number(s) to remove, or a vector of blocks to remove (e.g., "parameters")} - -\item{only}{only remove lines assigning given names (as a vector of character -strings)} - -\item{type}{which types of lines to remove, either "all", "sample" (i.e., -lines with a "~") or "assignment" (lines with a "=") (default: -"all")} - -\item{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} } \value{ the updated \code{stanedit} object @@ -38,7 +21,7 @@ Removes one or more lines in a libbi model. \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") } \seealso{ \code{\link{stanedit}} diff --git a/tests/testthat/test-model-edits.R b/tests/testthat/test-model-edits.R index ea19cf1..9adc871 100644 --- a/tests/testthat/test-model-edits.R +++ b/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) })