# This handles the errors for simulations
.createSimLineObject <- function(x, line) {
  .predDf <- get("predDf", x)
  if (line > nrow(.predDf)) {
    return(NULL)
  }
  .predLine <- .predDf[line, ]
  .ret <- list(x, .predLine, line)
  class(.ret) <- c(paste(.predLine$distribution), "rxGetDistributionSimulationLines")
  .ret
}

#' This is a S3 method for getting the distribution lines for a rxode2 simulation
#'
#' @param line Parsed rxode2 model environment
#' @return Lines for the simulation of `ipred` and `dv`. This is based
#'   on the idea that the focei parameters are defined
#' @author Matthew Fidler
#' @keywords internal
#' @export
rxGetDistributionSimulationLines <- function(line) {
  UseMethod("rxGetDistributionSimulationLines")
}

.simulationFun <- list(
  "t"="rt",
  "pois"="rpois",
  "binom"="rbinom",
  "beta"="rbeta",
  "chisq"="rchisq",
  "dexp"="rexp",
  "f"="rf",
  "geom"="rgeom",
  "hyper"="rhyper",
  "unif"="runif",
  "weibull"="rweibull",
  "cauchy"="rcauchy",
  "dgamma"="rgamma",
  "ordinal"="rordinal",
  "nbinom"="rnbinom",
  "nbinomMu"="rnbinomMu"
)

.getQuotedDistributionAndSimulationArgs <- function(line) {
  env <- line[[1]]
  pred1 <- line[[2]]
  .dist <- as.character(pred1$distribution)
  if (.dist == "LL") {
    return(env$lstExpr[[pred1$line]][[3]])
  }
  .nargs <- max(.errDist[[.dist]])
  .cnd <- pred1$cond
  .argName <- .namedArgumentsToPredDf[[.dist]]
  .args <- vapply(seq(1:.nargs), function(.i) {
    .curDist <- .argName[.i]
    if (!is.na(pred1[[.curDist]])) {
      return(pred1[[.curDist]])
    } else {
      .curDist <- paste0(.dist, ifelse(.i == 1, "", .i))
      .w <- which(env$iniDf$err == .curDist & env$iniDf$condition == .cnd)
      if (length(.w) == 1) {
        return(env$iniDf$name[.w])
      } else {
        return("")
      }
    }
  }, character(1))

  as.call(lapply(c(.simulationFun[[.dist]], .args[.args != ""]), str2lang))
}

#' Get the ar() correlation as a quoted expression for an endpoint
#'
#' @param env parsed model environment
#' @param pred1 single predDf row
#' @return quoted correlation (parameter name, or the modeled correlation
#'   variable), or NULL when the endpoint has no ar() term
#' @author Matthew Fidler
#' @noRd
.rxGetArCorLang <- function(env, pred1) {
  # ar() correlations backed by a parameter live in the $iniDf with err == "ar"
  # (a literal ar(0.5) is parsed into an auto-generated FIX parameter, an
  # estimated ar(rho) keeps its name); there is no dedicated $predDf column
  .w <- which(env$iniDf$err == "ar" & env$iniDf$condition == pred1$cond)
  if (length(.w) == 1L) return(str2lang(env$iniDf$name[.w]))
  # otherwise the correlation is a modeled (calculated) variable, e.g.
  # `corv <- expit(tcor); cp ~ add(add.sd) + ar(corv)` -- recover it directly
  # from the endpoint's original error expression
  .rxFindArArg(env, pred1$cond)
}

#' Find the `ar()` argument in an endpoint's error expression
#'
#' Scans the model's stored expressions (`env$lstExpr`) for the `~` error line
#' whose left-hand side matches the endpoint `cond` and returns the (quoted)
#' argument of its `ar()` term, if any.  Used to resolve modeled `ar()`
#' correlations, which are not stored in `$iniDf`/`$predDf`.
#'
#' @param env parsed model environment (must carry `lstExpr`)
#' @param cond endpoint condition (the error expression's left-hand side)
#' @return the quoted `ar()` argument, or NULL when not found
#' @author Matthew L. Fidler
#' @noRd
.rxFindArArg <- function(env, cond) {
  .lst <- tryCatch(get("lstExpr", envir=env), error=function(e) NULL)
  if (is.null(.lst)) return(NULL)
  .findAr <- function(e) {
    if (is.call(e)) {
      if (identical(e[[1]], quote(ar)) && length(e) == 2L) return(e[[2]])
      for (.i in seq_along(e)) {
        .r <- .findAr(e[[.i]])
        if (!is.null(.r)) return(.r)
      }
    }
    NULL
  }
  for (.e in .lst) {
    if (is.call(.e) && identical(.e[[1]], quote(`~`)) && length(.e) == 3L) {
      .lhs <- .e[[2]]
      # strip conditioning (lhs | cond) down to the endpoint variable
      if (is.call(.lhs) && identical(.lhs[[1]], quote(`|`))) .lhs <- .lhs[[2]]
      # unwrap ll(x)/linCmt() the same way .errHandleLlOrLinCmt() sets the
      # endpoint condition, so ll(cp) ~ ... + ar(corv) still matches cond
      if (is.call(.lhs)) {
        if (identical(.lhs[[1]], quote(`ll`)) && length(.lhs) == 2L) {
          .lhs <- .lhs[[2]]
        } else if (identical(.lhs[[1]], quote(`linCmt`))) {
          .lhs <- quote(`rxLinCmt`)
        }
      }
      if (identical(deparse1(.lhs), as.character(cond))) {
        .arg <- .findAr(.e[[3]])
        if (!is.null(.arg)) return(.arg)
      }
    }
  }
  NULL
}

#' Build the continuous-time AR(1) simulation lines for an endpoint
#'
#' Implements a stationary continuous-time AR(1) (Ornstein-Uhlenbeck)
#' process on the residual: the innovation is the endpoint's usual unit
#' draw, scaled so the marginal variance stays rx_r_ for any correlation.
#' The lag-1 correlation decays as cor^(time difference).  State is carried
#' across observation records with the same lag()/lag0() form the estimation
#' likelihood uses: rx.arT.<var> carries the previous time, lag0() reads the
#' previous residual for the self-referential recurrence, and
#' `1 - is.na(lag(...))` is the NaN-safe first-record indicator (0 on the first
#' record so phi=0 -> the marginal draw, 1 after).
#'
#' @param cor quoted correlation (name or number)
#' @param var endpoint variable suffix (e.g. "cp")
#' @param innovation quoted unit residual draw (rxerr.<var> or an r*() call)
#' @return list of quoted model lines; the final residual is left in
#'   rx.arRes.<var> and the sim line back-transforms rx_pred_ + that residual
#' @author Matthew Fidler
#' @noRd
.rxArSimLines <- function(cor, var, innovation) {
  .res <- str2lang(paste0("rx.arRes.", var))
  .t <- str2lang(paste0("rx.arT.", var))
  .dt <- str2lang(paste0("rx.arDt.", var))
  .nf <- str2lang(paste0("rx.arNf.", var))
  .phi <- str2lang(paste0("rx.arPhi.", var))
  list(
    bquote(.(.t) <- time),
    bquote(.(.dt) <- time - lag0(.(.t), 1)),
    bquote(.(.nf) <- 1 - is.na(lag(.(.t), 1))),
    bquote(.(.phi) <- .(.nf) * .(cor)^.(.dt)),
    bquote(.(.res) <- .(.phi) * lag0(.(.res), 1) +
             sqrt(rx_r_ * (1 - .(.phi)^2)) * .(innovation)),
    bquote(sim <- rxTBSi(rx_pred_ + .(.res), rx_lambda_, rx_yj_, rx_low_, rx_hi_)))
}

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.norm <- function(line) {
  env <- line[[1]]
  pred1 <- line[[2]]
  .errNum <- line[[3]]
  .err <- str2lang(paste0("rxerr.", pred1$var))
  .arCor <- .rxGetArCorLang(env, pred1)
  if (is.null(.arCor)) {
    .ret <- vector("list", 2)
    .ret[[1]] <- bquote(ipredSim <- rxTBSi(rx_pred_, rx_lambda_, rx_yj_, rx_low_, rx_hi_))
    .ret[[2]] <- bquote(sim <- rxTBSi(rx_pred_+sqrt(rx_r_) * .(.err), rx_lambda_, rx_yj_, rx_low_, rx_hi_))
  } else {
    .ret <- c(list(bquote(ipredSim <- rxTBSi(rx_pred_, rx_lambda_, rx_yj_, rx_low_, rx_hi_))),
              .rxArSimLines(.arCor, pred1$var, .err))
  }
  c(.handleSingleErrTypeNormOrTFoceiBase(env, pred1, .errNum, rxPredLlik=FALSE), .ret)
}

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.dnorm <- rxGetDistributionSimulationLines.norm

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.t <- function(line) {
  env <- line[[1]]
  pred1 <- line[[2]]
  .errNum <- line[[3]]
  .draw <- .getQuotedDistributionAndSimulationArgs(line)
  .arCor <- .rxGetArCorLang(env, pred1)
  if (is.null(.arCor)) {
    .ret <- vector("list", 2)
    .ret[[1]] <- bquote(ipredSim <- rxTBSi(rx_pred_, rx_lambda_, rx_yj_, rx_low_, rx_hi_))
    .ret[[2]] <- bquote(sim <- rxTBSi(rx_pred_+sqrt(rx_r_) * .(.draw), rx_lambda_, rx_yj_, rx_low_, rx_hi_))
  } else {
    .ret <- c(list(bquote(ipredSim <- rxTBSi(rx_pred_, rx_lambda_, rx_yj_, rx_low_, rx_hi_))),
              .rxArSimLines(.arCor, pred1$var, .draw))
  }
  c(.handleSingleErrTypeNormOrTFoceiBase(env, pred1, .errNum, rxPredLlik=FALSE), .ret)
}

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.cauchy <- function(line) {
  env <- line[[1]]
  pred1 <- line[[2]]
  .errNum <- line[[3]]
  .draw <- .getQuotedDistributionAndSimulationArgs(line)
  .arCor <- .rxGetArCorLang(env, pred1)
  if (is.null(.arCor)) {
    .ret <- vector("list", 2)
    .ret[[1]] <- bquote(ipredSim <- rxTBSi(rx_pred_, rx_lambda_, rx_yj_, rx_low_, rx_hi_))
    .ret[[2]] <- bquote(sim <- rxTBSi(rx_pred_+sqrt(rx_r_) * .(.draw), rx_lambda_, rx_yj_, rx_low_, rx_hi_))
  } else {
    .ret <- c(list(bquote(ipredSim <- rxTBSi(rx_pred_, rx_lambda_, rx_yj_, rx_low_, rx_hi_))),
              .rxArSimLines(.arCor, pred1$var, .draw))
  }
  c(.handleSingleErrTypeNormOrTFoceiBase(env, pred1, .errNum, rxPredLlik=FALSE), .ret)
}

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.ordinal <- function(line) {
  .env <- line[[1]]
  .pred1 <- line[[2]]
  .errNum <- line[[3]]
  .c <- .env$lstExpr[[.pred1$line[1]]][[3]]
  .ce <- try(eval(.c), silent=TRUE)
  if (inherits(.ce, "try-error")) {
  } else if (inherits(.ce, "numeric") &&
               !is.null(names(.ce))) {
    .n <- names(.ce)
    .ln <- length(.n)
    if (.n[.ln] != "") {
      stop("last element in ordinal simulation of c(p1=0, p2=0.5, ...) must be a number, not a named number",
           call.=FALSE)
    }
    .n <- .n[.n != ""]
    if (length(.n) != .ln - 1) {
      stop("names for ordinal simulation incorrect")
    }
    .ret <- vector("list", 3)
    .ret[[1]] <- quote(ipredSim <- NA)
    .ret[[2]] <- str2lang(paste0("rx_sim_~rxord(", paste(.n, collapse=", "), ")"))
    .ce <- setNames(.ce, NULL)

    .ret[[3]] <- str2lang(paste0("sim<-", paste(vapply(seq_along(.ce), function(i) {
      paste("(rx_sim_ == ", i, ")*", .ce[i])
   }, character(1), USE.NAMES=FALSE), collapse="+")))
    return(.ret)
  }
  .c[[1]] <- quote(`rxord`)
  .ret <- vector("list", 2)
  .ret[[1]] <- quote(ipredSim <- NA)
  .ret[[2]] <- bquote(sim <- .(.c))
  .ret
}

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.default <- function(line) {
  env <- line[[1]]
  pred1 <- line[[2]]
  .errNum <- line[[3]]
  .ret <- vector("list", 1)
  .ret[[1]] <- bquote(sim <- .(.getQuotedDistributionAndSimulationArgs(line)))
  c(.handleSingleErrTypeNormOrTFoceiBase(env, pred1, .errNum, rxPredLlik=FALSE), .ret)
}

#' @rdname rxGetDistributionSimulationLines
#' @export
rxGetDistributionSimulationLines.rxUi <- function(line) {
  .predDf <- get("predDf", line)
  lapply(seq_along(.predDf$cond), function(c) {
    .mod <- .createSimLineObject(line, c)
    rxGetDistributionSimulationLines(.mod)
  })
}

#' @export
#' @rdname rxUiGet
rxUiGet.cmtLines <- function(x, ...) {
  .x <- x[[1]]
  .len <- length(.x$mv0$state)
  .predDf <- get("predDf", .x)
  lapply(.predDf[.predDf$cmt > .len, "cond"], function(cmt) {
    call("cmt", str2lang(cmt))
  })
}
attr(rxUiGet.cmtLines, "desc") <- "cmt lines for model"

#' @export
#' @rdname rxUiGet
rxUiGet.dvidLine <- function(x, ...) {
  .x <- x[[1]]
  as.call(c(list(quote(`dvid`)), as.numeric(.x$predDf$cmt)))
}
attr(rxUiGet.dvidLine, "desc") <- "dvid() line for model"
attr(rxUiGet.dvidLine, "rstudio") <- quote(dvid(1, 2, 3)) # for rstudio completion

#' @export
#' @rdname rxUiGet
rxUiGet.paramsLine <- function(x, ...) {
  .x <- x[[1]]
  .iniDf <- .x$iniDf
  .params <- c(.iniDf[is.na(.iniDf$neta1) | .iniDf$neta1 == .iniDf$neta2, "name"],
               .x$covariates)
  eval(parse(text=paste0("quote(params(", paste(.params, collapse=", "), "))")))
}
attr(rxUiGet.paramsLine, "desc") <- "params() line for model"
attr(rxUiGet.paramsLine, "rstudio") <- quote(params(ID, CL, V, KA)) # for rstudio completion

#' @export
#' @rdname rxUiGet
rxUiGet.interpLines <- function(x, ...){
  .ui <- x[[1]]
  .interp <- rxModelVars(.ui)$interp
  if (!is.factor(.interp) ||
        length(.interp) == 0) {
    return(NULL)
  }
  .lvl <- levels(.interp)
  if (length(.lvl) != 5L ||
        !identical(.lvl, c("default", "linear", "locf", "nocb", "midpoint"))) {
    return(NULL)
  }
  if (any(is.na(.interp))) {
    return(NULL)
  }
  .try <- try(all(.interp == "default"), silent=TRUE)
  if (inherits(.try, "try-error") ||
        !checkmate::testLogical(.try, any.missing=FALSE, len=1)) {
    return(NULL)
  }
  if (.try) {
    # use default
    return(NULL)
  }
  .ret <- list()
  .w <- which(.interp=="linear")
  if (length(.w) > 0) {
    .ret <- list(str2lang(paste("linear(",paste(names(.interp)[.w], collapse=", "), ")")))
  }
  .w <- which(.interp=="locf")
  if (length(.w) > 0) {
    .ret <- c(.ret, list(str2lang(paste("locf(",paste(names(.interp)[.w], collapse=", "), ")"))))
  }
  .w <- which(.interp=="nocb")
  if (length(.w) > 0) {
    .ret <- c(.ret, list(str2lang(paste("nocb(",paste(names(.interp)[.w], collapse=", "), ")"))))
  }
  .w <- which(.interp=="midpoint")
  if (length(.w) > 0) {
    .ret <- c(.ret, list(str2lang(paste("midpoint(",paste(names(.interp)[.w], collapse=", "), ")"))))
  }
  if (length(.ret) == 0) {
    return(NULL) #nocov
  }
  .ret
}
attr(rxUiGet.interpLines, "desc") <- "interpolation declaration line(s) for model"
attr(rxUiGet.interpLines, "rstudio") <- quote(linear(CP)) # for rstudio completion

#' @rdname rxUiGet
#' @export
rxUiGet.splitDose <- function(x, ...) {
  .ui <- x[[1]]
  .splitBolus <- rxModelVars(.ui)$splitBolus
  if (length(.splitBolus) < 2L) {
    return(NULL)
  }
  .state <- rxModelVars(.ui)$state
  if (length(.state) == 0L ||
        any(.splitBolus < 1L | .splitBolus > length(.state))) {
    return(NULL)
  }
  list(as.call(c(list(quote(`splitBolus`)),
                 lapply(.state[.splitBolus], as.name))))
}
attr(rxUiGet.splitDose, "desc") <- "split dose declaration line(s) for model"
attr(rxUiGet.splitDose, "rstudio") <- quote(splitBolus(depot, central))

#' @rdname rxUiGet
#' @export
rxUiGet.splitDoseLines <- rxUiGet.splitDose
attr(rxUiGet.splitDoseLines, "desc") <- attr(rxUiGet.splitDose, "desc")
attr(rxUiGet.splitDoseLines, "rstudio") <- attr(rxUiGet.splitDose, "rstudio")

#' @export
#' @rdname rxUiGet
rxUiGet.simulationSigma <- function(x, ...) {
  .x <- x[[1]]
  .exact <- x[[2]]
  .predDf <- get("predDf", .x)
  .sigmaNames <- vapply(seq_along(.predDf$var), function(i) {
    if (.predDf$distribution[i] %in% c("dnorm",  "norm")) {
      paste0("rxerr.", .predDf$var[i])
    } else {
      ""
    }
  }, character(1))
  .sigmaNames <- .sigmaNames[.sigmaNames != ""]
  .sigma <- diag(length(.sigmaNames))
  dimnames(.sigma) <- list(.sigmaNames, .sigmaNames)
  .sigma
}
attr(rxUiGet.simulationSigma, "desc") <- "simulation sigma"
attr(rxUiGet.simulationSigma, "rstudio") <- lotri::lotri(a+b ~ c(1, .1, 1))

.simulationModelAssignTOS <- function(ui, ret) {
  assign("theta", ui$theta, envir=ret)
  assign("omega", ui$omega, envir=ret)
  assign("simulationSigma", ui$simulationSigma, envir=ret)
  assign("uiFun", as.function(ui), envir=ret)
  class(ret) <- c("rxode2tos", "rxode2")
  ret
}

#' @export
#' @rdname rxUiGet
rxUiGet.simulationModel <- function(x, ...) {
  .x <- x[[1]]
  ## meta is a reference-type environment shared across all rxUiDecompress
  ## calls for the same model, so it is the right place for per-model caches.
  ## All cached values are invalidated automatically when the model is modified
  ## via piping/.copyUi(), because those operations create a new meta env.
  .meta <- .x$meta
  .cached <- .meta$.simModelBase
  if (!is.null(.cached)) {
    return(.cached)
  }
  ## Cold path: build the compiled simulation model and cache the full TOS.
  ## theta/omega/simulationSigma/uiFun are derived from the rxUi which is
  ## immutable until the next piping step, so they are safe to cache.
  .cached <- eval(getBaseSimModel(.x))
  assign("theta",           .x$theta,           envir=.cached)
  assign("omega",           .x$omega,           envir=.cached)
  assign("simulationSigma", .x$simulationSigma, envir=.cached)
  assign("uiFun",           as.function(.x),    envir=.cached)
  class(.cached) <- c("rxode2tos", "rxode2")
  .meta$.simModelBase <- .cached
  .cached
}
attr(rxUiGet.simulationModel, "desc") <- "simulation model from UI"
attr(rxUiGet.simulationModel, "rstudio") <- quote(rxode2()) # for rstudio completion

#' @export
#' @rdname rxUiGet
rxUiGet.symengineModelNoPrune <- function(x, ...) {
  # For rstudio completion we need to do something else here
  .x <- x[[1]]
  .exact <- x[[2]]
  .simulationModelAssignTOS(.x, eval(getBaseSymengineModel(.x)))
}
attr(rxUiGet.symengineModelNoPrune, "desc") <- "symengine model without pruning if/else from UI"
attr(rxUiGet.symengineModelNoPrune, "rstudio") <- quote(rxode2()) # for rstudio completion

#' @export
#' @rdname rxUiGet
rxUiGet.symengineModelPrune <- function(x, ...) {
  .x <- x[[1]]
  .tmp <- getBaseSymengineModel(.x)
  .tmp[[1]] <- quote(`rxModelVars`)
  .tmp <- eval(.tmp)
  .tmp <- rxode2(rxPrune(.tmp))
  .simulationModelAssignTOS(.x, .tmp)
}
attr(rxUiGet.symengineModelPrune, "desc") <- "symengine model with pruning if/else from UI"
attr(rxUiGet.symengineModelPrune, "rstudio") <- quote(rxode2()) # for rstudio completion

#' @export
#' @rdname rxUiGet
rxUiGet.simulationIniModel <- function(x, ...) {
  .x <- x[[1]]
  .exact <- x[[2]]
  .simulationModelAssignTOS(.x, eval(getBaseIniSimModel(.x)))
}
attr(rxUiGet.simulationIniModel, "desc") <- "simulation model with the ini values prepended (from UI)"
attr(rxUiGet.simulationIniModel, "rstudio") <- quote(rxode2()) # for rstudio completion

.rxModelNoErrorLines <- function(uiModel, prefixLines=NULL, paramsLine=NULL,
                                 modelVars=FALSE, cmtLines=TRUE,
                                 lstExpr=NULL) {
  if (is.null(lstExpr)) {
    .expr <- uiModel$lstExpr
  } else {
    .expr <- lstExpr
  }
  .cmtLines <- NULL
  if (cmtLines) {
    .cmtLines <- uiModel$cmtLines
  }

  .lenLines <- length(uiModel$lstExpr) + length(.cmtLines) + length(prefixLines)

  .k <- 2

  if (is.null(paramsLine)) {
  } else if (is.na(paramsLine)) {
    .lenLines <- .lenLines - 1
  }
  .ret <- vector("list", .lenLines + .k)
  .curErrLine <- 1
  .ret[[1]] <- quote(`{`)
  .k <- 3
  if (is.null(paramsLine)) {
    .ret[[2]] <- uiModel$paramsLine
  } else if (is.na(paramsLine)) {
    .k <- 2
  } else {
    .ret[[2]] <- paramsLine
  }
  for (.i in seq_along(prefixLines)) {
    .ret[[.k]] <- prefixLines[[.i]]
    .k <- .k + 1
  }
  for (.i in seq_along(.expr)) {
    .ret[[.k]] <- .expr[[.i]]
    .k <- .k + 1
  }
  for(.i in seq_along(.cmtLines)) {
    .ret[[.k]] <- .cmtLines[[.i]]
    .k <- .k + 1
  }
  if (modelVars) {
    as.call(list(quote(`rxModelVars`), as.call(.ret)))
  } else {
    as.call(list(quote(`rxode2`), as.call(.ret)))
  }
}
#' Filter out properties and adjust predDf
#'
#' @param predDf predDf from the ui model
#' @param lstExpr list of expressions for model or NULL, if NULL
#'   defaults to the model expressions accessible by ui$lstExpr
#' @param ui original ui model or NULL
#' @return a list containing the adjusted predDf and lstExpr, or if
#'   predDf is null simply the lstExpr
#' @noRd
#' @author Matthew L. Fidler
.rxFilterOutPropsAndAdjustPredDf <- function(ui, lstExpr, predDf=NULL) {
  if (is.null(lstExpr)) {
    .expr <- ui$lstExpr
  } else {
    .expr <- lstExpr
  }
  ## remove directive lines from .expr; these are re-added in a
  ## normalized position for simulation models.
  .f <- vapply(seq_along(.expr), function(i) {
    .e <- .expr[[i]]
    if (is.call(.e)) {
      identical(.e[[1]], quote(`linear`)) ||
        identical(.e[[1]], quote(`locf`)) ||
        identical(.e[[1]], quote(`nocb`)) ||
        identical(.e[[1]], quote(`midpoint`)) ||
        identical(.e[[1]], quote(`splitBolus`))
    } else {
      FALSE
    }
  }, logical(1))
  .df <- data.frame(filter =.f, origLine=seq_along(.f))
  .predDf <- predDf
  if (any(.df$filter)) {
    .expr <- lapply(seq_along(.expr)[!.df$filter], function(i) {
      .expr[[i]]
    })
    .df <- .df[!.df$filter, , drop=FALSE]
    .df$newLine <- seq_along(.df$filter)
    if (!is.null(.predDf)) {
      .predDf$line <- vapply(.predDf$line, function(i) {
        .df$newLine[.df$origLine == i]
      }, integer(1))
    }
  }
  if (is.null(.predDf)) return(.expr)
  list(predDf=.predDf, lstExpr=.expr)
}

#' Combine Error Lines and create rxode2 expression
#'
#' @param uiModel UI model
#' @param errLines Error lines; If missing, get the error lines from
#'   `rxGetDistributionSimulationLines()`
#' @param prefixLines Prefix lines, after param statement
#' @param paramsLine Params line, if not present.
#' @param modelVars Return model vars instead of rxode2 statement
#' @param cmtLines Include trailing `cmt` lines
#' @param dvidLine Include trailing `dvid()` specification
#' @param lstExpr A list of expressions for model, or NULL.  When NULL
#'   defaults to the model expressions accessible by
#'   `uiModel$lstExpr`.
#' @param useIf Use an `if (CMT == X)` for endpoints
#' @param interpLines Interpolation lines, if not present
#' @param splitDoseLines Split dose lines, if not present
#' @param levelLines Levels lines for assigned strings.  If not
#'   present, use the interpolation lines from the current model.
#' @return quoted expression that can be evaluated to compiled rxode2
#'   model
#' @export
#' @author Matthew L. Fidler
#' @keywords internal
#' @details
#'
#' This is exported to allow other functions to mangle the error lines
#' to make other types of estimation methods (if needed)
#'
#' @examples
#'
#' \donttest{
#'
#' one.cmt <- function() {
#'   ini({
#'     ## You may label each parameter with a comment
#'     tka <- 0.45 # Log Ka
#'     tcl <- log(c(0, 2.7, 100)) # Log Cl
#'     ## This works with interactive models
#'     ## You may also label the preceding line with label("label text")
#'     tv <- 3.45; label("log V")
#'     ## the label("Label name") works with all models
#'     eta.ka ~ 0.6
#'     eta.cl ~ 0.3
#'     eta.v ~ 0.1
#'     add.sd <- 0.7
#'   })
#'   model({
#'     ka <- exp(tka + eta.ka)
#'     cl <- exp(tcl + eta.cl)
#'     v <- exp(tv + eta.v)
#'     linCmt() ~ add(add.sd)
#'   })
#' }
#'
#' f <- rxode2(one.cmt)
#'
#' # You can get the simulation model easily by
#' rxCombineErrorLines(f)
#'
#' # You can then get the compiled model by simply evaluting the model:
#' r <- eval(rxCombineErrorLines(f))
#'
#' # This also works with multile endpoint models:
#' pk.turnover.emax <- function() {
#'   ini({
#'     tktr <- log(1)
#'     tka <- log(1)
#'     tcl <- log(0.1)
#'     tv <- log(10)
#'     ##
#'     eta.ktr ~ 1
#'     eta.ka ~ 1
#'     eta.cl ~ 2
#'     eta.v ~ 1
#'     prop.err <- 0.1
#'     pkadd.err <- 0.1
#'     ##
#'     temax <- logit(0.8)
#'     tec50 <- log(0.5)
#'     tkout <- log(0.05)
#'     te0 <- log(100)
#'     ##
#'     eta.emax ~ .5
#'     eta.ec50  ~ .5
#'     eta.kout ~ .5
#'     eta.e0 ~ .5
#'     ##
#'     pdadd.err <- 10
#'   })
#'   model({
#'     ktr <- exp(tktr + eta.ktr)
#'     ka <- exp(tka + eta.ka)
#'     cl <- exp(tcl + eta.cl)
#'     v <- exp(tv + eta.v)
#'     ##
#'     emax=expit(temax+eta.emax)
#'     ec50 =  exp(tec50 + eta.ec50)
#'     kout = exp(tkout + eta.kout)
#'     e0 = exp(te0 + eta.e0)
#'     ##
#'     DCP = center/v
#'     PD=1-emax*DCP/(ec50+DCP)
#'     ##
#'     effect(0) = e0
#'     kin = e0*kout
#'     ##
#'     d/dt(depot) = -ktr * depot
#'     d/dt(gut) =  ktr * depot -ka * gut
#'     d/dt(center) =  ka * gut - cl / v * center
#'     d/dt(effect) = kin*PD -kout*effect
#'     ##
#'     cp = center / v
#'     cp ~ prop(prop.err) + add(pkadd.err)
#'     effect ~ add(pdadd.err)
#'   })
#' }
#'
#' f <- rxode2(pk.turnover.emax)
#' rxCombineErrorLines(f)
#'
#' # Note that in the parsed form, you can also get the compiled rxode2
#' # model with $simulationModel
#'
#' f$simulationModel
#'
#' }
rxCombineErrorLines <- function(uiModel, errLines=NULL, prefixLines=NULL, paramsLine=NULL,
                                modelVars=FALSE, cmtLines=TRUE, dvidLine=TRUE,
                                lstExpr=NULL,
                                useIf=TRUE,
                                interpLines=NULL, splitDoseLines=NULL,
                                levelLines=NULL) {
  if(!inherits(uiModel, "rxUi")) {
    stop("uiModel must be a evaluated UI model by rxode2(modelFunction) or modelFunction()",
         call.=FALSE)
  }
  uiModel <- rxUiDecompress(uiModel)
  .predDf <- uiModel$predDf
  if (is.null(.predDf)) {
    return(.rxModelNoErrorLines(uiModel, prefixLines=prefixLines, paramsLine=paramsLine,
                                modelVars=modelVars, cmtLines=cmtLines,
                                lstExpr=lstExpr))
  }
  if (is.null(errLines)) {
    errLines <- rxGetDistributionSimulationLines(uiModel)
  }
  .if <- FALSE
  if (length(.predDf$line) > 1) {
    .lenLines <- length(.predDf$line)
    .if <- useIf
  } else {
    .lenLines <- sum(vapply(seq_along(errLines), function(i) {
      length(errLines[[i]])
    }, integer(1)))
  }
  .cmtLines <- NULL
  if (cmtLines) {
    .cmtLines <- uiModel$cmtLines
  }
  .predDf <- uiModel$predDf
  .tmp <- .rxFilterOutPropsAndAdjustPredDf(uiModel, predDf=.predDf, lstExpr=lstExpr)
  .predDf <- .tmp$predDf
  .expr <- .tmp$lstExpr

  .lenLines <- .lenLines + length(.expr) -
    length(.predDf$line) + length(.cmtLines) + length(prefixLines)
  .k <- 2 + dvidLine * 1

  if (is.null(paramsLine)) {
  } else if (is.na(paramsLine)) {
    .lenLines <- .lenLines - 1
    .k <- 1 + dvidLine * 1
  }
  if (is.null(levelLines)) {
    .levelLines <- rxUiGet.levels(list(uiModel))
    .lenLines <- .lenLines - length(.levelLines)
    .k <- .k + length(.levelLines)
  } else if (is.na(levelLines)) {
    .levelLines <- list()
  } else {
    .levelLines <- levelLines
    .lenLines <- .lenLines - length(.levelLines)
    .k <- .k + length(.levelLines)
  }
  if (is.null(interpLines)) {
    .interpLines <- rxUiGet.interpLines(list(uiModel))
    .lenLines <- .lenLines - length(.interpLines)
    .k <- .k + length(.interpLines)
  } else if (is.na(interpLines)) {
    .interpLines <- list()
  } else {
    .interpLines <- interpLines
    .lenLines <- .lenLines - length(.interpLines)
    .k <- .k + length(.interpLines)
  }
  if (is.null(splitDoseLines)) {
    .splitDoseLines <- rxUiGet.splitDoseLines(list(uiModel))
    .lenLines <- .lenLines - length(.splitDoseLines)
    .k <- .k + length(.splitDoseLines)
  } else if (is.na(splitDoseLines)) {
    .splitDoseLines <- list()
  } else {
    .splitDoseLines <- splitDoseLines
    .lenLines <- .lenLines - length(.splitDoseLines)
    .k <- .k + length(.splitDoseLines)
  }
  .ret <- vector("list", .lenLines + .k)
  .curErrLine <- 1
  .ret[[1]] <- quote(`{`)
  .k <- 3
  if (is.null(paramsLine)) {
    .ret[[2]] <- uiModel$paramsLine
  } else if (is.na(paramsLine)) {
    .k <- 2
  } else {
    .ret[[2]] <- paramsLine
  }
  if (length(.levelLines) > 0) {
    for (.i in seq_along(.levelLines)) {
      .ret[[.k]] <- .levelLines[[.i]]
      .k <- .k + 1
    }
  }
  if (length(.interpLines) > 0) {
    for (.i in seq_along(.interpLines)) {
      .ret[[.k]] <- .interpLines[[.i]]
      .k <- .k + 1
    }
  }
  if (length(.splitDoseLines) > 0) {
    for (.i in seq_along(.splitDoseLines)) {
      .ret[[.k]] <- .splitDoseLines[[.i]]
      .k <- .k + 1
    }
  }
  for (.i in seq_along(prefixLines)) {
    .ret[[.k]] <- prefixLines[[.i]]
    .k <- .k + 1
  }
  for (.i in seq_along(.expr)) {
    if (.i %in% .predDf$line) {
      .curErr <- errLines[[.curErrLine]]
      if (.if) {
        .ret[[.k]] <- as.call(list(quote(`if`),
                                   as.call(list(quote(`==`), quote(`CMT`),
                                                as.numeric(.predDf$cmt[.curErrLine]))),
                                   as.call(c(list(quote(`{`)), .curErr))))
        .k <- .k + 1
      } else {
        for (.j in seq_along(.curErr)) {
          .ret[[.k]] <- .curErr[[.j]]
          .k <- .k + 1
        }
      }
      .curErrLine <- .curErrLine + 1
    } else {
      .ret[[.k]] <- .expr[[.i]]
      .k <- .k + 1
    }

  }
  for (.i in seq_along(.cmtLines)) {
    .ret[[.k]] <- .cmtLines[[.i]]
    .k <- .k + 1
  }
  if (dvidLine) {
    .ret[[.k]] <- uiModel$dvidLine
  }
  .drop <- which(vapply(seq_along(.ret), function(.i) {
    identical(.ret[[.i]], quote(`_drop`))
  }, logical(1), USE.NAMES=FALSE))
  if (length(.drop) > 0) {
    .ret <- .ret[-.drop]
  }
  if (modelVars) {
    as.call(list(quote(`rxModelVars`), as.call(.ret)))
  } else {
    as.call(list(quote(`rxode2`), as.call(.ret)))
  }
}
