regIf <- rex::rex(start, any_spaces, "if", any_spaces, "(", capture(anything), ")", any_spaces, "{", any_spaces, end)
regElse <- rex::rex(start, any_spaces, "else", any_spaces, "{", any_spaces, end)
regEnd <- rex::rex(start, any_spaces, "}", any_spaces, end)
regIfOrElse <- rex::rex(or(regIf, regElse))

## first.arg second.arg and type of function
## rxode2->symengine
.rxSEsingle <- list(
  "gammafn" = c("gamma(", ")", "gamma"),
  "lgammafn" = c("lgamma(", ")", "lgamma"),
  "lgamma" = c("lgamma(", ")", "lgamma"),
  "loggamma" = c("lgamma(", ")", "lgamma"),
  "digamma" = c("polygamma(0,", ")", "psigamma"),
  "trigamma" = c("polygamma(1,", ")", "psigamma"),
  "tetragamma" = c("polygamma(2,", ")", "psigamma"),
  "pentagamma" = c("polygamma(3,", ")", "psigamma"),
  "cospi" = c("cos(pi*(", "))", "cos"),
  "sinpi" = c("sin(pi*(", "))", "sin"),
  "tanpi" = c("tan(pi*(", "))", "tan"),
  "log1p" = c("log(1+", ")", "log"),
  "expm1" = c("(exp(", ")-1)", "exp"),
  "factorial" = c("gamma(", "+1)", "gamma"),
  "lfactorial" = c("lgamma(", "+1)", "lgamma"),
  "lgamma1p" = c("lgamma(", "+1)", "lgamma"),
  "expm1" = c("(exp(", ")-1)", "exp"),
  "log10" = c("log(", ")/log(10)", "log"),
  "log2" = c("log(", ")/log(2)", "log"),
  "log1pexp" = c("log(1+exp(", "))", "log1pexp"),
  "!" = c("rxNot(", ")", ""),
  "phi" = c("0.5*(1+erf((", ")/sqrt(2)))"),
  "pnorm" = c("0.5*(1+erf((", ")/sqrt(2)))"),
  "normcdf" = c("0.5*(1+erf((", ")/sqrt(2)))"),
  "qnorm" = c("sqrt(2)*erfinv(2*(", ")-1)"),
  "fabs" = c("abs0(", ")")
)

.SEsingle <- list(
  "rxNot" = c("(!(", "))"),
  "loggamma" = c("lgamma(", ")")
)

.rxSEdouble <- list(
  "pow" = c("(", ")^(", ")"),
  "R_pow" = c("(", ")^(", ")"),
  "R_pow_di" = c("(", ")^(", ")"),
  "Rx_pow_di" = c("(", ")^(", ")"),
  "Rx_pow" = c("(", ")^(", ")"),
  "lbeta" = c("log(beta(", ",", "))"),
  "==" = c("rxEq(", ",", ")"),
  "!=" = c("rxNeq(", ",", ")"),
  ">=" = c("rxGeq(", ",", ")"),
  "<=" = c("rxLeq(", ",", ")"),
  "<" = c("rxLt(", ",", ")"),
  ">" = c("rxGt(", ",", ")"),
  "&&" = c("rxAnd(", ",", ")"),
  "||" = c("rxOr(", ",", ")"),
  "&" = c("rxAnd(", ",", ")"),
  "|" = c("rxOr(", ",", ")"),
  "%%" = c("rxMod(", ",", ")")
)

.SEdouble <- list(
  "lbeta" = c("lbeta(", ",", ")"),
  "rxMod" = c("(", "%%", ")"),
  "rxEq" = c("(", "==", ")"),
  "rxNeq" = c("(", "!=", ")"),
  "rxGeq" = c("(", ">=", ")"),
  "rxLeq" = c("(", "<=", ")"),
  "rxGt" = c("(", ">", ")"),
  "rxLt" = c("(", "<", ")"),
  "rxAnd" = c("(", "&&", ")"),
  "rxOr" = c("(", "||", ")"),
  # raw R comparison/logical operators map to themselves so rxFromSE() can
  # re-consume its own output; the Subs handler re-parses converted text with
  # R's parser, turning rxGt()/rxEq() back into `>`/`==` operator calls
  "==" = c("(", "==", ")"),
  "!=" = c("(", "!=", ")"),
  ">=" = c("(", ">=", ")"),
  "<=" = c("(", "<=", ")"),
  ">" = c("(", ">", ")"),
  "<" = c("(", "<", ")"),
  "&&" = c("(", "&&", ")"),
  "&" = c("(", "&&", ")"),
  "||" = c("(", "||", ")"),
  "|" = c("(", "||", ")"),
  "%%" = c("(", "%%", ")"),
  "R_pow"=c("(", ")^(", ")"),
  "R_pow_di"=c("(", ")^(", ")"),
  "Rx_pow"=c("(", ")^(", ")"),
  "Rx_pow_di"=c("(", ")^(", ")"),
  ## Bare R relational/logical operators.  These are not produced by symengine
  ## directly (it uses rxEq/rxGt/...), but a Subs() over a Derivative whose body
  ## carries a relational -- e.g. from abs() or an occasion indicator -- converts
  ## rxGt/rxEq to R `>`/`==` and then re-runs .rxFromSE(); handle those infix so
  ## the relational survives the second pass instead of tripping the unknown-user-
  ## function check.
  ">"=c("(", ">", ")"),
  "<"=c("(", "<", ")"),
  ">="=c("(", ">=", ")"),
  "<="=c("(", "<=", ")"),
  "=="=c("(", "==", ")"),
  "!="=c("(", "!=", ")"),
  "&&"=c("(", "&&", ")"),
  "||"=c("(", "||", ")")
)

## atan2
.rxSEeq <- c(
  "lgamma" = 1,
  "abs" = 1,
  "acos" = 1,
  "acosh" = 1,
  "asin" = 1,
  "asinh" = 1,
  "atan" = 1,
  "atan2" = 2,
  "atanh" = 1,
  "beta" = 2,
  "cos" = 1,
  "cosh" = 1,
  "erf" = 1,
  "erfc" = 1,
  "exp" = 1,
  "gamma" = 1,
  "log" = 1,
  "polygamma" = 2,
  "rxTBS" = 5,
  "rxTBSi" = 5,
  "rxTBSd" = 5,
  "rxTBSd2" = 5,
  "rxTBSdL" = 5,
  "rxTBSdL2" = 5,
  "rxTBSdLx" = 5,
  "sin" = 1,
  "sinh" = 1,
  "sqrt" = 1,
  "tan" = 1,
  "tanh" = 1,
  "gammap" = 2,
  ## C's math.h library
  "floor" = 1,
  "round" = 1,
  "ceil" = 1,
  "trunc" = 1,
  ## Special R functions
  "bessel_i" = 3,
  "bessel_j" = 2,
  "bessel_k" = 3,
  "bessel_y" = 2,
  "logspace_add" = 2,
  "logspace_sub" = 2,
  "fmax2" = 2,
  "fmin2" = 2,
  "sign" = 1,
  "fsign" = 2,
  "fprec" = 2,
  "fround" = 2,
  "ftrunc" = 2,
  "transit" = NA,
  "gammaq" = 2,
  "gammapDer" = 2,
  "gammapInv" = 2,
  "gammapInva" = 2,
  "gammaqInv" = 2,
  "gammaqInva" = 2,
  "lowergamma" = 2,
  "uppergamma" = 2,
  "linCmtA"=14,
  "linCmtB"=15,
  "max" = NA,
  "min" = NA,
  "logit" = NA,
  "expit" = NA,
  "probit" = NA,
  "probitInv" = NA,
  "tlast" = NA,
  "tlast0" = NA,
  "tfirst" = NA,
  "tfirst0" = NA,
  "lag" = NA,
  "lead" = NA,
  "lag0" = NA,
  "lead0" = NA,
  "dose" =NA,
  "podo" =NA,
  "dose0" =NA,
  "podo0" =NA,
  "dabs" = 1,
  "dabs2" = 1,
  "abs1" = 1,
  "dabs1" = 1,
  "erfinv" = 1,
  "abs0" = 1,
  "dosenum" = 0,
  "first" = 1,
  "last" = 1,
  "diff" = 1,
  "diff0" = 1,
  "is.nan" = 1,
  "is.na" = 1,
  "is.finite" = 1,
  "is.infinite" = 1,
  "llikPois"=2,
  "llikPoisDlambda"=2,
  "llikBinom"=3,
  "llikBinomDprob"=3,
  "llikNbinom"=3,
  "llikNbinomDprob"=3,
  "llikNbinomMu"=3,
  "llikNbinomMuDmu"=3,
  "llikBeta"=3,
  "llikBetaDshape1"=3,
  "llikBetaDshape2"=3,
  "llikT"=4,
  "llikTDdf"=4,
  "llikTDmean"=4,
  "llikTDsd"=4,
  "llikChisq"=2,
  "llikChisqDdf"=2,
  "llikExp"=2,
  "llikExpDrate"=2,
  "llikF"=3,
  "llikFDdf1"=3,
  "llikFDdf2"=3,
  "llikGeom"=2,
  "llikGeomDprob"=2,
  "llikUnif"=3,
  "llikUnifDalpha"=3,
  "llikUnifDbeta"=3,
  "llikWeibull"=3,
  "llikWeibullDshape"=3,
  "llikWeibullDscale"=3,
  "llikGamma"=3,
  "llikGammaDshape"=3,
  "llikGammaDrate"=3,
  "llikCauchy"=3,
  "llikCauchyDlocation"=3,
  "llikCauchyDscale"=3,
  "llikNorm"=3,
  "llikNormDmean"=3,
  "llikNormDsd"=3,
  # Now the llikX variety for saving comp. time
  "llikXPois"=3,
  "llikXPoisDlambda"=3,
  "llikXBinom"=4,
  "llikXBinomDprob"=4,
  "llikXNbinomMu"=4,
  "llikXNbinomMuDmu"=4,
  "llikXNbinom"=4,
  "llikXNbinomDprob"=4,
  "llikXBeta"=4,
  "llikXBetaDshape1"=4,
  "llikXBetaDshape2"=4,
  "llikXT"=5,
  "llikXTDdf"=5,
  "llikXTDmean"=5,
  "llikXTDsd"=5,
  "llikXChisq"=3,
  "llikXChisqDdf"=3,
  "llikXExp"=3,
  "llikXExpDrate"=3,
  "llikXF"=4,
  "llikXFDdf1"=4,
  "llikXFDdf2"=4,
  "llikXGeom"=3,
  "llikXGeomDprob"=3,
  "llikXUnif"=4,
  "llikXUnifDalpha"=4,
  "llikXUnifDbeta"=4,
  "llikXWeibull"=4,
  "llikXWeibullDshape"=4,
  "llikXWeibullDscale"=4,
  "llikXGamma"=4,
  "llikXGammaDshape"=4,
  "llikXGammaDrate"=4,
  "llikXCauchy"=4,
  "llikXCauchyDlocation"=4,
  "llikXCauchyDscale"=4,
  "llikXNorm"=4,
  "llikXNormDmean"=4,
  "llikXNormDsd"=4,
  "ReLU"=1,
  "dReLU"=1,
  "GELU"=1,
  "dGELU"=1,
  "d2GELU"=1,
  "d3GELU"=1,
  "d4GELU"=1,
  "ELU"=2,
  "dELU"=2,
  "d2ELU"=2,
  "d2aELU"=2,
  "dELUa"=2,
  "d2ELUa"=2,
  "softplus"=1,
  "dsoftplus"=1,
  "d2softplus"=1,
  "d3softplus"=1,
  "d4softplus"=1,
  "SELU"=1,
  "dSELU"=1,
  "lReLU"=1,
  "dlReLU"=1,
  "PReLU"=2,
  "dPReLU"=2,
  "d2PReLU"=2,
  "dPReLUa"=2,
  "dPReLUa1"=2,
  "Swish"=1,
  "dSwish"=1
)

.rxOnly <- c(
  ## Now random number generators
  "rnorm" = NA,
  "rxnorm" = NA,
  "rxbinom" = 2,
  "rbinom" = 2,
  "rxcauchy" = NA,
  "rcauchy" = NA,
  "rchisq" = 1,
  "rxchisq" = 1,
  "rexp" = 1,
  "rxexp" = 1,
  "rbeta" = 2,
  "rxbeta" = 2,
  "rgeom" = 1,
  "rxgeom" = 1,
  "rxpois" = 1,
  "rpois" = 1,
  "rxt" = 1,
  "rt" = 1
)

#' Add/Create C functions for use in rxode2
#'
#' @inheritParams rxFunParse
#'
#' @param name This can either give the name of the user function or
#'   be a simple R function that you wish to convert to C.  If you
#'   have rxode2 convert the R function to C, the name of the function
#'   will match the function name provided and the number of arguments
#'   will match the R function provided.  Hence, if you are providing
#'   an R function for conversion to C, the rest of the arguments are
#'   implied.
#' @export
#' @examples
#' \donttest{
#' # Right now rxode2 is not aware of the function fun
#' # Therefore it cannot translate it to symengine or
#' # Compile a model with it.
#'
#' try(rxode2("a=fun(a,b,c)"))
#'
#' # Note for this approach to work, it cannot interfere with C
#' # function names or reserved rxode2 special terms.  Therefore
#' # f(x) would not work since f is an alias for bioavailability.
#'
#' fun <- "
#' double fun(double a, double b, double c) {
#'   return a*a+b*a+c;
#' }
#' " # C-code for function
#'
#' rxFun("fun", c("a", "b", "c"), fun) ## Added function
#'
#' # Now rxode2 knows how to translate this function to symengine
#'
#' rxToSE("fun(a,b,c)")
#'
#' # And will take a central difference when calculating derivatives
#'
#' rxFromSE("Derivative(fun(a,b,c),a)")
#'
#' ## Of course, you could specify the derivative table manually
#' rxD("fun", list(
#'   function(a, b, c) {
#'     paste0("2*", a, "+", b)
#'   },
#'   function(a, b, c) {
#'     return(a)
#'   },
#'   function(a, b, c) {
#'     return("0.0")
#'   }
#' ))
#'
#' rxFromSE("Derivative(fun(a,b,c),a)")
#'
#' # You can also remove the functions by `rxRmFun`
#'
#' rxRmFun("fun")
#'
#' # you can also use R functions directly in rxode2
#'
#'
#' gg <- function(x, y) {
#'   x + y
#' }
#'
#' f <- rxode2({
#'  z = gg(x, y)
#' })
#'
#'
#' e <- et(1:10) |> as.data.frame()
#'
#' e$x <- 1:10
#' e$y <- 21:30
#'
#' rxSolve(f, e)
#'
#' # Note that since it touches R, it can only run single-threaded.
#' # There are also requirements for the function:
#' #
#' # 1. It accepts one value per argument (numeric)
#' #
#' # 2. It returns one numeric value
#'
#' # If it is a simple function (like gg) you can also convert it to C
#' # using rxFun and load it into rxode2
#'
#' rxFun(gg)
#'
#' rxSolve(f, e)
#'
#' # to stop the recompile simply reassign the function
#' f <- rxode2(f)
#'
#' rxSolve(f, e)
#'
#' rxRmFun("gg")
#' rm(gg)
#' rm(f)
#'
#'
#' # You can also automatically convert a R function to R code (and
#' # calculate first derivatives)
#'
#' fun <- function(a, b, c) {
#'   a^2+b*a+c
#' }
#'
#' rxFun(fun)
#'
#' # You can see the R code if you want with rxC
#'
#' message(rxC("fun"))
#'
#' # you can also remove both the function and the
#' # derivatives with rxRmFun("fun")
#'
#' rxRmFun("fun")
#'
#' }
rxFun <- function(name, args, cCode) {
  if (missing(args) && missing(cCode)) {
    .funName <- as.character(substitute(name))
    .lst <- rxFun2c(name, name=.funName)
    .env <- new.env(parent=emptyenv())
    .env$d <- list()
    lapply(seq_along(.lst), function(i) {
      .cur <- .lst[[i]]
      do.call(rxode2::rxFunParse, .cur[1:3])
      message("converted R function '", .cur$name, "' to C (will now use in rxode2)")
      ## message(.cur$cCode)
      if (length(.cur) == 4L) {
        .env$d <- c(.env$d, list(.cur[[4]]))
      }
    })
    if (length(.env$d) > 0) {
      message("Added derivative table for '", .lst[[1]]$name, "'")
       rxD(.lst[[1]]$name, .env$d)
    }
    return(invisible())
  }
  rxFunParse(name, args, cCode)
}

#' @rdname rxFun
#' @export
rxRmFun <- function(name) {
  rxRmFunParse(name)
}

.SE1p <- c(
  "loggamma" = "lgamma1p",
  "lgamma" = "lgamma1p",
  "log" = "log1p"
)

.SE1m <- c(
  "cos" = "cospi",
  "sin" = "sinpi",
  "tan" = "tanpi"
)
## "rxTBS", "rxTBSd"
.rxSEcnt <- c(
  "M_E" = "E",
  "M_PI" = "pi",
  "M_PI_2" = "pi/2",
  "M_PI_4" = "pi/4",
  "M_1_PI" = "1/pi",
  "M_2_PI" = "2/pi",
  "M_2PI" = "2*pi",
  "M_SQRT_PI" = "sqrt(pi)",
  "M_2_SQRTPI" = "2/sqrt(pi)",
  "M_1_SQRT_2PI" = "1/sqrt(2*pi)",
  "M_SQRT2" = "sqrt(2)",
  "M_SQRT_3" = "sqrt(3)",
  "M_SQRT_32" = "sqrt(32)",
  "M_SQRT_2dPI" = "sqrt(2/pi)",
  "M_LN_SQRT_PI" = "log(sqrt(pi))",
  "M_LN_SQRT_2PI" = "log(sqrt(2*pi))",
  "M_LN_SQRT_PId2" = "log(sqrt(pi/2))",
  "M_LOG10_2" = "log(2)/log(10)",
  "M_LOG2E" = "1/log(2)",
  "M_LOG10E" = "1/log(10)",
  "M_LN2" = "log(2)",
  "M_LN10" = "log(10)"
)
## "rxTBS", "rxTBSd"

.rxSEreserved <- list(
  "e" = 2.718281828459045090796,
  "E" = 2.718281828459045090796,
  "EulerGamma" = 0.57721566490153286060651209008240243104215933593992,
  "Catalan" = 0.915965594177219015054603514932384110774,
  "GoldenRatio" = 2.118033988749894902526,
  "I" = 1i
)

#' Add to rxode2's derivative tables
#'
#' @param name Function Name
#' @param derivatives A list of functions. Each function takes the
#'     same number of arguments as the original function.  The first
#'     function will construct the derivative with respect to the
#'     first argument; The second function will construct the
#'     derivitive with respect to the second argument, and so on.
#' @return nothing
#' @author Matthew Fidler
#' @export
#' @examples
#' ## Add an arbitrary list of derivative functions
#' ## In this case the fun(x,y) is assumed to be 0.5*x^2+0.5*y^2
#'
#' rxD("fun", list(
#'   function(x, y) {
#'     return(x)
#'   },
#'   function(x, y) {
#'     return(y)
#'   }
#' ))
rxD <- function(name, derivatives) {
  if (!inherits(derivatives, "list") || length(derivatives) == 0L) {
    stop("derivatives must be a list of functions with at least 1 element", call. = FALSE)
  }
  if (!all(sapply(derivatives, function(x) (inherits(x, "function") || is.null(x))))) {
    stop("derivatives must be a list of functions with at least 1 element", call. = FALSE)
  }
  .rxD <- rxode2::rxode2parseD()
  if (exists(name, envir = .rxD)) {
    warning(sprintf(gettext("replacing defined derivatives for '%s'"), name), call. = FALSE)
  }
  assign(name, derivatives, envir = .rxD)
  return(invisible())
}

.rxToSE.envir <- new.env(parent=emptyenv())
.rxToSE.envir$envir <- NULL

.promoteLinB <- FALSE
#' rxode2 to symengine environment
#'
#' @param x expression
#'
#' @param envir default is `NULL`; Environment to put symengine
#'     variables in.
#'
#' @param progress shows progress bar if true.
#'
#' @param promoteLinSens Promote solved linear compartment systems to
#'     sensitivity-based solutions.
#'
#' @param unknownDerivatives When handling derivatives from unknown
#'     functions, the translator will translate into different types
#'     of numeric derivatives.  The currently supported methods are:
#'
#'     - `forward` for forward differences
#'     - `central` for central differences
#'     - `error` for throwing an error for unknown derivatives
#'
#' @param parent is the parent environment to look for R-based user functions
#'
#' @return An rxode2 symengine environment
#' @author Matthew L. Fidler
#' @export
rxToSE <- function(x, envir = NULL, progress = FALSE,
                   promoteLinSens = TRUE, parent = parent.frame()) {
  .udfEnvSet(parent)
  .rxToSE.envir$parent <- parent
  .rxToSElinCmt$linCmt <- NULL # no linCmt() found
  if (exists("t", envir=.rxToSElinCmt, inherits=FALSE)) rm("t", envir=.rxToSElinCmt)
  assignInMyNamespace(".promoteLinB", promoteLinSens)
  assignInMyNamespace(".rxIsLhs", FALSE)
  assignInMyNamespace(".rxLastAssignedDdt", "")
  if (is(substitute(x), "character")) {
    force(x)
  } else if (is(substitute(x), "{")) {
    x <- deparse1(substitute(x))
    if (x[1] == "{") {
      x <- x[-1]
      x <- x[-length(x)]
    }
    x <- paste(x, collapse = "\n")
  } else {
    .xc <- as.character(substitute(x))
    x <- substitute(x)
    if (length(.xc) == 1) {
      .found <- FALSE
      .frames <- seq(1, sys.nframe())
      .frames <- .frames[.frames != 0]
      for (.f in .frames) {
        .env <- parent.frame(.f)
        if (exists(.xc, envir = .env)) {
          .val2 <- try(get(.xc, envir = .env), silent = TRUE)
          if (inherits(.val2, "character")) {
            .val2 <- eval(parse(text = paste0("quote({", .val2, "})")))
            return(.rxToSE(.val2, envir=envir, progress=progress))
          } else if (inherits(.val2, "numeric") || inherits(.val2, "integer")) {
            return(sprintf("%s", .val2))
          }
        }
      }
    }
    return(.rxToSE(x, envir=envir, progress=progress))
  }
  return(.rxToSE(eval(parse(text = paste0("quote({", x, "})"))), envir, progress))
}

## adapted from URLencode
.rxStrEncode <- function (str) {
  paste0("rxQ__",
         vapply(str, function(str) {
           OK <- "[^ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789]"
           x <- strsplit(str, "")[[1L]]
           z <- grep(OK, x)
           if (length(z)) {
             y <- vapply(x[z], function(x)
               paste0("_", toupper(as.character(charToRaw(x))),
                      collapse = ""), "")
             x[z] <- y
           }
           paste(x, collapse = "")
         }, character(1), USE.NAMES = FALSE),
         "__rxQ")
}

.rxStrDecode <- function(x) {
  .nchr <- nchar(x)
  if (.nchr > 10) {
    if (substr(x, 1, 5) == "rxQ__") {
      .x <- charToRaw(substr(x, 6, .nchr - 5))
      .pc <- charToRaw("_")
      .out <- raw(0L)
      .i <- 1L
      while (.i <= length(.x)) {
        if (.x[.i] != .pc) {
          .out <- c(.out, .x[.i])
          .i <- .i + 1L
        }
        else {
          .y <- as.integer(.x[.i + 1L:2L])
          .y[.y > 96L] <- .y[.y > 96L] - 32L
          .y[.y > 57L] <- .y[.y > 57L] - 7L
          .y <- sum((.y - 48L) * c(16L, 1L))
          .out <- c(.out, as.raw(as.character(.y)))
          .i <- .i + 3L
        }
      }
      return(rawToChar(.out))
    }
  }
  return(x)
}


.rxChrToSym <- function(x) {
  str2lang(.rxStrEncode(x))
}

.rxRepRxQ <- function(x) {
  .nchr <- nchar(x)
  if (.nchr > 10) {
    if (substr(x, 1, 5) == "rxQ__") {
      return(deparse1(.rxStrDecode(x)))
    }
  }
  return(x)
}

.rxToSEDualVarFunction <- c("tlast", "tlast0", "tad", "tad0", "tafd", "tafd0",
                            "tfirst", "tfirst0", "dose", "podo", "dose0", "podo0",
                            "dosenum", "dosenum0")

#' Change rxode2 linCmt states to `linCmtA/B` syntax
#'
#' @param x character expression
#' @param envir Current evaluating environment
#' @param progress Progress information
#' @param isEnvir Tell if this is an environment parse
#' @return Changed expression (as character), or NULL if not
#' @author Matthew L. Fidler
#' @noRd
.rxToSEtoLinCmt <- function(x, envir=NULL, progress=FALSE, isEnv=TRUE) {
  if (is.null(.rxToSElinCmt$linCmt)) {
    return(NULL)
  }
  .linCmtB <- .rxToSElinCmt$linCmt == "linCmtB"
  .oral0 <- as.numeric(paste(.rxToSElinCmt$oral0)) == 1
  .ncmt <- as.numeric(paste(.rxToSElinCmt$ncmt))
  .which1 <- NA_integer_
  if (.oral0) {
    if (.ncmt == 1) {
      if (x == "depot") {
        .which1 <- 0L
      } else if (x == "central") {
        .which1 <- 1L
      }
      # The sensitivity equations
      if (.linCmtB) {
        if (x == "rx__sens_central_BY_p1") {
          .which1 <- 2L
        } else if (x == "rx__sens_central_BY_v1") {
          .which1 <- 3L
        } else if (x == "rx__sens_central_BY_ka") {
          .which1 <- 4L
        } else if (x == "rx__sens_depot_BY_ka") {
          .which1 <- 5L
        }
      }
    } else if (.ncmt == 2) {
      if (x == "depot") {
        .which1 <- 0L
      } else if (x == "central") {
        .which1 <- 1L
      } else if (x == "peripheral1") {
        .which1 <- 2L
      }
      if (.linCmtB) {
        if (x == "rx__sens_central_BY_p1") {
          .which1 <- 3L
        } else if (x == "rx__sens_central_BY_v1") {
          .which1 <- 4L
        } else if (x == "rx__sens_central_BY_p2") {
          .which1 <- 5L
        } else if (x == "rx__sens_central_BY_p3") {
          .which1 <- 6L
        } else if (x == "rx__sens_central_BY_ka") {
          .which1 <- 7L
        } else if (x == "rx__sens_peripheral1_BY_p1") {
          .which1 <- 8L
        } else if (x == "rx__sens_peripheral1_BY_v1") {
          .which1 <- 9L
        } else if (x == "rx__sens_peripheral1_BY_p2") {
          .which1 <- 10L
        } else if (x == "rx__sens_peripheral1_BY_p3") {
          .which1 <- 11L
        } else if (x == "rx__sens_peripheral1_BY_ka") {
          .which1 <- 12L
        } else if (x == "rx__sens_depot_BY_ka") {
          .which1 <- 13L
        }
      }
    } else {
      if (x == "depot") {
        .which1 <- 0L
      } else if (x == "central") {
        .which1 <- 1L
      } else if (x == "peripheral1") {
        .which1 <- 2L
      } else if (x == "peripheral2") {
        .which1 <- 3L
      }
      if (.linCmtB) {
        if (x == "rx__sens_central_BY_p1") {
          .which1 <- 4L
        } else if (x == "rx__sens_central_BY_v1") {
          .which1 <- 5L
        } else if (x == "rx__sens_central_BY_p2") {
          .which1 <- 6L
        } else if (x == "rx__sens_central_BY_p3") {
          .which1 <- 7L
        } else if (x == "rx__sens_central_BY_p4") {
          .which1 <- 8L
        } else if (x == "rx__sens_central_BY_p5") {
          .which1 <- 9L
        } else if (x == "rx__sens_central_BY_ka") {
          .which1 <- 10L
        } else if (x == "rx__sens_peripheral1_BY_p1") {
          .which1 <- 11L
        } else if (x == "rx__sens_peripheral1_BY_v1") {
          .which1 <- 12L
        } else if (x == "rx__sens_peripheral1_BY_p2") {
          .which1 <- 13L
        } else if (x == "rx__sens_peripheral1_BY_p3") {
          .which1 <- 14L
        } else if (x == "rx__sens_peripheral1_BY_p4") {
          .which1 <- 15L
        } else if (x == "rx__sens_peripheral1_BY_p5") {
          .which1 <- 16L
        } else if (x == "rx__sens_peripheral1_BY_ka") {
          .which1 <- 17L
        } else if (x == "rx__sens_peripheral2_BY_p1") {
          .which1<- 18L
        } else if (x == "rx__sens_peripheral2_BY_v1") {
          .which1 <- 19L
        } else if (x == "rx__sens_peripheral2_BY_p2") {
          .which1 <- 20L
        } else if (x == "rx__sens_peripheral2_BY_p3") {
          .which1 <- 21L
        } else if (x == "rx__sens_peripheral2_BY_p4") {
          .which1 <- 22L
        } else if (x == "rx__sens_peripheral2_BY_p5") {
          .which1 <- 23L
        } else if (x == "rx__sens_peripheral2_BY_ka") {
          .which1 <- 24L
        } else if (x == "rx__sens_depot_BY_ka") {
          .which1 <- 25L
        }
      }
    }
  } else {
    if (.ncmt == 1) {
      if (x == "central") {
        .which1 <- 0L
      }
      if (.linCmtB) {
        if (x == "rx__sens_central_BY_p1") {
          .which1 <- 1L
        } else if (x == "rx__sens_central_BY_v1") {
          .which1 <- 2L
        }
      }
    } else if (.ncmt == 2) {
      if (x == "central") {
        .which1 <- 0L
      } else if (x == "peripheral1") {
        .which1 <- 1L
      }
      if (.linCmtB) {
        if (x == "rx__sens_central_BY_p1") {
          .which1 <- 2L
        } else if (x == "rx__sens_central_BY_v1") {
          .which1 <- 3L
        } else if (x == "rx__sens_central_BY_p2") {
          .which1 <- 4L
        } else if (x == "rx__sens_central_BY_p3") {
          .which1 <- 5L
        } else if (x == "rx__sens_peripheral1_BY_p1") {
          .which1 <- 6L
        } else if (x == "rx__sens_peripheral1_BY_v1") {
          .which1 <- 7L
        } else if (x == "rx__sens_peripheral1_BY_p2") {
          .which1 <- 8L
        } else if (x == "rx__sens_peripheral1_BY_p3") {
          .which1 <- 9L
        }
      }
    } else if (.ncmt == 3) {
      if (x == "central") {
        .which1 <- 0L
      } else if (x == "peripheral1") {
        .which1 <- 1L
      } else if (x == "peripheral2") {
        .which1 <- 2L
      }
      if (.linCmtB) {
        if (x == "rx__sens_central_BY_p1") {
          .which1 <- 3L
        } else if (x == "rx__sens_central_BY_v1") {
          .which1 <- 4L
        } else if (x == "rx__sens_central_BY_p2") {
          .which1 <- 5L
        } else if (x == "rx__sens_central_BY_p3") {
          .which1 <- 6L
        } else if (x == "rx__sens_central_BY_p4") {
          .which1 <- 7L
        } else if (x == "rx__sens_central_BY_p5") {
          .which1 <- 8L
        } else if (x == "rx__sens_peripheral1_BY_p1") {
          .which1 <- 9L
        } else if (x == "rx__sens_peripheral1_BY_v1") {
          .which1 <- 10L
        } else if (x == "rx__sens_peripheral1_BY_p2") {
          .which1 <- 11L
        } else if (x == "rx__sens_peripheral1_BY_p3") {
          .which1 <- 12L
        } else if (x == "rx__sens_peripheral1_BY_p4") {
          .which1 <- 13L
        } else if (x == "rx__sens_peripheral1_BY_p5") {
          .which1 <- 14L
        } else if (x == "rx__sens_peripheral2_BY_p1") {
          .which1 <- 15L
        } else if (x == "rx__sens_peripheral2_BY_v1") {
          .which1 <- 16L
        } else if (x == "rx__sens_peripheral2_BY_p2") {
          .which1 <- 17L
        } else if (x == "rx__sens_peripheral2_BY_p3") {
          .which1 <- 18L
        } else if (x == "rx__sens_peripheral2_BY_p4") {
          .which1 <- 19L
        } else if (x == "rx__sens_peripheral2_BY_p5") {
          .which1 <- 20L
        }
      }
    }
  }
  if (is.na(.which1)) {
    return(NULL)
  }
  if (!.linCmtB) {
    # linCmtA(rx__PTR__, t, linCmt, ncmt, oral0, which, trans,
    #         p1, v1, p2, p3, p4, p5, ka)
    .rxToSElinCmt$which <- .which1
    return(sprintf("linCmtA(rx__PTR__, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s)",
                   .rxToSElinCmt$t, .rxToSElinCmt$linCmtN, .rxToSElinCmt$ncmt,
                   .rxToSElinCmt$oral0, .rxToSElinCmt$which,
                   .rxToSElinCmt$trans, .rxToSElinCmt$p1,
                   .rxToSElinCmt$v1, .rxToSElinCmt$p2, .rxToSElinCmt$p3,
                   .rxToSElinCmt$p4, .rxToSElinCmt$p5,
                   .rxToSElinCmt$ka))
  } else {
    .rxToSElinCmt$which1 <- .which1
    .rxToSElinCmt$which2 <- -2L
    return(sprintf("linCmtB(rx__PTR__, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s)",
                   .rxToSElinCmt$t,
                   .rxToSElinCmt$linCmtN,
                   .rxToSElinCmt$ncmt,
                   .rxToSElinCmt$oral0,
                   .rxToSElinCmt$which1,
                   .rxToSElinCmt$which2,
                   .rxToSElinCmt$trans,
                   .rxToSElinCmt$p1,
                   .rxToSElinCmt$v1,
                   .rxToSElinCmt$p2,
                   .rxToSElinCmt$p3,
                   .rxToSElinCmt$p4,
                   .rxToSElinCmt$p5,
                   .rxToSElinCmt$ka))
  }
}

#' Change rxode2 syntax to symengine syntax for symbols and numbers
#'
#' @param x expression
#' @param envir Current evaluating environment
#' @param progress Progress information
#' @param isEnvir Tell if this is an environment parse
#' @return Changed expression (as character)
#' @author Matthew L. Fidler
#' @noRd
.rxToSENameOrAtomic <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .cnst <- names(.rxSEreserved)
  if (is.character(x)) {
    .ret <- .rxChrToSym(x)
    .ret2 <- as.character(.ret)
    if (isEnv) {
      .ret2 <- as.character(.ret)
      assign(.ret2, symengine::Symbol(.ret2), envir = envir)
    }
    return(.ret)
  } else {
    .ret <- as.character(x)
    if (!.rxIsLhs && .ret %in% .rxToSEDualVarFunction) {
      ## A bare dose-history name (tad, dosenum, tlast, ...) used as a *value*
      ## expands to its functional form (e.g. tad -> (t-tlast())).  When the same
      ## name is an assignment *target* (e.g. `tad = tad()`, which FOCEi's FD model
      ## emits) it must stay a plain symbol -- otherwise the lhs is rewritten into
      ## the function body and produces an invalid assignment like
      ## `(t-tlast()) = t-tlast()`, which breaks analytic Jacobian (calcJac)
      ## generation for the model (notably delay()/DDE models, which force the
      ## Jacobian-requiring dense solver).
      .ret <- paste0(.ret, "()")
      .ret <- rxToSE(.ret)
      return(.ret)
    } else if (any(.ret == .cnst)) {
      .ret <- paste0("rx_SymPy_Res_", .ret)
      if (isEnv && is.name(x)) {
        if (substr(x, 1, 1) != ".") {
          if (!exists(.ret, envir = envir)) {
            assign(.ret, symengine::Symbol(.ret), envir = envir)
          }
        }
      }
      return(.ret)
    } else {
      .lin <- .rxToSEtoLinCmt(.ret, envir=envir, progress=progress, isEnv=isEnv)
      if (!is.null(.lin)) {
        return(.lin)
      }
      .ret0 <- .rxSEcnt[.ret]
      if (is.na(.ret0)) {
        if (isEnv && is.name(x)) {
          ## message(.ret)
          if (substr(x, 1, 1) != ".") {
            if (!exists(.ret, envir = envir) && is.name(x)) {
              assign(.ret, symengine::Symbol(.ret), envir = envir)
            }
          }
        }
        return(.ret)
      }
      return(setNames(.ret0, NULL))
    }
  }
}

.rxToSECurlyBrace <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .x2 <- x[-1]
  if (progress) {
    rxProgress(length(.x2))
    on.exit({
      rxProgressAbort()
    })
    .ret <- paste(lapply(.x2, function(x) {
      rxTick()
      .rxToSE(x, envir = envir)
    }), collapse = "\n")
    rxProgressStop()
  } else {
    .ret <- paste(lapply(.x2, .rxToSE, envir = envir),
                  collapse = "\n")
  }
  ## Assign and evaluate deferred items.
  if (isEnv) {
    for (.var in names(envir$..ddt..)) {
      .expr <- envir$..ddt..[[.var]]
      .expr <- eval(parse(text = .expr))
      assign(.var, .expr, envir = envir)
      .rx <- paste0(
        rxFromSE(.var), "=",
        rxFromSE(.expr)
      )
      assign("..ddt", c(envir$..ddt, .rx),
             envir = envir
             )
    }
    for (.var in names(envir$..sens0..)) {
      .expr <- envir$..sens0..[[.var]]
      .expr <- eval(parse(text = .expr))
      assign(.var, .expr, envir = envir)
      .rx <- paste0(
        rxFromSE(.var), "=",
        rxFromSE(.expr))
      assign("..sens0", c(envir$..sens0, .rx),
             envir = envir)
    }
    for (.var in names(envir$..jac0..)) {
      .expr <- envir$..jac0..[[.var]]
      .expr <- eval(parse(text = .expr))
      assign(.var, .expr, envir = envir)
      .rx <- paste0(
        rxFromSE(.var), "=",
        rxFromSE(.expr))
      assign("..jac0", c(envir$..jac0, .rx),
             envir = envir)
    }
  }
  return(.ret)
}

.rxLastAssignedDdt <- ""
.rxIsLhs <- FALSE

.rxToSEArithmeticOperators <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x) == 3) {
    if (identical(x[[1]], quote(`/`))) {
      .x2 <- x[[2]]
      .x3 <- x[[3]]
      ## df(%s)/dy(%s)
      if (identical(.x2, quote(`d`)) &&
            identical(.x3[[1]], quote(`dt`))) {
        if (length(.x3[[2]]) == 1) {
          .state <- as.character(.x3[[2]]) # .rxToSE(.x3[[2]], envir = envir)
        } else {
          .state <- .rxToSE(.x3[[2]], envir = envir)
        }
        if (.rxIsLhs) {
          assignInMyNamespace(".rxLastAssignedDdt", .state)
        }
        return(paste0("rx__d_dt_", .state, "__"))
      } else {
        if (length(.x2) == 2 && length(.x3) == 2) {
          if (identical(.x2[[1]], quote(`df`)) &&
                identical(.x3[[1]], quote(`dy`))) {
            if (length(.x2[[2]]) == 1) {
              .state <- as.character(.x2[[2]])
            } else {
              .state <- .rxToSE(.x2[[2]], envir = envir)
            }
            if (length(.x3[[2]]) == 1) {
              .var <- as.character(.x3[[2]])
            } else {
              .var <- .rxToSE(.x3[[2]], envir = envir)
            }
            return(paste0(
              "rx__df_", .state,
              "_dy_", .var, "__"
            ))
          }
        }
        .ret <- paste0(
          .rxToSE(.x2, envir = envir),
          as.character(x[[1]]),
          .rxToSE(.x3, envir = envir)
        )
      }
    } else {
      .ret <- paste0(
        .rxToSE(x[[2]], envir = envir),
        as.character(x[[1]]),
        .rxToSE(x[[3]], envir = envir)
      )
    }
    return(.ret)
  } else {
    ## Unary Operators
    return(paste(
      as.character(x[[1]]),
      .rxToSE(x[[2]], envir = envir)
    ))
  }
}

.rxToSEAssignOperators <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  assignInMyNamespace(".rxIsLhs", TRUE)
  .var <- .rxToSE(x[[2]], envir = envir)
  assignInMyNamespace(".rxIsLhs", FALSE)
  .isNum <- FALSE
  if (isEnv) {
    if (length(x[[2]]) == 2) {
      if (as.character(x[[2]][[1]]) == "mtime") {
        .mtimeVar <- .rxToSE(x[[2]][[2]], envir = envir)
        envir$..mtimeVars <- unique(c(.mtimeVar, envir$..mtimeVars))
        return(invisible(NULL))
      }
      if (as.character(x[[2]][[1]]) == "indLin") {
        ## indLin(state) <- forcing : store the forcing as a per-state symengine
        ## variable (rx__indLinForce_<state>__) so .rxInjectMatExpOdes() can add
        ## it to the matrix-derived d/dt().  The LHS itself has no symengine
        ## variable (.rxToSE returns "" for indLin), so it must be handled here
        ## before the generic assignment below.  A named variable (not a list)
        ## is used so symengine's masked `[[<-` cannot coerce the container.
        .indLinState <- as.character(x[[2]][[2]])
        .force <- eval(parse(text = paste0(
          "with(envir,", .rxToSE(x[[3]], envir = envir), ")")))
        assign(paste0("rx__indLinForce_", .indLinState, "__"), .force,
               envir = envir)
        return(invisible(NULL))
      }
      if (any(as.character(x[[2]][[1]]) == c("alag", "lag", "F", "f", "rate", "dur"))) {
        envir$..eventVars <- unique(c(.var, envir$..eventVars))
      }
    }
    if (length(x[[2]]) == 3 && as.character(x[[2]][[1]]) == "past") {
      ## past(state, tau) <- expr : non-constant delay() pre-history.  Store the
      ## RHS (rx__past_<state>__, for sensitivity histories) and the delay tau
      ## text (rx__pastTau_<state>__) as per-state symengine env variables, then
      ## return: the line is retained verbatim in the normalized model and must
      ## not enter Jacobian/sensitivity differentiation here (state is the delay
      ## history, differentiated only via its own past() expression).
      .pastState <- as.character(x[[2]][[2]])
      ## Store the history RHS and tau as plain rxode2-syntax TEXT (not symengine
      ## Basics): reading Basics back out of the model env in .rxDelaySensAugment
      ## is subject to symengine's masked get/[[.  The RHS is re-parsed there with
      ## eval(parse(text=), envir=model) for differentiation (the safe pattern).
      assign(paste0("rx__pastRhs_", .pastState, "__"),
             paste(deparse(x[[3]]), collapse = " "), envir = envir)
      assign(paste0("rx__pastTau_", .pastState, "__"),
             paste(deparse(x[[2]][[3]]), collapse = " "), envir = envir)
      return(invisible(NULL))
    }
  }
  if (inherits(x[[3]], "numeric") || inherits(x[[3]], "integer")) {
    .isNum <- TRUE
    if (isEnv) {
      if (envir$..doConst) {
        assign(.var, x[[3]], envir = envir)
      }
    }
    .expr <- x[[3]]
  }
  if (isEnv) {
    .expr <- paste0(
      "with(envir,",
      .rxToSE(x[[3]],
              envir = envir
              ), ")"
    )
    # A variable that is referenced inside a history function (lag/lead/diff/...)
    # must be emitted as an lhs and bound as a bare symbol, so downstream uses
    # (including the history reference) stay symbolic and the defining line is not
    # inlined or dead-code eliminated.
    if (!is.null(envir$..laggedVars) && any(.var == envir$..laggedVars) &&
          !identical(x[[1]], quote(`~`))) {
      .val <- try(eval(parse(text = .expr)), silent = TRUE)
      if (!inherits(.val, "try-error")) {
        .rx <- paste0(rxFromSE(.var), "=", rxFromSE(.val))
        assign("..lhs", c(envir$..lhs, .rx), envir = envir)
        assign(.var, symengine::S(.var), envir = envir)
        return(invisible(NULL))
      }
    }
    if (regexpr(rex::rex(or(
      .regRate,
      .regDur,
      .regLag,
      .regF,
      regIni0,
      regDDt
    )), .var) != -1) {
      ## A d/dt(state) whose state is read by delay() is a genuine ODE, not a
      ## derivable sensitivity -- keep it in ..ddt.. even if its name matches the
      ## sensitivity convention.
      .ddtState <- if (regexpr(rex::rex(regDDt), .var) != -1) {
        sub(rex::rex(start, "rx__d_dt_", capture(anything), "__", end), "\\1", .var)
      } else {
        NA_character_
      }
      .isDelayedOde <- !is.na(.ddtState) &&
        !is.null(envir$..delayedStates) && (.ddtState %in% envir$..delayedStates)
      if (!.isDelayedOde && regexpr(
        rex::rex(or(regSens, regSensEtaTheta)),
        .var
      ) != -1) {
        .lst <- get("..sens0..", envir = envir)
        .lst[[.var]] <- .expr
        assign("..sens0..", .lst, envir = envir)
      } else {
        .lst <- get("..ddt..", envir = envir)
        .lst[[.var]] <- .expr
        assign("..ddt..", .lst, envir = envir)
      }
    } else if (regexpr(rex::rex(or(
      regDfDy,
      regDfDyTh
    )), .var) != -1) {
      .lst <- get("..jac0..", envir = envir)
      .lst[[.var]] <- .expr
      assign("..jac0..", .lst, envir = envir)
    } else if (!identical(x[[1]], quote(`~`))) {
      if (is.call(x[[3]]) && identical(as.character(x[[3]][[1]]), "linCmt")) {
        assign(.var, symengine::S(.var), envir = envir)
        .name <- rxFromSE(.var)
        .rx <- paste0(.name, "=", paste(deparse(x[[3]]), collapse = ""))
        if (regexpr("^(nlmixr|rx)_", .var) == -1) {
          assign("..lhs", c(envir$..lhs, .rx), envir = envir)
        }
        return(invisible(NULL))
      }
      .expr <- try(eval(parse(text = .expr)), silent = TRUE)
      .isNum <- (inherits(.expr, "numeric") || inherits(.expr, "integer"))
      if ((.isNum && envir$..doConst) ||
            (!.isNum)) {
        assign(.var, .expr, envir = envir)
      }
      .name <- rxFromSE(.var)
      .rx <- paste0(
        .name, "=",
        rxFromSE(.expr)
      )
      if (regexpr("^(nlmixr|rx)_", .var) == -1) {
        if (.isNum) {
          names(.rx) <- .name
          assign("..lhs0", c(envir$..lhs0, .rx),
                 envir = envir
                 )
        } else {
          if (any(names(envir$..lhs0) == .name)) {
            .tmp <- envir$..lhs0
            .tmp <- .tmp[names(.tmp) != .name]
            assign("..lhs0", .tmp, envir = envir)
          }
          assign("..lhs", c(envir$..lhs, .rx),
                 envir = envir
                 )
        }
      }
    } else {
      # Suppressed (`~`) intermediate: never an output column, it exists only to
      # be substituted into downstream expressions.  Always bind it so references
      # resolve -- even a literal constant (e.g. `rx_expr_3 ~ 0`) with
      # doConst=FALSE, which otherwise leaks as an undefined phantom parameter.
      .expr <- eval(parse(text = .expr))
      assign(.var, .expr, envir = envir)
      .rx <- paste0(
        rxFromSE(.var), "=",
        rxFromSE(.expr)
      )
    }
  }
}

.rxToSESquareBracket <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .type <- toupper(as.character(x[[2]]))
  if (any(.type == c("THETA", "ETA"))) {
    if (is.numeric(x[[3]])) {
      .num <- x[[3]]
      if (round(.num) == .num) {
        if (.num > 0) {
          if (isEnv) {
            if (.type == "THETA") {
              if (exists("..maxTheta", envir = envir)) {
                .m <- get("..maxTheta", envir = envir)
              } else {
                .m <- 0
              }
              .m <- max(.m, .num)
              .funs <- envir$..curCall
              .funs <- .funs[.funs != ""]
              if (length(.funs) > 0) {
                .funs <- paste(.funs, collapse = ".")
                envir$..extraTheta[[.funs]] <-
                  unique(c(
                    envir$..extraTheta[[.funs]],
                    .num
                  ))
              }
              assign("..maxTheta", .m, envir = envir)
            } else {
              if (exists("..maxEta", envir = envir)) {
                .m <- get("..maxEta", envir = envir)
              } else {
                .m <- 0
              }
              .m <- max(.m, .num)
              .funs <- envir$..curCall
              .funs <- .funs[.funs != ""]
              if (length(.funs) > 0) {
                .funs <- paste(.funs, collapse = ".")
                envir$..extraEta[[.funs]] <-
                  unique(c(
                    envir$..extraEta[[.funs]],
                    .num
                  ))
              }
              assign("..maxEta", .m, envir = envir)
            }
          }
          return(paste0(.type, "_", .num, "_"))
        } else {
          stop("only 'THETA[#]' or 'ETA[#]' are supported", call. = FALSE)
        }
      } else {
        stop("only 'THETA[#]' or 'ETA[#]' are supported", call. = FALSE)
      }
    } else {
      stop("only 'THETA[#]' or 'ETA[#]' are supported", call. = FALSE)
    }
  } else {
    stop("only 'THETA[#]' or 'ETA[#]' are supported", call. = FALSE)
  }
}

.rxToSETad0 <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .len <- length(x)
  if (.len == 1L) {
  } else if (.len == 2L) {
    if (length(x[[2]]) != 1) {
      stop(as.character(x[[1]]), "() must be used with a state", call. = FALSE)
    }
    return(paste0("(t-tlast0(", as.character(x[[2]]), "))"))
  } else {
    stop(as.character(x[[1]]), "() can have 0-1 arguments", call. = FALSE)
  }
  return(paste0("(t-tlast0())"))
}

.rxToSETad <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .len <- length(x)
  if (.len == 1L) {
  } else if (.len == 2L) {
    if (length(x[[2]]) != 1) {
      stop(as.character(x[[1]]), "() must be used with a state", call. = FALSE)
    }
    return(paste0("(t-tlast(", as.character(x[[2]]), "))"))
  } else {
    stop(as.character(x[[1]]), "() can have 0-1 arguments", call. = FALSE)
  }
  return(paste0("(t-tlast())"))
}

.rxToSELagOrLead <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .len <- length(x)
  .fun <- as.character(x[[1]])
  # lag()/lead() reference the previous/next record value of a *variable*, so the
  # variable must stay a symbol.  In a symengine environment the assignment eval
  # (`with(envir, ...)`) would otherwise inline an lhs variable's definition and
  # break the call, so wrap the variable in symengine::S("var") to keep it a raw
  # symbol; it round-trips back to the bare name in rxFromSE().
  .vref <- function(v) if (isEnv) paste0("symengine::S(\"", v, "\")") else v
  if (.len == 1L) {
    stop(.fun, "() takes 1-2 arguments")
  } else if (.len == 2L) {
    if (length(x[[2]]) != 1) {
      stop(.fun, "() must be used with a variable", call. = FALSE)
    }
    return(paste0(.fun, "(", .vref(as.character(x[[2]])), ")"))
  } else if (.len == 3L) {
    if (length(x[[2]]) != 1) {
      stop(.fun, "() must be used with a variable", call. = FALSE)
    }
    if (length(x[[3]]) != 1) {
      stop(.fun, "(", as.character(x[[2]]), ", #) must have an integer for the number of lagged doses", call. = FALSE)
    }
    if (regexpr(rex::rex(maybe(one_of("-", "+")), regDecimalint), as.character(x[[3]]), perl = TRUE) == -1) {
      stop(.fun, "(", as.character(x[[2]]), ", #) must have an integer for the number of lagged doses", call. = FALSE)
    }
    return(paste0(.fun, "(", .vref(as.character(x[[2]])), ", ", as.character(x[[3]]), ")"))
  } else {
    stop(as.character(x[[1]]), "() can have 0-1 arguments", call. = FALSE)
  }
  return(paste0("(t-tfirst())"))
}

.rxToSETlastOrTafd <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .len <- length(x)
  if (.len == 1L) {
  } else if (.len == 2L) {
    if (length(x[[2]]) != 1) {
      stop(as.character(x[[1]]), "() must be used with a state", call. = FALSE)
    }
    return(paste0("(t-tfirst(", as.character(x[[2]]), "))"))
  } else {
    stop(as.character(x[[1]]), "() can have 0-1 arguments", call. = FALSE)
  }
  return(paste0("(t-tfirst())"))
}

.rxToSETlastOrTafd0 <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .len <- length(x)
  if (.len == 1L) {
  } else if (.len == 2L) {
    if (length(x[[2]]) != 1) {
      stop(as.character(x[[1]]), "() must be used with a state", call. = FALSE)
    }
    return(paste0("(t-tfirst0(", as.character(x[[2]]), "))"))
  } else {
    stop(as.character(x[[1]]), "() can have 0-1 arguments", call. = FALSE)
  }
  return(paste0("(t-tfirst0())"))
}

.rxToSETlastOrTfirst <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .len <- length(x)
  if (.len == 1L) {
    if (identical(x[[1]], quote(`podo`))) {
      return(paste0("podo(", .rxLastAssignedDdt, ")"))
    }
    if (identical(x[[1]], quote(`podo0`))) {
      return(paste0("podo0(", .rxLastAssignedDdt, ")"))
    }
  } else if (.len == 2L) {
    if (length(x[[2]]) != 1) {
      stop(as.character(x[[1]]), "() must be used with a state", call. = FALSE)
    }
    return(paste0(as.character(x[[1]]), "(", as.character(x[[2]]), ")"))
  } else {
    stop(as.character(x[[1]]), "() can have 0-1 arguments", call. = FALSE)
  }
  return(paste0(as.character(x[[1]]), "()"))
}

.rxToSEDelay <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  # delay(state, T) is the value of `state` at the past time t - T.  It is kept
  # as a function call so it round-trips back to delay() in any generated code,
  # and its derivative with respect to any variable is zero (a delayed/past
  # state does not depend on the current state); see the lag/lead handling in
  # rxFromSE().
  if (length(x) != 3L) {
    stop("'delay' takes 2 arguments 'delay(state, T)'", call. = FALSE)
  }
  if (length(x[[2]]) != 1) {
    stop("the first argument to 'delay' must be an ODE state 'delay(state, T)'", call. = FALSE)
  }
  .t <- .rxToSE(x[[3]], envir = envir)
  ## also handles rxDelayD() (the delayed time-derivative); keep the function
  ## name so it round-trips and differentiates to 0 like delay().
  paste0(as.character(x[[1]]), "(", as.character(x[[2]]), ", ", .t, ")")
}

.rxToSEPsigamma <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x == 3)) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "psigamma")
    }
    .a <- .rxToSE(x[[2]], envir = envir)
    .b <- .rxToSE(x[[3]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(paste0("polygamma(", .b, ",", .a, ")"))
  } else {
    stop("'psigamma' takes 2 arguments", call. = FALSE)
  }
}

.rxToSELog1pmx <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x == 2)) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "log")
    }
    .a <- .rxToSE(x[[2]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(paste0("(log(1+", .a, ")-(", .a, "))"))
  } else {
    stop("'log1pmx' only takes 1 argument", call. = FALSE)
  }
}

.rxToSEChoose <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x) == 3) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "gamma")
    }
    .n <- .rxToSE(x[[2]], envir = envir)
    .k <- .rxToSE(x[[3]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(paste0(
      "gamma(", .n, "+1)/(gamma(",
      .k, "+1)*gamma(", .n, "-(", .k, ")+1))"
    ))
  } else {
    stop("'choose' takes 2 arguments", call. = FALSE)
  }
}

.rxToSELchoose <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x) == 3) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "lgamma")
    }
    .n <- .rxToSE(x[[2]], envir = envir)
    .k <- .rxToSE(x[[3]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(paste0("(lgamma(", .n, "+1)-lgamma(", .k, "+1)-lgamma(", .n, "-(", .k, ")+1))"))
  } else {
    stop("'lchoose' takes 2 arguments", call. = FALSE)
  }
}

.rxToSEPnorm <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x) == 4) {
    ## pnorm(q, mean, sd)
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..currCall <- c(envir$..curCall, "erf")
    }
    .q <- .rxToSE(x[[2]], envir = envir)
    .mean <- .rxToSE(x[[3]], envir = envir)
    .sd <- .rxToSE(x[[4]], envir = envir)
    return(paste0("0.5*(1+erf((((", .q, ")-(", .mean, "))/(", .sd, "))/sqrt(2)))"))
  } else if (length(x) == 3) {
    ## pnorm(q, mean)
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..currCall <- c(envir$..curCall, "erf")
    }
    .q <- .rxToSE(x[[2]], envir = envir)
    .mean <- .rxToSE(x[[3]], envir = envir)
    return(paste0("0.5*(1+erf((((", .q, ")-(", .mean, ")))/sqrt(2)))"))
  } else if (length(x) == 2) {
    ## pnorm(q)
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..currCall <- c(envir$..curCall, "erf")
    }
    .q <- .rxToSE(x[[2]], envir = envir)
    return(paste0("0.5*(1+erf((", .q, ")/sqrt(2)))"))
  } else {
    stop("'pnorm' can only take 1-3 arguments", call. = FALSE)
  }
}

.rxToSEd4GELU <- function(x, envir=NULL, progress=FALSE, isEnv=TRUE) {
  if (length(x) == 2) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "d4GELU")
    }
    .x <- .rxToSE(x[[2]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(
      paste0("exp(-(", .x, ")^2/2)*(7*(", .x, ")^2 - 4 - (", .x, ")^4)/sqrt(2*pi)")
    )
  } else {
    stop("'d4GELU' can only take 1 argument", call. = FALSE)
  }
}

.rxToSEd4softplus <- function(x, envir=NULL, progress=FALSE, isEnv=TRUE) {
  if (length(x) == 2) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "d4softplus")
    }
    .x <- .rxToSE(x[[2]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    .ex1 <- paste0("(1.0 + exp(-(", .x, ")))")
    return(
      paste0("6.0*exp(-3.0*(", .x, "))/((", .ex1,
             ")^4) - 6.0*exp(-2.0*(", .x, "))/((", .ex1,
             ")^3) + exp(-(", .x, "))/((", .ex1, ")^2)")
    )
  } else {
    stop("'d4softplus' can only take 1 argument", call. = FALSE)
  }
}

.rxToSEdSELU <- function(x, envir=NULL, progress=FALSE, isEnv=TRUE) {
  if (length(x) == 2) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "dSELU")
    }
    .x <- .rxToSE(x[[2]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(
      paste0("(rxGt(", .x, ", 0)*1.0507009873554804934193349852946 + 1.0507009873554804934193349852946*1.6732632423543772848170429916717*exp(", .x, ")*rxLeq(", .x, ", 0))")
    )
  } else {
    stop("'dSELU' can only take 1 argument", call. = FALSE)
  }

}

.rxToSEdSwish <- function(x, envir=NULL, progress=FALSE, isEnv=TRUE) {
  if (length(x) == 2) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "dSwish")
    }
    .x <- .rxToSE(x[[2]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    # x*exp(-x)/(1.0 + exp(-x))^2 + (1.0 + exp(-x))^(-1);
    return(
      paste0("((", .x, ")*exp(-(", .x, "))/(1.0 + exp(-(", .x,
             ")))^2 + 1.0/(1.0 + exp(-(", .x, ")))")
      )
  } else {
    stop("'dSwish' can only take 1 argument", call. = FALSE)
  }

}


# Convert the mix() expression to a if clause with mixest for symengine
.rxToSEMix <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  .expr <- vapply(seq_along(x), function(i) {
    if (i %% 2 == 0)  {
      # Noting that argument 1 is the function name,
      # The even arguments are the mixture values
      paste0("rxEq(mixest, ", i/2, ")*(", .rxToSE(x[[i]], envir = envir, progress = progress), ")")
    } else {
      ""
    }
  }, character(1L), USE.NAMES = FALSE)
  paste0("(", paste(.expr[nzchar(.expr)], collapse="+"), ")")
}

.rxToSETransit <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (length(x) == 4) {
    ## transit(n, mtt, bio)
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "lgamma")
    }
    .n <- .rxToSE(x[[2]], envir = envir)
    if (isEnv) {
      envir$..curCall <- .lastCall
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "log")
    }
    .mtt <- .rxToSE(x[[3]], envir = envir)
    .bio <- .rxToSE(x[[4]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(paste0(
      "exp(log((", .bio, ")*(podo0(", .rxLastAssignedDdt, ")))+log(",
      .n, " + 1)-log(", .mtt, ")+(", .n,
      ")*((log(", .n, "+1)-log(", .mtt,
      "))+log(t-tlast0(", .rxLastAssignedDdt, ")))-((", .n, "+1)/(", .mtt,
      "))*(t-tlast0(", .rxLastAssignedDdt, "))-lgamma(1+", .n, "))"
    ))
  } else if (length(x) == 3) {
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(envir$..curCall, "lgamma")
    }
    .n <- .rxToSE(x[[2]], envir = envir)
    .mtt <- .rxToSE(x[[3]], envir = envir)
    if (isEnv) envir$..curCall <- .lastCall
    return(paste0("exp(log(podo0(", .rxLastAssignedDdt, "))+(log(", .n, "+1)-log(", .mtt, "))+(", .n, ")*((log(", .n, "+1)-log(", .mtt, "))+ log(t-tlast0(", .rxLastAssignedDdt, ")))-((", .n, " + 1)/(", .mtt, "))*(t-tlast0(",.rxLastAssignedDdt, "))-lgamma(1+", .n, "))"))
  } else {
    stop("'transit' can only take 2-3 arguments", call. = FALSE)
  }
}

.rxToSEMax <- function(x, min=FALSE) {
  # Based on https://stackoverflow.com/questions/30738923/max-implemented-with-basic-operators
  if (length(x) == 0) return("")
  if (length(x) == 1) return(paste0("(", x[1], ")"))
  .x2 <- x[1:2]
  .xrest <- x[-(1:2)]
  .a <- paste0(.x2[1])
  .b <- paste0(.x2[2])
  .cmp <- ifelse(min, "rxLt", "rxGt")
  .av <- suppressWarnings(as.numeric(.x2[1]))
  .bv <- suppressWarnings(as.numeric(.x2[2]))
  if (identical(.av, 0)) {
    return(paste0("((", .b, ")*", .cmp, "(", .b, ",0))"))
  }
  if (identical(.bv, 0)) {
    return(paste0("((", .a, ")*", .cmp, "(", .a,",0))"))
  }
  .ret <- paste0("(((", .a, ")-(", .b, "))*", .cmp, "(", .a, ",", .b, ")+(", .b, "))")
  if (length(.xrest) == 0) return(.ret)
  return(.rxToSEMax(c(.ret, .xrest), min=min))
}

.rxToSElinCmt <- new.env(parent=emptyenv())
.rxToSElinCmt$linCmt <- NULL


#' This saves the linCmt information to the .rxToSElinCmt environment
#'
#' This is useful when trying to convert the depot and other states
#' defined by the linear compartment to `linCmtA` or `linCmtB` to the
#' function.
#'
#' @param expr language based expression to save information for.
#'
#' @return nothing, called for side effects
#'
#' @noRd
#'
#' @author Matthew L. Fidler
.rxSEsaveLinCmt <- function(expr) {
  if (is.null(.rxToSElinCmt$linCmt)) stop(".rxToSElinCmt$linCmt is NULL")
  if (!exists("t", envir=.rxToSElinCmt)) {
    if (.rxToSElinCmt$linCmt == "linCmtA") {
      # [[1]] == linCmtA
      # [[2]] == rx__PTR__
      .rxToSElinCmt$t <- expr[[3]]
      .rxToSElinCmt$linCmtN <- expr[[4]]
      .rxToSElinCmt$ncmt <- expr[[5]]
      .rxToSElinCmt$oral0 <- expr[[6]]
      # [[7]] = which
      .rxToSElinCmt$trans <- expr[[8]]
      .rxToSElinCmt$p1 <- expr[[9]]
      .rxToSElinCmt$v1 <- expr[[10]]
      .rxToSElinCmt$p2 <- expr[[11]]
      .rxToSElinCmt$p3 <- expr[[12]]
      .rxToSElinCmt$p4 <- expr[[13]]
      .rxToSElinCmt$p5 <- expr[[14]]
      .rxToSElinCmt$ka <- expr[[15]]
      # linCmtA(rx__PTR__, t, linCmt, ncmt, oral0, which, trans,
      #         p1, v1, p2, p3, p4, p5, ka)
    } else {
      # linCmtB(rx__PTR__, t, linCmt, ncmt, oral0, which1, which2, trans,
      #         p1, v1, p2, p3, p4, p5, ka)
      # [[1]] == linCmtB
      # [[2]] == rx__PTR__
      .rxToSElinCmt$t <- expr[[3]]
      .rxToSElinCmt$linCmtN <- expr[[4]]
      .rxToSElinCmt$ncmt <- expr[[5]]
      .rxToSElinCmt$oral0 <- expr[[6]]
      # [[7]] = which1
      # [[8]] = which2
      .rxToSElinCmt$trans <- expr[[9]]
      .rxToSElinCmt$p1 <- expr[[10]]
      .rxToSElinCmt$v1 <- expr[[11]]
      .rxToSElinCmt$p2 <- expr[[12]]
      .rxToSElinCmt$p3 <- expr[[13]]
      .rxToSElinCmt$p4 <- expr[[14]]
      .rxToSElinCmt$p5 <- expr[[15]]
      .rxToSElinCmt$ka <- expr[[16]]
    }
  } else {
    if (.rxToSElinCmt$linCmt != expr[[1]]) {
      stop("linCmtA and linCmtB cannot be used in the same model", call. = FALSE)
    }
    if (.rxToSElinCmt$linCmt == "linCmtA") {
      # [[1]] == linCmtA
      # [[2]] == rx__PTR__
      err <- NULL
      if (!identical(.rxToSElinCmt$t, expr[[3]])) {
        err <- c(err, "t")
      }
      if (!identical(.rxToSElinCmt$linCmtN, expr[[4]])) {
        err <- c(err, "linCmtN")
      }
      if (!identical(.rxToSElinCmt$ncmt, expr[[5]])) {
        err <- c(err, "ncmt")
      }
      if (!identical(.rxToSElinCmt$oral0, expr[[6]])) {
        err <- c(err, "oral0")
      }
      if (!identical(.rxToSElinCmt$trans, expr[[8]])) {
        err <- c(err, "trans")
      }
      if (!identical(.rxToSElinCmt$p1, expr[[9]])) {
        err <- c(err, "p1")
      }
      if (!identical(.rxToSElinCmt$v1, expr[[10]])) {
        err <- c(err, "v1")
      }
      if (!identical(.rxToSElinCmt$p2, expr[[11]])) {
        err <- c(err, "p2")
      }
      if (!identical(.rxToSElinCmt$p3, expr[[12]])) {
        err <- c(err, "p3")
      }
      if (!identical(.rxToSElinCmt$p4, expr[[13]])) {
        err <- c(err, "p4")
      }
      if (!identical(.rxToSElinCmt$p5, expr[[14]])) {
        err <- c(err, "p5")
      }
      if (!identical(.rxToSElinCmt$ka, expr[[15]])) {
        err <- c(err, "ka")
      }
      if (!is.null(err)) {
        stop(paste0("linCmtA needs exactly the same arguments: ",
                    paste(err, collapse = ", ")),
             call. = FALSE)
      }
    } else {
      # linCmtB(rx__PTR__, t, linCmt, ncmt, oral0, which1, which2, trans,
      #         p1, v1, p2, p3, p4, p5, ka)
      # [[1]] == linCmtB
      # [[2]] == rx__PTR__
      err <- NULL
      if (!identical(.rxToSElinCmt$t, expr[[3]])) {
        err <- c(err, "t")
      }
      if (!identical(.rxToSElinCmt$linCmtN, expr[[4]])) {
        err <- c(err, "linCmtN")
      }
      if (!identical(.rxToSElinCmt$ncmt, expr[[5]])) {
        err <- c(err, "ncmt")
      }
      if (!identical(.rxToSElinCmt$oral0, expr[[6]])) {
        err <- c(err, "oral0")
      }
      if (!identical(.rxToSElinCmt$trans, expr[[9]])) {
        err <- c(err, "trans")
      }
      if (!identical(.rxToSElinCmt$p1, expr[[10]])) {
        err <- c(err, "p1")
      }
      if (!identical(.rxToSElinCmt$v1, expr[[11]])) {
        err <- c(err, "v1")
      }
      if (!identical(.rxToSElinCmt$p2, expr[[12]])) {
        err <- c(err, "p2")
      }
      if (!identical(.rxToSElinCmt$p3, expr[[13]])) {
        err <- c(err, "p3")
      }
      if (!identical(.rxToSElinCmt$p4, expr[[14]])) {
        err <- c(err, "p4")
      }
      if (!identical(.rxToSElinCmt$p5, expr[[15]])) {
        err <- c(err, "p5")
      }
      if (!identical(.rxToSElinCmt$ka, expr[[16]])) {
        err <- c(err, "ka")
      }
      if (!is.null(err)) {
        stop(paste0("linCmtB needs exactly the same arguments: ",
                    paste(err, collapse = ", ")),
             call. = FALSE)
      }
    }
  }
}

#' This is used converting the rxode2 functions to a symengine call
#'
#' @param x language object that is a call
#' @param envir environment that has information
#' @param progress boolean telling if the progress bar should be shown
#' @param isEnv boolean to indicate if the environment is a rxode2 environment
#' @return string representing the translation
#' @noRd
#' @author Matthew L. Fidler
.rxToSECall <- function(x, envir = NULL, progress = FALSE, isEnv=TRUE) {
  if (identical(x[[1]], quote(`(`))) {
    return(paste0("(", .rxToSE(x[[2]], envir = envir), ")"))
  } else if (identical(x[[1]], quote(`{`))) {
    return(.rxToSECurlyBrace(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`*`)) ||
               identical(x[[1]], quote(`^`)) ||
               identical(x[[1]], quote(`+`)) ||
               identical(x[[1]], quote(`-`)) ||
               identical(x[[1]], quote(`/`))) {
    return(.rxToSEArithmeticOperators(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`=`)) ||
               identical(x[[1]], quote(`<-`)) ||
               identical(x[[1]], quote(`~`))) {
    if (length(x[[2]]) == 2 &&
          identical(x[[2]][[1]], quote(`levels`))) {
      return("")
    }
    return(.rxToSEAssignOperators(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`[`))) {
    return(.rxToSESquareBracket(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`tad`))) {
    return(.rxToSETad(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`tad0`))) {
    return(.rxToSETad0(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`lag`)) ||
               identical(x[[1]], quote(`lead`)) ||
               identical(x[[1]], quote(`lag0`)) ||
               identical(x[[1]], quote(`lead0`))) {
    return(.rxToSELagOrLead(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`delay`)) ||
               identical(x[[1]], quote(`rxDelayD`)) ||
               identical(x[[1]], quote(`rxDelayD2`)) ||
               identical(x[[1]], quote(`rxDelayD3`))) {
    return(.rxToSEDelay(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`tafd`))) {
    return(.rxToSETlastOrTafd(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`tafd0`))) {
    return(.rxToSETlastOrTafd0(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`tlast`)) ||
               identical(x[[1]], quote(`tfirst`)) ||
               identical(x[[1]], quote(`tlast0`)) ||
               identical(x[[1]], quote(`tfirst0`)) ||
               identical(x[[1]], quote(`dose`)) ||
               identical(x[[1]], quote(`podo`)) ||
               identical(x[[1]], quote(`dose0`)) ||
               identical(x[[1]], quote(`podo0`))) {
    return(.rxToSETlastOrTfirst(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`psigamma`))) {
    return(.rxToSEPsigamma(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`log1pmx`))) {
    return(.rxToSELog1pmx(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`choose`))) {
    return(.rxToSEChoose(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`lchoose`))) {
    return(.rxToSELchoose(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if ((identical(x[[1]], quote(`pnorm`))) ||
               (identical(x[[1]], quote(`normcdf`))) ||
               (identical(x[[1]], quote(`phi`)))) {
    return(.rxToSEPnorm(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`transit`))) {
    return(.rxToSETransit(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`mix`))) {
    return(.rxToSEMix(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`abs`)) ||
               identical(x[[1]], quote(`fabs`)) ||
               identical(x[[1]], quote(`abs0`))) {
    if (length(x) != 2) stop("abs only takes 1 argument", call.=FALSE)
    .r <- .rxToSE(x[[2]], envir = envir)
    return(paste0("(2.0*(", .r, ")*rxGt(", .r, ",0.0)-(", .r, "))"))
  } else if (identical(x[[1]], quote(`d4GELU`))) {
    return(.rxToSEd4GELU(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`d4softplus`))) {
    return(.rxToSEd4softplus(x, envir = envir, progress = progress, isEnv=isEnv))
  } else if (identical(x[[1]], quote(`dSELU`))) {
    .rxToSEdSELU(x, envir=envir, progress=progress, isEnv=isEnv)
  } else if (identical(x[[1]], quote(`dSwish`))) {
    .rxToSEdSwish(x, envir=envir, progress=progress, isEnv=isEnv)
  } else {
    if (length(x[[1]]) == 1) {
      .x1 <- as.character(x[[1]])
      .xc <- .rxSEsingle[[.x1]]
      if (!is.null(.xc)) {
        if (length(x) == 2) {
          if (isEnv) {
            .lastCall <- envir$..curCall
            envir$..curCall <- c(envir$..curCall, .xc[3])
          }
          .ret <- paste0(
            .xc[1], .rxToSE(x[[2]], envir = envir),
            .xc[2]
          )
          if (isEnv) envir$..curCall <- .lastCall
          return(.ret)
        } else {
          stop(sprintf("'%s' only accepts 1 argument", .x1), call. = FALSE)
        }
      }
      .xc <- .rxSEdouble[[.x1]]
      if (!is.null(.xc)) {
        .x1 <- as.character(x[[1]])
        if (length(x) == 3) {
          .ret <- paste0(
            .xc[1], .rxToSE(x[[2]], envir = envir),
            .xc[2],
            .rxToSE(x[[3]], envir = envir),
            .xc[3]
          )
          return(.ret)
        } else {
          stop(sprintf("'%s' only acceps 2 arguments", .x1), call. = FALSE)
        }
      }
    }
    if (isEnv) {
      .lastCall <- envir$..curCall
      envir$..curCall <- c(
        envir$..curCall,
        as.character(x[[1]])
      )
    }
    .fun0 <- as.character(x[[1]])
    if (.fun0 %in% c("dur", "rate", "lag", "alag", "f", "F")) {
      .ret0 <- c(list(as.character(x[[1]])),
                 lapply(x[-1], as.character, envir = envir))
    } else {
      .ret0 <- c(list(as.character(x[[1]])),
                 lapply(x[-1], .rxToSE, envir = envir))
    }
    if (isEnv) envir$..curCall <- .lastCall
    .SEeq <- c(.rxSEeq, rxode2::.rxSEeqUsr())
    .curName <- paste(.ret0[[1]])
    .nargs <- .SEeq[.curName]
    if (.curName == "linCmtA") {
      # Save the information about the model so that
      # depot and the rest can be converted to the right equivalent
      # linear compartment model
      if (.promoteLinB) {
        # linCmtA(rx__PTR__, t, linCmt, ncmt, oral0, which, trans,
        #         p1, v1, p2, p3, p4, p5, ka)
        # linCmtB(rx__PTR__, t, linCmt, ncmt, oral0, which1, which2, trans,
        #         p1, v1, p2, p3, p4, p5, ka)
        .rxToSElinCmt$linCmt <- "linCmtB"
        .which <- eval(str2lang(.ret0[[7]]))
        if (.which == -1) {
          # Linear compartment solution
          .ret0 <- c(
            list("linCmtB"),
            .ret0[2:6],
            list("-1", "-1"),
            .ret0[-c(1, 2:7)]
          )
        } else {
          # Compartment value, convert to the corresponding compartment
          # value
          .ret0 <- c(
            list("linCmtB"),
            .ret0[2:6],
            list(paste0(.which), "-2"),
            .ret0[-c(1, 2:7)]
          )
        }
        .nargs <- .nargs + 1
      } else {
        .rxToSElinCmt$linCmt <- "linCmtA"
      }
      .rxSEsaveLinCmt(.ret0)
    }
    if (!is.na(.nargs)) {
      if (.nargs == length(.ret0) - 1) {
        .ret <- paste0(.ret0[[1]], "(")
        .ret0 <- .ret0[-1]
        .ret <- paste0(.ret, paste(unlist(.ret0), collapse = ","), ")")
        if (.ret == "exp(1)") {
          return("E")
        }
        return(.ret)
      } else {
        stop(sprintf(
          gettext("'%s' takes %s arguments (has %s)"),
          paste(.ret0[[1]]),
          .nargs, length(.ret0) - 1
        ), call. = FALSE)
      }
    } else {
      .fun <- paste(.ret0[[1]])
      .ret0 <- .ret0[-1]
      if (.fun == "linCmt") {
        return(paste0("linCmt(", paste(unlist(.ret0), collapse = ", "), ")"))
      }
      if (.fun == "past") {
        ## past(state, tau) <- expr : non-constant delay() pre-history.  Keyed by
        ## state (one past() per state); tau is carried separately.  Returns a
        ## flat per-state symbol so it never reaches symengine differentiation.
        return(paste0("rx_past_", .ret0[[1]], "_"))
      }
      if (length(.ret0) == 1L) {
        if (any(.fun == c("alag", "lag"))) {
          return(paste0("rx_lag_", .ret0[[1]], "_"))
        } else if (any(.fun == c("F", "f"))) {
          return(paste0("rx_f_", .ret0[[1]], "_"))
        } else if (any(.fun == c("rate", "dur"))) {
          return(paste0("rx_", .fun, "_", .ret0[[1]], "_"))
        }
      }
      .ret <- paste0("(", paste(unlist(.ret0), collapse = ","), ")")
      if (.ret == "(0)") {
        return(paste0("rx_", .fun, "_ini_0__"))
      } else if (any(.fun == c("cmt", "dvid", "mtime", "matExp", "indLin"))) {
        return("")
      } else if (.fun == "max") {
        .ret <- .rxToSEMax(unlist(.ret0), min=FALSE)
      } else if (.fun == "min") {
        .ret <- .rxToSEMax(unlist(.ret0), min=TRUE)
      } else if (.fun == "sum") {
        .ret <- paste0("(", paste(paste0("(", unlist(.ret0), ")"), collapse = "+"), ")")
      } else if (.fun == "prod") {
        .ret <- paste0("(", paste(paste0("(", unlist(.ret0), ")"), collapse = "*"), ")")
      } else if (.fun == "probitInv") {
        ## erf <- function(x) 2 * pnorm(x * sqrt(2)) - 1 (probitInv=pnorm)
        if (length(.ret0) == 1) {
          .ret <- paste0("0.5*(1+erf((", unlist(.ret0)[1], ")/sqrt(2)))")
        } else if (length(.ret0) == 2) {
          .ret0 <- unlist(.ret0)
          .p <- paste0("0.5*(1+erf((", .ret0[1], ")/sqrt(2)))")
          ## return (high-low)*p+low;
          .ret <- paste0(
            "(1.0-(", .ret0[2], "))*(", .p,
            ")+(", .ret0[2], ")"
          )
        } else if (length(.ret0) == 3) {
          .ret0 <- unlist(.ret0)
          .p <- paste0("0.5*(1+erf((", .ret0[1], ")/sqrt(2)))")
          .ret <- paste0(
            "((", .ret0[3], ")-(", .ret0[2], "))*(", .p,
            ")+(", .ret0[2], ")"
          )
        } else {
          stop("'probitInv' requires 1-3 arguments",
               call. = FALSE
               )
        }
      } else if (.fun == "probit") {
        ## erfinv <- function (x) qnorm((1 + x)/2)/sqrt(2) (probit=qnorm )
        if (length(.ret0) == 1) {
          .ret <- paste0("sqrt(2)*erfinv(2*(", unlist(.ret0), ")-1)")
        } else if (length(.ret0) == 2) {
          .ret0 <- unlist(.ret0)
          .p <- paste0(
            "((", .ret0[1], ")-(", .ret0[2], "))/(1.0-",
            "(", .ret0[2], "))"
          )
          .ret <- paste0("sqrt(2)*erfinv(2*(", .p, ")-1)")
        } else if (length(.ret0) == 3) {
          .ret0 <- unlist(.ret0)
          ## (x-low)/(high-low)
          .p <- paste0(
            "((", .ret0[1], ")-(", .ret0[2],
            "))/((", .ret0[3], ")-(", .ret0[2], "))"
          )
          .ret <- paste0("sqrt(2)*erfinv(2*(", .p, ")-1)")
        } else {
          stop("'probit' requires 1-3 arguments",
               call. = FALSE
               )
        }
      } else if (.fun == "logit") {
        if (length(.ret0) == 1) {
          .ret <- paste0("-log(1/(", unlist(.ret0), ")-1)")
        } else if (length(.ret0) == 2) {
          .ret0 <- unlist(.ret0)
          .p <- paste0(
            "((", .ret0[1], ")-(", .ret0[2], "))/(1.0-",
            "(", .ret0[2], "))"
          )
          .ret <- paste0("-log(1/(", .p, ")-1)")
        } else if (length(.ret0) == 3) {
          .ret0 <- unlist(.ret0)
          ## (x-low)/(high-low)
          .p <- paste0(
            "((", .ret0[1], ")-(", .ret0[2],
            "))/((", .ret0[3], ")-(", .ret0[2], "))"
          )
          .ret <- paste0("-log(1/(", .p, ")-1)")
        } else {
          stop("'logit' requires 1-3 arguments",
               call. = FALSE
               )
        }
      } else if (any(.fun == c("expit", "invLogit", "logitInv"))) {
        if (length(.ret0) == 1) {
          .ret <- paste0("1/(1+exp(-(", unlist(.ret0)[1], ")))")
        } else if (length(.ret0) == 2) {
          .ret0 <- unlist(.ret0)
          .p <- paste0("1/(1+exp(-(", .ret0[1], ")))")
          ## return (high-low)*p+low;
          .ret <- paste0(
            "(1.0-(", .ret0[2], "))*(", .p,
            ")+(", .ret0[2], ")"
          )
        } else if (length(.ret0) == 3) {
          .ret0 <- unlist(.ret0)
          .p <- paste0("1/(1+exp(-(", .ret0[1], ")))")
          .ret <- paste0(
            "((", .ret0[3], ")-(", .ret0[2], "))*(", .p,
            ")+(", .ret0[2], ")"
          )
        } else {
          stop("'expit' requires 1-3 arguments",
               call. = FALSE
               )
        }
      } else {
        if (.fun %in% c("param", "dvid", "cmt", "locf", "nocb",
                        "midpoint", "linear", "splitBolus", "matExp", "indLin")) return(NULL)
        if (.fun %in% c("printf", "Rprintf", "print")) {
          return(paste(deparse(x), collapse=""))
        }
        .udf <- try(get(.fun, envir = .rxToSE.envir$parent, mode="function"), silent =TRUE)
        if (inherits(.udf, "try-error")) {
          .udf <- try(get(.fun, envir = rxode2::.udfEnvSet(NULL), mode="function"), silent =TRUE)
        }
        if (inherits(.udf, "try-error")) {
          stop(sprintf(gettext("function '%s' or its derivatives are not supported in rxode2"), .fun),
               call. = FALSE
               )
        } else {
          .f <- formals(.udf)
          if (any(names(.f)  == "...")) {
            stop(sprintf(gettext("R user function '%s' has variable number of arguments with'...' and is not supported in rxode2"), .fun),
                 call. = FALSE
                 )
          } else if (length(.ret0) == length(.f)) {
            if (is.environment(envir)) {
              assign(.fun, .rxFunction(.fun), envir = envir)
            }
            .ret0 <- unlist(.ret0)
            .ret <- paste0(.fun, "(",paste(.ret0, collapse=", "), ")")
          } else {
            stop(sprintf(gettext("user function '%s' requires %d arguments (supplied %d)"), .fun,
                         length(.f), length(.ret0)),
                 call. = FALSE
                 )
          }
        }
      }
    }
  }
}

#' @rdname rxToSE
#' @export
.rxToSE <- function(x, envir = NULL, progress = FALSE) {
  rxReq("symengine")
  .isEnv <- inherits(envir, "rxS") || inherits(envir, "environment")
  if (is.name(x) || is.atomic(x)) {
    return(.rxToSENameOrAtomic(x, envir=envir, progress=progress, isEnv=.isEnv))
  } else if (is.call(x)) {
    return(.rxToSECall(x, envir = envir, progress = progress, isEnv=.isEnv))
  } else {
    stop("unsupported expression", call. = FALSE)
  }
}

.rxUnXi <- function(x) {
  gsub("_xi_([[:digit:]]*)", "rx_xi_\\1", x)
}


## 0L = error
## 1L = forward
## 2L = central
.rxFromNumDer <- 0L
.rxDelta <- (.Machine$double.eps)^(1 / 3)

.rxFromSE.envir <- new.env(parent=emptyenv())
.rxFromSE.envir$parent <- NULL

#' @rdname rxToSE
#' @export
rxFromSE <- function(x, unknownDerivatives = c("forward", "central", "error"),
                     parent=parent.frame()) {
  rxReq("symengine")
  .udfEnvSet(parent)
  .rxFromSE.envir$parent <- parent
  .unknown <- c("central" = 2L, "forward" = 1L, "error" = 0L)
  assignInMyNamespace(".rxFromNumDer", .unknown[match.arg(unknownDerivatives)])
  if (is(substitute(x), "character")) {
    return(.rxFromSE(eval(parse(text = paste0("quote({", .rxUnXi(x), "})")))))
  } else if (is(substitute(x), "{")) {
    x <- deparse1(substitute(x))
    if (x[1] == "{") {
      x <- x[-1]
      x <- x[-length(x)]
    }
    x <- .rxUnXi(paste(x, collapse = "\n"))
    .ret <- .rxFromSE(eval(parse(text = paste0("quote({", x, "})"))))
    return(.ret)
  } else {
    .xc <- as.character(substitute(x))
    x <- substitute(x)
    if (length(.xc) == 1) {
      .found <- FALSE
      .frames <- seq(1, sys.nframe())
      .frames <- .frames[.frames != 0]
      for (.f in .frames) {
        .env <- parent.frame(.f)
        if (exists(.xc, envir = .env)) {
          .val2 <- try(get(.xc, envir = .env), silent = TRUE)
          if (inherits(.val2, "character")) {
            .val2 <- eval(parse(text = paste0("quote({", .rxUnXi(.val2), "})")))
            .ret <- .rxFromSE(.val2)
            return(.ret)
          } else if (inherits(.val2, "numeric") || inherits(.val2, "integer")) {
            return(sprintf("%s", .val2))
          } else {
            if (!is.null(attr(class(.val2), "package"))) {
              if (attr(class(.val2), "package") == "symengine") {
                .val2 <- eval(parse(text = paste0("quote({", .rxUnXi(as.character(.val2)), "})")))
                .ret <- .rxFromSE(.val2)
                return(.ret)
              }
            }
          }
        }
      }
    }
    x <- eval(parse(text = paste("quote(", .rxUnXi(paste(deparse1(x), collapse = " ")), ")")))
    .ret <- .rxFromSE(x)
    return(.ret)
  }
  x <- .rxUnXi(x)
  .ret <- .rxFromSE(eval(parse(text = paste0("quote({", x, "})"))))
  return(.ret)
}

.stripP <- function(x) {
  if (is.call(x)) {
    if (length(x) == 1) {
      return(x)
    } else if (identical(x[[1]], quote(`(`))) {
      return(.stripP(x[[2]]))
    } else {
      return(x)
    }
  } else {
    return(x)
  }
}

.rxM1rmF <- function(x) {
  .env <- new.env(parent = emptyenv())
  .env$found <- FALSE
  .f <- function(x, envir) {
    if (is.call(x)) {
      if (identical(x[[1]], quote(`*`))) {
        if (length(x) == 3) {
          .x2 <- as.character(x[[2]])
          .x3 <- as.character(x[[3]])
          if (length(.x3) == 1) {
            if (.x3 == "pi") {
              envir$found <- TRUE
              return(.rxFromSE(.stripP(x[[2]])))
            }
          }
          if (length(.x2) == 1) {
            if (.x2 == "pi") {
              envir$found <- TRUE
              return(.rxFromSE(.stripP(x[[3]])))
            }
          }
          return(paste0(
            .f(x[[2]], envir), "*",
            .f(x[[3]], envir)
          ))
        } else {
          return(.rxFromSE(x))
        }
      } else if (identical(x[[1]], quote(`/`))) {
        .x2 <- as.character(x[[2]])
        if (length(.x2) == 1) {
          if (.x2 == "pi") {
            envir$found <- TRUE
            x[[2]] <- 1
            return(.rxFromSE(x))
          }
          return(paste0(
            .f(x[[2]], envir), "/",
            .f(x[[3]], envir)
          ))
        }
        ## Compound numerator (eg sin(2*(time-a)/period)): recurse into both
        ## sides so a `pi` factor buried in the numerator is still stripped and
        ## the argument is not dropped (else the whole arg became NULL -> sin()).
        ## Parenthesize the numerator unless it is already parenthesized so the
        ## `/` precedence is preserved after any pi-factor stripping.
        .num <- .f(x[[2]], envir)
        if (!identical(x[[2]][[1]], quote(`(`))) {
          .num <- paste0("(", .num, ")")
        }
        return(paste0(.num, "/", .f(x[[3]], envir)))
      } else {
        return(.rxFromSE(x))
      }
    } else {
      return(.rxFromSE(x))
    }
  }
  .ret <- .f(x, .env)
  return(list(.ret, .env$found))
}

.rxP1rmF <- function(x) {
  .env <- new.env(parent = emptyenv())
  .env$found <- FALSE
  .f <- function(x, envir) {
    if (is.call(x)) {
      if (identical(x[[1]], quote(`+`))) {
        if (length(x) == 3) {
          if (inherits(x[[3]], "numeric")) {
            if (x[[3]] == 1) {
              envir$found <- TRUE
              return(.rxFromSE(.stripP(x[[2]])))
            } else {
              return(paste0(
                .f(x[[2]], envir),
                "+", as.character(x[[3]])
              ))
            }
          }
          if (inherits(x[[2]], "numeric")) {
            if (x[[2]] == 1) {
              envir$found <- TRUE
              return(.rxFromSE(.stripP(x[[3]])))
            } else {
              return(paste0(
                as.character(x[[2]]), "+",
                .f(x[[3]], envir)
              ))
            }
          }
          return(paste0(
            .f(x[[2]], envir), "+",
            .f(x[[3]], envir)
          ))
        } else {
          return(.rxFromSE(x))
        }
      } else if (identical(x[[1]], quote(`-`))) {
        if (length(x) == 3) {
          if (inherits(x[[2]], "numeric")) {
            if (x[[2]] == 1) {
              x <- x[-2]
              envir$found <- TRUE
              return(.rxFromSE(x))
            } else {
              return(.rxFromSE(x))
            }
          } else {
            return(.rxFromSE(x))
          }
        } else {
          return(.rxFromSE(x))
        }
      } else {
        return(.rxFromSE(x))
      }
    } else {
      return(.rxFromSE(x))
    }
  }
  .ret <- .f(x, .env)
  return(list(.ret, .env$found))
}

.rxFromSEnum <- function(x) {
  .ret <- as.character(x)
  .retl <- nchar(.ret)
  if (length(.retl) == 1L && .retl > 5) {
    .op <- options()
    options(digits = 22)
    on.exit(options(.op))
    .rx <- names(.rxSEcnt)
    .val <- setNames(.rxSEcnt, NULL)
    E <- exp(1)
    for (.i in seq_along(.rx)) {
      .tmp <- try(eval(parse(text = paste0("substr(paste(", .val[.i], "), 1, .retl)"))), silent = TRUE)
      if (!inherits(.tmp, "try-error")) {
        if (.ret == .tmp) {
          return(.rx[.i])
        }
      }
    }
  }
  return(.ret)
}

#' @export
#' @rdname rxToSE
.rxFromSE <- function(x) {
  rxReq("symengine")
  .cnst <- setNames(
    names(.rxSEreserved),
    paste0("rx_SymPy_Res_", names(.rxSEreserved))
  )
  if (is.name(x) || is.atomic(x)) {
    .ret <- .rxFromSEnum(x)
    .ret <- .rxRepRxQ(.ret)
    .ret0 <- .cnst[.ret]
    if (!is.na(.ret0)) {
      return(.ret0)
    }
    .ret0 <- .rxSEreserved[[.ret]]
    if (!is.null(.ret0)) {
      if (is.character(.ret0)) {
        return(.ret0)
      } else if (is.numeric(.ret0)) {
        return(sprintf("%.16f", .ret0))
      }
    }
    if (.ret == "E") {
      return("M_E")
    }
    .ret <- sub(
      .regRate, "rate(\\1)",
      sub(
        .regDur, "dur(\\1)",
        sub(
          .regLag, "alag(\\1)",
          sub(
            .regF, "f(\\1)",
            sub(
              regIni0, "\\1(0)",
              sub(
                regDfDy, "df(\\1)/dy(\\2)",
                sub(
                  regDfDyTh, "df(\\1)/dy(\\2[\\3])",
                  sub(
                    regDDt, "d/dt(\\1)",
                    sub(
                      rex::rex(start, regThEt, end),
                      "\\1[\\2]", .ret
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
    .ret <- sub("[(]rx_SymPy_Res_", "(", .ret)

    return(.ret)
  } else if (is.call(x)) {
    if (identical(x[[1]], quote(`(`))) {
      return(paste0("(", .rxFromSE(x[[2]]), ")"))
    } else if (identical(x[[1]], quote(`{`))) {
      .x2 <- x[-1]
      return(paste(lapply(.x2, function(x) {
        .ret <- .rxFromSE(x)
        return(.ret)
      }),
      collapse = "\n"
      ))
    } else if (identical(x[[1]], quote(`*`)) ||
      identical(x[[1]], quote(`^`)) ||
      identical(x[[1]], quote(`+`)) ||
      identical(x[[1]], quote(`-`)) ||
      identical(x[[1]], quote(`/`))) {
      if (length(x) == 3) {
        .x1 <- as.character(x[[1]])
        .x2 <- x[[2]]
        .x2 <- .rxFromSE(.x2)
        .x3 <- x[[3]]
        .x3 <- .rxFromSE(.x3)
        # eval in baseenv() so only numeric-constant subexpressions
        # canonicalize; the default frame's scope chain reaches the user's
        # global environment, leaking workspace variables into the
        # conversion (nlmixr2/rxode2#1109)
        .x3v <- try(eval(parse(text = .x3), envir = baseenv()), silent = TRUE)
        if (inherits(.x3v, "numeric") && length(.x3v) == 1L) {
          .x3 <- .rxFromSEnum(.x3v)
        }
        if (.x1 == "^" && .x3 == "1") {
          return(.x2)
        }
        if (.x1 == "^" && .x3 == "-1") {
          return(paste0("(1/(", .x2, "))"))
        }
        if (.x1 == "^" && is.numeric(x[[3]])) {
          if (round(x[[3]]) == x[[3]]) {
            return(paste0("Rx_pow_di(", .x2, ",", .x3, ")"))
          }
          if (.x3 == 0.5) {
            if (any(.x2 == c("pi", "M_PI"))) {
              return("M_SQRT_PI")
            } else if (any(.x2 == c("M_2_PI", "(M_2_PI)"))) {
              return("M_SQRT_2dPI")
            } else {
              return(paste0("sqrt(", .x2, ")"))
            }
          } else {
            return(paste0("Rx_pow(", .x2, ",", .x3, ")"))
          }
        }
        .ret <- paste0(.x2, .x1, .x3)
        ## FIXME parsing to figure out if *2 or *0.5 *0.4 is in
        ## expression
        if (any(.ret == c("pi*2", "2*pi", "M_PI*2", "2*M_PI"))) {
          return("M_2PI")
        }
        if (any(.ret == c("pi/2", "pi*0.5", "0.5*pi", "M_PI/2", "M_PI*0.5", "0.5*M_PI"))) {
          return("M_PI_2")
        }
        if (any(.ret == c("pi/4", "pi*0.25", "0.25*pi", "M_PI/4", "M_PI*0.25", "0.25*M_PI"))) {
          return("M_PI_4")
        }
        if (any(.ret == c("1/pi", "1/M_PI"))) {
          return("M_1_PI")
        }
        if (any(.ret == c("2/pi", "2/M_PI"))) {
          return("M_2_PI")
        }
        if (any(.ret == c(
          "(M_2_PI)^0.5", "(M_2_PI)^(1/2)",
          "M_2_PI^0.5", "M_2_PI^(1/2)",
          "sqrt((M_2_PI))"
        ))) {
          return("M_SQRT_2dPI")
        }
        if (any(.ret == c(
          "(pi)^0.5", "(pi)^(1/2)",
          "pi^0.5", "pi^(1/2)",
          "(M_PI)^0.5", "(M_PI)^(1/2)",
          "M_PI^0.5", "M_PI^(1/2)"
        ))) {
          return("M_SQRT_PI")
        }
        if (.ret == "log(2)/log(10)") {
          return("M_LOG10_2")
        }
        if (.ret == "1/log(10)") {
          return("M_LOG10E")
        }
        if (.ret == "1/log(2)") {
          return("M_LOG2E")
        }
        if (any(.ret == c("2/M_SQRT_PI", "2/(M_SQRT_PI)"))) {
          return("M_2_SQRTPI")
        }
        if (any(.ret == c(
          "1/sqrt(M_2PI)",
          "1/(sqrt((M_2PI)))",
          "1/(M_2PI^0.5)", "1/(M_2PI^(1/2))",
          "1/((M_2PI)^0.5)", "1/((M_2PI)^(1/2))"
        ))) {
          return("M_1_SQRT_2PI")
        }
        ## if (.x1 == "^") {
        ##   return(paste0("Rx_pow(", .x2, ",", .x3, ")"))
        ## }
        return(.ret)
      } else {
        ## Unary Operators
        .ret <- paste0(
          as.character(x[[1]]),
          .rxFromSE(x[[2]])
        )
        return(.ret)
      }
    } else if (identical(x[[1]], quote(`=`)) ||
      identical(x[[1]], quote(`<-`)) ||
      identical(x[[1]], quote(`~`))) {
      .var <- .rxFromSE(x[[2]])
      .val <- .rxFromSE(x[[3]])
    } else if (identical(x[[1]], quote(`[`))) {
      if (any(as.character(x[[2]]) == c("THETA", "ETA"))) {
        return(paste0(x[[2]], "[", x[[3]], "]"))
      }
      stop("[...] expressions not supported",
        call. = FALSE
      )
    } else if (identical(x[[1]], quote(`lag`)) ||
      identical(x[[1]], quote(`lead`)) ||
      identical(x[[1]], quote(`lag0`)) ||
      identical(x[[1]], quote(`lead0`))) {
      .a <- .rxFromSE(x[[2]])
      .fun <- as.character(x[[1]])
      if (length(x) == 3) {
        return(paste0(.fun, "(", .a, ",", .rxFromSE(x[[3]]), ")"))
      } else {
        return(paste0(.fun, "(", .a, ")"))
      }
    } else if (identical(x[[1]], quote(`delay`))) {
      return(paste0("delay(", .rxFromSE(x[[2]]), ", ", .rxFromSE(x[[3]]), ")"))
    } else if (identical(x[[1]], quote(`rxDelayD`))) {
      return(paste0("rxDelayD(", .rxFromSE(x[[2]]), ", ", .rxFromSE(x[[3]]), ")"))
    } else if (identical(x[[1]], quote(`rxDelayD2`))) {
      return(paste0("rxDelayD2(", .rxFromSE(x[[2]]), ", ", .rxFromSE(x[[3]]), ")"))
    } else if (identical(x[[1]], quote(`rxDelayD3`))) {
      return(paste0("rxDelayD3(", .rxFromSE(x[[2]]), ", ", .rxFromSE(x[[3]]), ")"))
    } else if (identical(x[[1]], quote(`polygamma`))) {
      if (length(x == 3)) {
        .a <- .rxFromSE(x[[2]])
        .b <- .rxFromSE(x[[3]])
        if (.a == "0") {
          return(paste0("digamma(", .b, ")"))
        } else if (.a == "1") {
          return(paste0("trigamma(", .b, ")"))
        } else if (.a == "2") {
          return(paste0("tetragamma(", .b, ")"))
        } else if (.a == "3") {
          return(paste0("pentagamma(", .b, ")"))
        } else {
          return(paste0(
            "psigamma(", .b, ",",
            .a, ")"
          ))
        }
      } else {
        stop("'polygamma' takes 2 arguments",
          call. = FALSE
        )
      }
    } else {
      if (length(x[[1]]) == 1) {
        .x1 <- as.character(x[[1]])
        .xc <- .SEsingle[[.x1]]
        if (!is.null(.xc)) {
          if (length(x) == 2) {
            .x2 <- x[[2]]
            if (length(.x2) != 1) {
              if (identical(.x2[[1]], quote(`+`))) {
                .tmp0 <- .SE1p[.x1]
                if (!is.na(.tmp0)) {
                  .ret <- .rxP1rmF(.x2)
                  if (.ret[[2]]) {
                    .r1 <- .ret[[1]]
                    return(paste0(
                      .tmp0, "(",
                      .r1,
                      ")"
                    ))
                  }
                }
                return(paste0(.xc[1], .x2[[1]], .xc[2]))
              }
            }
            return(paste0(.xc[1], .rxFromSE(x[[2]]), .xc[2]))
          } else {
            stop(sprintf("'%s' only acceps 1 argument", .x1),
              call. = FALSE
            )
          }
        }
        .xc <- .SEdouble[[.x1]]
        if (!is.null(.xc)) {
          if (length(x) == 3) {
            .x1 <- .rxFromSE(x[[1]])
            return(paste0(
              .xc[1], .rxFromSE(x[[2]]), .xc[2],
              .rxFromSE(x[[3]]),
              .xc[3]
            ))
          } else {
            stop(sprintf("'%s' only acceps 2 arguments", .x1),
              call. = FALSE
            )
          }
        }
      }
      if (length(x) == 2) {
        .isnan <- try(is.nan(x[[2]]), silent=TRUE)
        if (inherits(.isnan, "try-error")) .isnan <- FALSE
        if (.isnan) {
          if (as.character(x[[1]]) %in% .rxToSEDualVarFunction) {
            return(paste0(as.character(x[[1]]), "()"))
          }
        }
        if (identical(x[[1]], quote(`log`))) {
          if (length(x[[2]]) == 3) {
            if (identical(x[[2]][[1]], quote(`beta`))) {
              .tmp <- x[[2]]
              .tmp[[1]] <- quote(`lbeta`)
              return(.rxFromSE(.tmp))
            }
          }
        }
      }
      .ret0 <- lapply(lapply(x, .stripP), .rxFromSE)
      .SEeq <- c(.rxSEeq, .rxSEeqUsr())
      .nargs <- .SEeq[paste(.ret0[[1]])]
      if (!is.na(.nargs)) {
        if (.nargs == length(.ret0) - 1) {
          .x1 <- as.character(.ret0[[1]])
          .tmp0 <- .x1
          if (.nargs == 1) {
            .tmp0 <- .SE1p[.x1]
            .x2 <- x[[2]]
            if (!is.na(.tmp0)) {
              .ret <- .rxP1rmF(.x2)
              if (.ret[[2]]) {
                if (.tmp0 == "log1p") {
                  .tmp <- eval(parse(text = paste0("quote(", .ret[[1]], ")")))
                  if (length(.tmp) > 1) {
                    if (identical(.tmp[[1]], quote(`exp`))) {
                      .tmp <- .tmp[[-1]]
                      .tmp0 <- "log1pexp"
                      .ret[[1]] <- .rxFromSE(.tmp)
                    }
                  }
                }
                return(paste0(
                  .tmp0, "(",
                  .ret[[1]],
                  ")"
                ))
              } else {
                .ret <- paste0(
                  .x1, "(",
                  .ret[[1]],
                  ")"
                )
                if (.ret == "log(2)") {
                  return("M_LN2")
                }
                if (.ret == "log(10)") {
                  return("M_LN10")
                }
                if (.ret == "log(M_SQRT_PI)") {
                  return("M_LN_SQRT_PI")
                }
                if (any(.ret == c(
                  "log(sqrt((M_PI_2)))",
                  "log(sqrt(M_PI_2))",
                  "log((M_PI_2)^(1/2))",
                  "log((M_PI_2)^0.5)",
                  "log(M_PI_2^(1/2))",
                  "log(M_PI_2^0.5)"
                ))) {
                  return("M_LN_SQRT_PId2")
                }
                if (any(.ret == c(
                  "log(sqrt((M_2PI)))",
                  "log(sqrt(M_2PI))",
                  "log((M_2PI)^0.5)",
                  "log((M_2PI)^(1/2))",
                  "log(M_2PI^0.5)",
                  "log(M_2PI^(1/2))"
                ))) {
                  return("M_LN_SQRT_2PI")
                }
                return(.ret)
              }
            }
            .tmp0 <- .SE1m[.x1]
            if (!is.na(.tmp0)) {
              .ret <- .rxM1rmF(.x2)
              if (.ret[[2]]) {
                return(paste0(
                  .tmp0, "(",
                  .ret[[1]],
                  ")"
                ))
              } else {
                return(paste0(
                  .x1, "(",
                  .ret[[1]],
                  ")"
                ))
              }
            }
            .tmp0 <- .x1
          }
          .ret <- paste0(.tmp0, "(")
          .ret0 <- .ret0[-1]
          .ret <- paste0(
            .ret, paste(unlist(.ret0), collapse = ","),
            ")"
          )
          if (.ret == "exp(1)") {
            return("M_E")
          }
          if (.ret == "sin(pi)") {
            return("0")
          }
          if (.ret == "cos(pi)") {
            return("1")
          }
          if (.ret == "tan(pi)") {
            return("0")
          }
          if (.ret == "sqrt(3)") {
            return("M_SQRT_3")
          }
          if (.ret == "sqrt(2)") {
            return("M_SQRT2")
          }
          if (.ret == "sqrt(32)") {
            return("M_SQRT_32")
          }
          if (.ret == "sqrt(pi)") {
            return("M_SQRT_PI")
          }
          if (any(.ret == c("sqrt(M_2_PI)", "sqrt((M_2_PI))"))) {
            return("M_SQRT_2dPI")
          }
          return(.ret)
        } else {
          stop(sprintf(
            gettext("'%s' takes %s arguments"),
            paste(.ret0[[1]]),
            .nargs
          ))
        }
      } else if (identical(x[[1]], quote(`Derivative`))) {
        ## delay-family functions (delay/rxDelayD/lag/lead) have zero derivatives
        ## of every order, so Derivative(<delay-family>, ...) collapses to 0.
        ## This also covers the higher-order (length(x) > 3) derivatives produced
        ## when the sensitivity machinery differentiates a delayed term more than
        ## once -- symengine keeps Derivative(delay(...), v1, v2) unevaluated.
        if (length(x) >= 3 && is.call(x[[2]]) &&
              any(as.character(x[[2]][[1L]]) == c("lead", "lag", "delay", "rxDelayD", "rxDelayD2", "rxDelayD3"))) {
          return("0")
        }
        if (length(x) == 3) {
          .fun <- as.character(x[[2]])
          .var <- .rxFromSE(x[[3]])
          if (length(.fun) == 1) {
            if (.fun == "abs0") {
              return(paste0("abs(", .var, ")"))
            }
          }
          ## Convert the differentiated function's arguments from the PARSED
          ## expressions (as.list(x[[2]])[-1]), not as.character(x[[2]])[-1]:
          ## the latter deparses each argument to a whole string, so a nested
          ## symengine name (e.g. THETA_3_ inside sqrt(THETA_3_^2)) is treated as
          ## an atomic value and the start/end-anchored THETA_n_ -> THETA[n]
          ## conversion never fires, leaking the mangled name into the derivative
          ## (e.g. llikNormDmean(DV, y, sqrt(THETA_3_^2))).  Matches the
          ## length(x) > 3 branch below.
          .args <- lapply(as.list(x[[2]])[-1], .rxFromSE)
          .with <- which(.var == .args)
          .errD <- function(force = FALSE) {
            if (!force && .rxFromNumDer != 0L) {
              ## Can calculate forward or central
              ## difference instead.
              ## Warn
              if (.rxFromNumDer == 1L) {
                ## Forward
                .a1 <- .args
                .fn <- .fun[1]
                .a1[.with] <- paste0("(", .a1[.with], ")+", .rxDelta)
                .a2 <- .args
                return(paste0(
                  "(", .fn, "(", paste0(.a1, collapse = ","), ")-",
                  .fn, "(", paste0(.a2, collapse = ","), "))/", .rxDelta
                ))
              } else if (.rxFromNumDer == 2L) {
                ## Central
                .a1 <- .args
                .fn <- .fun[1]
                .a1[.with] <- paste0(.a1[.with], "-", (0.5 * .rxDelta))
                .a2 <- .args
                .a2[.with] <- paste0(.a2[.with], "+", (0.5 * .rxDelta))
                return(paste0(
                  "(", .fn, "(", paste0(.a1, collapse = ","), ")-",
                  .fn, "(", paste0(.a2, collapse = ","), "))/", .rxDelta
                ))
              } else {
                stop("only forward and central differences are supported", call. = FALSE)
              }
            } else {
              stop(sprintf(gettext("cannot figure out the '%s' derivative with respect to '%s'"), .fun[1], .var[1]))
            }
          }
          if (length(.with) != 1) {
            .errD(force = TRUE)
          }
          if (any(.fun[1] == c("lead", "lag", "delay", "rxDelayD", "rxDelayD2", "rxDelayD3"))) {
            return("0")
          }
          .rxD <- rxode2parseD()
          if (exists(.fun[1], envir = .rxD)) {
            .funLst <- get(.fun[1], envir = .rxD)
            if (length(.funLst) < .with) {
              return(.errD())
            }
            .derFun <- .funLst[[.with]]
            if (is.null(.derFun)) {
              return(.errD())
            }
            .ret <- try(do.call(.derFun, as.list(.args)), silent = TRUE)
            if (inherits(.ret, "try-error")) {
              warning(
                "an error occurred looking up the derivative for '",
                .fun[1], "' using numerical differences instead"
              )
              return(.errD())
            } else {
              return(.ret)
            }
          } else {
            if (.rxFromNumDer == 0L) {
              stop(sprintf(gettext("rxode2/symengine does not know how to take a derivative of '%s'"), .fun[1]),
                call. = FALSE
              )
            } else {
              return(.errD())
            }
          }
        } else if (length(x) > 3) {
          ## symengine collapses repeated same-argument differentiation
          ## D(D(fun, v), v)... into Derivative(fun, v, v, ...).  Apply the registered
          ## derivative chain iteratively (e.g. rxTBS -> rxTBSd -> rxTBSd2), carrying the
          ## arguments through the parsed result so each step uses the correct
          ## derivative-argument order; args are converted from symengine to rxode2 syntax
          ## once (first step) and reused as-is thereafter.
          .rxD <- rxode2parseD()
          .fun <- as.character(x[[2]][[1L]])
          .args <- lapply(as.list(x[[2]])[-1], .rxFromSE)
          .vars <- lapply(x[-(1:2)], .rxFromSE)
          .ok <- TRUE
          .res <- NULL
          for (.k in seq_along(.vars)) {
            .with <- which(.vars[[.k]] == unlist(.args))
            if (length(.with) != 1 || !exists(.fun, envir = .rxD)) {
              .ok <- FALSE
              break
            }
            .funLst <- get(.fun, envir = .rxD)
            if (length(.funLst) < .with || is.null(.funLst[[.with]])) {
              .ok <- FALSE
              break
            }
            .res <- try(do.call(.funLst[[.with]], as.list(.args)), silent = TRUE)
            if (inherits(.res, "try-error")) {
              .ok <- FALSE
              break
            }
            .call <- str2lang(.res)
            .fun <- as.character(.call[[1L]])
            .args <- lapply(as.list(.call)[-1],
                            function(.z) if (is.character(.z)) .z else paste(deparse(.z), collapse = ""))
          }
          if (.ok && !is.null(.res)) {
            return(.res)
          }
          stop("'Derivative' conversion only takes one function and one argument",
            call. = FALSE
          )
        } else {
          stop("'Derivative' conversion only takes one function and one argument",
            call. = FALSE
          )
        }
      } else if (identical(x[[1]], quote(`Subs`))) {
        .fun <- eval(parse(text = paste0("quote(", .rxFromSE(x[[2]]), ")")))
        .what <- .stripP(x[[3]])
        .with <- .stripP(x[[4]])
        .subs <- function(x) {
          if (identical(x, .what)) {
            return(.with)
          } else if (is.call(x)) {
            as.call(lapply(x, .subs))
          } else if (is.pairlist(x)) {
            as.pairlist(lapply(x, .subs))
          } else {
            return(x)
          }
        }
        .ret <- .subs(.fun)
        return(.rxFromSE(.ret))
      } else if (any(paste(.ret0[[1]]) == c("max", "min"))) {
        .x1 <- as.character(.ret0[[1]])
        .ret <- paste0(.x1, "(")
        .ret0 <- .ret0[-1]
        .ret <- paste0(
          .ret, paste(unlist(.ret0), collapse = ","),
          ")"
        )
        return(.ret)
      } else if (any(paste(.ret0[[1]]) == c("tlast", "tfirst", "dose", "podo",
                                            "tlast0", "first0", "dose0", "podo0"))) {
        if (length(.ret0) == 1L) {
          return(paste0(.ret0[[1]], "()"))
        } else if (length(.ret0) == 2L) {
          if (length(.ret0[[2]]) == 1L) {
            return(paste0(.ret0[[1]], "(", .ret0[[2]], ")"))
          }
        }
        stop(paste0(.ret0[[1]], "() takes 0-1 arguments"))
      } else {
        .fun <- paste(.ret0[[1]])
        .g <- try(get(.fun, envir=.rxFromSE.envir$parent, mode="function"), silent=TRUE)
        if (inherits(.g, "try-error")) {
          .g <- try(get(.fun, envir=.udfEnvSet(NULL), mode="function"), silent=TRUE)
        }
        if (inherits(.g, "try-error")) {
          stop(sprintf(gettext("'%s' not supported in symengine->rxode2"), .fun),
               call. = FALSE
               )
        } else {
          .f <- formals(.g)
          if (any(names(.f)  == "...")) {
            stop(sprintf(gettext("R user function '%s' has variable number of arguments with'...' and is not supported in rxode2"), .fun),
                 call. = FALSE
                 )
          } else if (length(.ret0) - 1 == length(.f)) {
            .ret <- unlist(.ret0)
            .fun <- .ret[1]
            .args <- .ret[-1]
            return(paste0(.fun, "(", paste(.args, collapse = ", "), ")"))
          } else {
            stop(sprintf(gettext("user function '%s' requires %d arguments (supplied %d)"), .fun,
                         length(.f), length(.ret0) - 1),
                 call. = FALSE)

          }
        }
      }
    }
  } else {
    stop("unsupported expression", call. = FALSE)
  }
}

.rxFunction <- function(name) {
  .f <- function(...) {
    1
  }
  body(.f) <- bquote({
    .args <- unlist(list(...))
    if (length(.args) == 0) {
      .args <- NaN
    }
    return(symengine::FunctionSymbol(.(name), .args))
  })
  return(.f)
}

#' Load a model into a symengine environment
#'
#' @param x rxode2 object
#' @param doConst Load constants into the environment as well.
#' @inheritParams rxToSE
#' @return rxode2/symengine environment
#' @author Matthew Fidler
#' @export
rxS <- function(x, doConst = TRUE, promoteLinSens = FALSE, envir=parent.frame()) {
  .udfEnvSet(envir)
  rxReq("symengine")
  .cnst <- names(.rxSEreserved)
  .env <- new.env(parent = loadNamespace("symengine"))
  .env$..mv <- rxModelVars(x)
  # States read by delay() are genuine ODEs (delay(X, T) requires d/dt(X)) even
  # when their name matches the sensitivity convention (rx__sens_<s>_BY_<v>__);
  # their d/dt() must stay in ..ddt.. and not be reclassified as a derivable
  # sensitivity that later passes strip (e.g. nlmixr2est's analytic-cov
  # augmented model supplies delayed sensitivity ODEs directly).
  .env$..delayedStates <- if (isTRUE(.env$..mv$flags[["hasDelay"]] == 1L)) {
    tryCatch(.rxDelayTerms(.env$..mv)$state, error = function(e) character(0))
  } else {
    character(0)
  }
  .env$..jac0 <- NULL
  .env$..jac0.. <- list()
  .env$..ddt <- NULL
  .env$..ddt.. <- list()
  .env$..sens0 <- NULL
  .env$..sens0.. <- list()
  .env$..lhs <- NULL
  .env$..lhs0 <- NULL
  .env$..doConst <- doConst
  .rxD <- rxode2parseD()
  for (.f in c(
    ls(.symengineFs()),
    ls(.rxD), "linCmtA", "linCmtB",
    "rxEq", "rxNeq", "rxGeq", "rxLeq", "rxLt",
    "rxGt", "rxAnd", "rxOr", "rxNot", "rxTBS", "rxTBSd", "rxTBSd2",
    "rxTBSdL", "rxTBSdL2", "rxTBSdLx", "lag", "lead",
    "lag0", "lead0", "diff0",
    "delay", "rxDelayD", "rxDelayD2", "rxDelayD3", "rxTBSi"
  )) {
    assign(.f, .rxFunction(.f), envir = .env)
  }

  for (.v in seq_along(.rxSEreserved)) {
    assign(names(.rxSEreserved)[.v], .rxSEreserved[[.v]], envir = .env)
  }
  .env$..s0 <- symengine::S("0")
  .env$..extraTheta <- list()
  .env$..extraEta <- list()
  .env$..curCall <- character(0)
  .env$..eventVars <- NULL
  .env$..mtimeVars <- NULL
  .env$polygamma <- function(a, b) {
    ## symengine::subs(symengine::subs(..polygamma, ..a, a), ..b,  b)
    symengine::psigamma(b, a)
  }
  # "tlast"
  .pars <- c(
    rxParams(x), rxState(x),
    "t", "time",  "rx1c", "rx__PTR__",
    "mixnum", "mixest", "mixunif")

  ## default lambda/yj values
  .env$rx_lambda_ <- symengine::S("1")
  .env$rx_yj_ <- symengine::S("2")
  .env$rx_low_ <- symengine::S("0")
  .env$rx_hi_ <- symengine::S("1")
  if (!is.null(.rxSEeqUsr())) {
    sapply(names(.rxSEeqUsr()), function(x) {
      assign(x, .rxFunction(x), envir = .env)
    })
  }
  ## EulerGamma=0.57721566490153286060651209008240243104215933593992
  ## S("I")
  ## S("pi")
  ## S("E")
  ## S("") # EulerGamma
  ## S("Catalan") = 0.915965594177219015054603514932384110774
  ## S("GoldenRatio") = 1+sqrt(5)/2
  ## S("inf")
  ## S("nan")
  sapply(.pars, function(x) {
    if (any(.cnst == x)) {
      .tmp <- paste0("rx_SymPy_Res_", x)
      assign(.tmp, symengine::Symbol(.tmp), envir = .env)
    } else {
      .tmp <- rxToSE(x, envir=.env)
      assign(.tmp, symengine::Symbol(.tmp), envir = .env)
      assign(x, symengine::Symbol(x), envir = .env)
    }
  })
  assignInMyNamespace(".promoteLinB", promoteLinSens)
  .expr <- eval(parse(text = paste0("quote({", rxNorm(x), "})")))
  # variables referenced inside lag()/lead()/diff()/first()/last() must be kept
  # as emitted lhs and bound as symbols (not inlined or dead-code eliminated), so
  # the history function still references a defined variable in the output model
  .env$..laggedVars <- .rxCollectLaggedVars(.expr)
  .ret <- .rxToSE(.expr, envir=.env)
  class(.env) <- "rxS"
  return(.env)
}

#' Collect the variables referenced inside history functions (lag/lead/diff/...)
#'
#' Only the RHS of assignments is scanned so the dosing `lag(cmt) <- ...` form
#' (a compartment property, not a history reference) is not collected.
#'
#' @param expr a quoted model (or sub-expression)
#' @return character vector of variable names used as the first argument of a
#'   history function
#' @author Matthew Fidler
#' @noRd
.rxCollectLaggedVars <- function(expr) {
  .acc <- character(0)
  .histFn <- c("lag", "lead", "diff", "first", "last", "lag0", "lead0", "diff0")
  .walk <- function(e) {
    if (is.call(e)) {
      .f <- e[[1]]
      if (is.name(.f) &&
            (identical(.f, quote(`<-`)) || identical(.f, quote(`=`)) ||
               identical(.f, quote(`~`)))) {
        # A variable defined directly as a history function (eg
        # rx_arEp <- lag0(rx_arE, 1)) is itself a lagged quantity: keep it
        # symbolic too (not inlined), so downstream differentiation w.r.t. it
        # stays valid (eg the AR(1) exact eta/theta gradient differentiates the
        # whitened likelihood by the previous residual).
        .rhs <- e[[3]]
        if (!identical(.f, quote(`~`)) && is.name(e[[2]]) && is.call(.rhs) &&
              is.name(.rhs[[1]]) && as.character(.rhs[[1]]) %in% .histFn) {
          .acc[[length(.acc) + 1L]] <<- as.character(e[[2]])
        }
        # only scan the RHS (skip dosing lag(cmt) on the lhs)
        .walkRhs(e[[3]])
      } else {
        for (.i in seq_along(e)) .walk(e[[.i]])
      }
    }
  }
  .walkRhs <- function(e) {
    if (is.call(e)) {
      .f <- e[[1]]
      if (is.name(.f) && as.character(.f) %in% .histFn &&
            length(e) >= 2L && is.name(e[[2]])) {
        .acc[[length(.acc) + 1L]] <<- as.character(e[[2]])
      }
      for (.i in seq_along(e)[-1]) .walkRhs(e[[.i]])
    }
  }
  .walk(expr)
  unique(.acc)
}

symengineC <- new.env(parent = emptyenv())
symengineC$"**" <- .dslToPow
symengineC$"^" <- .dslToPow

symengineC$S <- function(x) {
  sprintf("%s", x)
}

for (f in names(.rxSEeq)) {
  symengineC[[f]] <- functionOp(f)
}
symengineC$"(" <- unaryOp("(", ")")
for (op in c("+", "-", "*")) {
  symengineC[[op]] <- binaryOp(paste0(" ", op, " "))
}

symengineC[["/"]] <- function(e1, e2) {
  sprintf("%s /( (%s == 0) ? %s : %s)", e1, e2, .Machine$double.eps, e2)
}

unknownCsymengine <- function(op) {
  force(op)
  function(...) {
    stop(sprintf("rxode2 doesn't support '%s' translation for 'Omega' translation", op),
      call. = FALSE
    )
  }
}

symengineCEnv <- function(expr) {
  ## Known functions
  calls <- allCalls(expr)
  callList <- setNames(lapply(calls, unknownCsymengine), calls)
  callEnv <- list2env(callList)
  rxSymPyFEnv <- cloneEnv(symengineC, callEnv)
  names <- allNames(expr)
  ## Replace time with t.
  n1 <- names
  n2 <- names
  n2 <- gsub(rex::rex("t", capture(numbers)), "REAL(theta)[\\1]", n2)
  n2 <- gsub(rex::rex("pi"), "M_PI", n2)
  n2 <- gsub(rex::rex("rx_SymPy_Res_"), "", n2)
  n2 <- gsub("None", "NA_REAL", n2)
  w <- n2[n2 == "t"]
  symbol.list <- setNames(as.list(n2), n1)
  symbol.env <- list2env(symbol.list, parent = symengineC)
  return(symbol.env)
}

seC <- function(x) {
  expr <- eval(parse(text = sprintf("quote(%s)", as.character(x))))
  .ret <- eval(expr, symengineCEnv(expr))
}


## nocov end

allNames <- function(x) {
  if (is.atomic(x)) {
    character()
  } else if (is.name(x)) {
    as.character(x)
  } else if (is.call(x) || is.pairlist(x)) {
    children <- lapply(x[-1], allNames)
    unique(unlist(children))
  } else {
    stop("do not know how to handle type ", typeof(x),
      call. = FALSE
    )
  }
}

allCalls <- function(x) {
  if (is.atomic(x) || is.name(x)) {
    character()
  } else if (is.call(x)) {
    fname <- as.character(x[[1]])
    children <- lapply(x[-1], allCalls)
    unique(c(fname, unlist(children)))
  } else if (is.pairlist(x)) {
    unique(unlist(lapply(x[-1], allCalls), use.names = FALSE))
  } else {
    stop("do not know how to handle type ", typeof(x), call. = FALSE)
  }
}

cloneEnv <- function(env, parent = parent.env(env)) {
  list2env(as.list(env), parent = parent)
}

.exists2 <- function(x, where) {
  .nc <- try(nchar(x) < 1000, silent = TRUE)
  if (inherits(.nc, "try-error")) .nc <- FALSE
  if (rxIs(.nc, "logical")) .nc <- FALSE
  if (.nc) {
    return(exists(x, where))
  } else {
    return(FALSE)
  }
}

## Start error function DSL
rxErrEnvF <- new.env(parent = emptyenv())
for (op in c(
  "+", "-", "*", "/", "^", "**",
  "!=", "==", "&", "&&", "|", "||"
)) {
  op2 <- op
  if (op == "**") {
    op2 <- "^"
  }
  rxErrEnvF[[op]] <- binaryOp(paste0(" ", op2, " "))
}
for (op in c("=", "~", "<-")) {
  rxErrEnvF[[op]] <- binaryOp(" = ")
}
rxErrEnvF$"{" <- function(...) {
  return(sprintf("{\n%s\n}", paste(unlist(list(...)), collapse = "\n")))
}
rxErrEnvF$"(" <- unaryOp("(", ")")
rxErrEnvF$"[" <- function(name, val) {
  n <- toupper(name)
  err <- gettext("rxode2 only supports THETA[#] and ETA[#] numbers")
  if (any(n == c("THETA", "ETA")) && is.numeric(val)) {
    if (round(val) == val && val > 0) {
      if (n == "THETA" && as.numeric(val) <= length(rxErrEnv.init)) {
        return(sprintf("THETA[%s]", val))
      } else {
        return(sprintf("%s[%s]", n, val))
      }
    } else {
      stop(err)
    }
  } else {
    stop(err)
  }
}

rxErrEnvF$"if" <- function(lg, tr, fl) {
  if (missing(fl)) {
    return(sprintf("if (%s) %s", lg, tr))
  } else {
    return(sprintf("if (%s) %s else %s", lg, tr, fl))
  }
}
rxErrEnv.theta <- 1
rxErrEnv.diag.est <- NULL
rxErrEnv.ret <- "rx_r_"
rxErrEnv.init <- NULL
rxErrEnv.lambda <- NULL
rxErrEnv.yj <- NULL
rxErrEnv.combined <- "^2"
rxErrEnv.hasAdd <- FALSE
rxErrEnv.hi <- "1"
rxErrEnv.low <- "0"

.rxErrEnvInit <- function() {
  assignInMyNamespace("rxErrEnv.hasAdd", FALSE)
  assignInMyNamespace("rxErrEnv.theta", 1)
  assignInMyNamespace("rxErrEnv.diag.est", NULL)
  assignInMyNamespace("rxErrEnv.ret", "rx_r_")
  assignInMyNamespace("rxErrEnv.init", NULL)
  assignInMyNamespace("rxErrEnv.lambda", NULL)
  assignInMyNamespace("rxErrEnv.yj", NULL)
  assignInMyNamespace("rxErrEnv.combined", "^2")
  assignInMyNamespace("rxErrEnv.hi", "1")
  assignInMyNamespace("rxErrEnv.low", "0")
}


rxErrEnvF$lnorm <- function(est) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'lnorm' can only be in an error function", call. = FALSE)
  }
  if (!is.null(rxErrEnv.lambda)) {
    if (rxErrEnv.lambda != "0" && rxErrEnv.yj != "0") {
      stop("'lnorm' cannot be used with other data transformations", call. = FALSE)
    }
  }
  if (is.na(est)) {
    assignInMyNamespace("rxErrEnv.lambda", "0")
    assignInMyNamespace("rxErrEnv.yj", "0")
    return("")
  } else {
    estN <- suppressWarnings(as.numeric(est))
    assignInMyNamespace("rxErrEnv.hasAdd", TRUE)
    if (is.na(estN)) {
      ret <- (sprintf("(%s)%s", est, rxErrEnv.combined))
      assignInMyNamespace("rxErrEnv.lambda", "0")
      assignInMyNamespace("rxErrEnv.yj", "0")
    } else {
      theta <- sprintf("THETA[%s]", rxErrEnv.theta)
      est <- estN
      theta.est <- theta
      ret <- (sprintf("(%s)%s", theta.est, rxErrEnv.combined))
      tmp <- rxErrEnv.diag.est
      tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
      assignInMyNamespace("rxErrEnv.diag.est", tmp)
      assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
      assignInMyNamespace("rxErrEnv.lambda", "0")
      assignInMyNamespace("rxErrEnv.yj", "0")
    }
  }
  return(ret)
}

rxErrEnvF$dlnorm <- rxErrEnvF$lnorm
rxErrEnvF$logn <- rxErrEnvF$lnorm

rxErrEnvF$logitNorm <- function(est, low = "0", hi = "1") {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'logitNorm' can only be in an error function", call. = FALSE)
  }
  if (!is.null(rxErrEnv.lambda)) {
    if (rxErrEnv.yj != "1") {
      if (rxErrEnv.yj != "4" && rxErrEnv.yj != "5") {
        stop("'logitNorm' cannot be used with other data transformations", call. = FALSE)
      }
    }
  }
  if (is.na(est)) {
    if (is.null(rxErrEnv.yj)) {
      assignInMyNamespace("rxErrEnv.yj", "4")
    } else if (rxErrEnv.yj == "1") {
      assignInMyNamespace("rxErrEnv.yj", "5")
    } else {
      assignInMyNamespace("rxErrEnv.yj", "4")
    }
    assignInMyNamespace("rxErrEnv.hi", hi)
    assignInMyNamespace("rxErrEnv.low", low)
    return("")
  } else {
    estN <- suppressWarnings(as.numeric(est))
    assignInMyNamespace("rxErrEnv.hasAdd", TRUE)
    if (is.na(estN)) {
      ret <- (sprintf("(%s)%s", est, rxErrEnv.combined))
      assignInMyNamespace("rxErrEnv.lambda", "0")
      if (is.null(rxErrEnv.yj)) {
        assignInMyNamespace("rxErrEnv.yj", "4")
      } else if (rxErrEnv.yj == "1") {
        assignInMyNamespace("rxErrEnv.yj", "5")
      } else {
        assignInMyNamespace("rxErrEnv.yj", "4")
      }
      assignInMyNamespace("rxErrEnv.hi", hi)
      assignInMyNamespace("rxErrEnv.low", low)
    } else {
      theta <- sprintf("THETA[%s]", rxErrEnv.theta)
      est <- estN
      theta.est <- theta
      ret <- (sprintf("(%s)%s", theta.est, rxErrEnv.combined))
      tmp <- rxErrEnv.diag.est
      tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
      assignInMyNamespace("rxErrEnv.diag.est", tmp)
      assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
      assignInMyNamespace("rxErrEnv.lambda", "0")
      if (is.null(rxErrEnv.yj)) {
        assignInMyNamespace("rxErrEnv.yj", "4")
      } else if (rxErrEnv.yj == "1") {
        assignInMyNamespace("rxErrEnv.yj", "5")
      } else {
        assignInMyNamespace("rxErrEnv.yj", "4")
      }
      assignInMyNamespace("rxErrEnv.hi", hi)
      assignInMyNamespace("rxErrEnv.low", low)
    }
  }
  return(ret)
}

rxErrEnvF$probitNorm <- function(est, low = "0", hi = "1") {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'probitNorm' can only be in an error function", call. = FALSE)
  }
  if (!is.null(rxErrEnv.lambda)) {
    if (rxErrEenv.yj != "1") {
      if (rxErrEnv.yj != "6" &&rxErrEnv.yj != "7") {
        print(rxErrEnv.yj)
        stop("'probitNorm' cannot be used with other data transformations", call. = FALSE)
      }
    }
  }
  if (is.na(est)) {
    if (is.null(rxErrEnv.yj)) {
      assignInMyNamespace("rxErrEnv.yj", "6")
    } else if (rxErrEnv.yj == "1") {
      assignInMyNamespace("rxErrEnv.yj", "7")
    } else {
      assignInMyNamespace("rxErrEnv.yj", "6")
    }
    assignInMyNamespace("rxErrEnv.hi", hi)
    assignInMyNamespace("rxErrEnv.low", low)
    return("")
  } else {
    estN <- suppressWarnings(as.numeric(est))
    assignInMyNamespace("rxErrEnv.hasAdd", TRUE)
    if (is.na(estN)) {
      ret <- (sprintf("(%s)%s", est, rxErrEnv.combined))
      assignInMyNamespace("rxErrEnv.lambda", "0")
      if (is.null(rxErrEnv.yj)) {
        assignInMyNamespace("rxErrEnv.yj", "6")
      } else if (rxErrEnv.yj == "1") {
        assignInMyNamespace("rxErrEnv.yj", "7")
      } else {
        assignInMyNamespace("rxErrEnv.yj", "6")
      }
      assignInMyNamespace("rxErrEnv.hi", hi)
      assignInMyNamespace("rxErrEnv.low", low)
    } else {
      theta <- sprintf("THETA[%s]", rxErrEnv.theta)
      est <- estN
      theta.est <- theta
      ret <- (sprintf("(%s)%s", theta.est, rxErrEnv.combined))
      tmp <- rxErrEnv.diag.est
      tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
      assignInMyNamespace("rxErrEnv.diag.est", tmp)
      assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
      assignInMyNamespace("rxErrEnv.lambda", "0")
      if (is.null(rxErrEnv.yj)) {
        assignInMyNamespace("rxErrEnv.yj", "6")
      } else if (rxErrEnv.yj == "1") {
        assignInMyNamespace("rxErrEnv.yj", "7")
      } else {
        assignInMyNamespace("rxErrEnv.yj", "6")
      }
      assignInMyNamespace("rxErrEnv.hi", hi)
      assignInMyNamespace("rxErrEnv.low", low)
    }
  }
  return(ret)
}

rxErrEnvF$tbs <- function(lambda) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'boxCox' can only be in an error function", call. = FALSE)
  }
  if (!is.null(rxErrEnv.lambda)) {
    if (rxErrEnv.yj != "0" && rxErrEnv.lambda != "0" && rxErrEnv.lambda != "1") {
      stop("'boxCox' cannot be used with other data transformations", call. = FALSE)
    }
  }
  estN <- suppressWarnings(as.numeric(lambda))
  if (is.na(estN)) {
    assignInMyNamespace("rxErrEnv.lambda", lambda)
    assignInMyNamespace("rxErrEnv.yj", "0")
  } else {
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- estN
    assignInMyNamespace("rxErrEnv.lambda", sprintf("THETA[%s]", rxErrEnv.theta))
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
    assignInMyNamespace("rxErrEnv.yj", "0")
  }
  return("0")
}

rxErrEnvF$boxCox <- rxErrEnvF$tbs

rxErrEnvF$tbsYj <- function(lambda) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'yeoJohnson' can only be in an error function", call. = FALSE)
  }
  if (!is.null(rxErrEnv.lambda)) {
    if ((rxErrEnv.yj != "1" && rxErrEnv.yj != "4" && rxErrEnv.yj != "6")) {
      stop("'yeoJohnson' cannot be used with other data transformations", call. = FALSE)
    }
  }
  estN <- suppressWarnings(as.numeric(lambda))
  if (is.na(estN)) {
    assignInMyNamespace("rxErrEnv.lambda", lambda)
    if (is.null(rxErrEnv.yj)) {
      assignInMyNamespace("rxErrEnv.yj", "1")
    } else if (rxErrEnv.yj == "4") {
      assignInMyNamespace("rxErrEnv.yj", "5")
    } else if (rxErrEnv.yj == "6") {
      assignInMyNamespace("rxErrEnv.yj", "7")
    } else {
      assignInMyNamespace("rxErrEnv.yj", "1")
    }
  } else {
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- estN
    assignInMyNamespace("rxErrEnv.lambda", sprintf("THETA[%s]", rxErrEnv.theta))
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
    if (is.null(rxErrEnv.yj)) {
      assignInMyNamespace("rxErrEnv.yj", "1")
    } else if (rxErrEnv.yj == "4") {
      assignInMyNamespace("rxErrEnv.yj", "5")
    } else if (rxErrEnv.yj == "6") {
      assignInMyNamespace("rxErrEnv.yj", "7")
    } else {
      assignInMyNamespace("rxErrEnv.yj", "1")
    }
  }
  return("0")
}

rxErrEnvF$yeoJohnson <- rxErrEnvF$tbsYj

rxErrEnvF$add <- function(est) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'add' can only be in an error function", call. = FALSE)
  }
  assignInMyNamespace("rxErrEnv.hasAdd", TRUE)
  estN <- suppressWarnings(as.numeric(est))
  if (is.na(estN)) {
    ret <- (sprintf("(%s)%s", est, rxErrEnv.combined))
  } else {
    theta <- sprintf("THETA[%s]", rxErrEnv.theta)
    est <- estN
    theta.est <- theta
    ret <- (sprintf("(%s)%s", theta.est, rxErrEnv.combined))
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
  }
  return(ret)
}

rxErrEnvF$norm <- rxErrEnvF$add
rxErrEnvF$dnorm <- rxErrEnvF$add

rxErrEnvF$"for" <- function(...) {
  stop("'for' is not supported", call. = FALSE)
}
rxErrEnvF$`return` <- function(est) {
  if (rxErrEnv.ret == "") {
    stop("The PK function should not return anything", call. = FALSE)
  }
  .extra <- ""
  force(est)
  if (rxErrEnv.ret == "rx_r_") {
    .hi <- rxErrEnv.hi
    .low <- rxErrEnv.low
    if (is.null(rxErrEnv.lambda)) {
      .lambda <- "1"
    } else {
      .lambda <- rxErrEnv.lambda
    }
    if (is.null(rxErrEnv.yj)) {
      .yj <- "0"
    } else {
      .yj <- rxErrEnv.yj
    }
    if (.yj == "0" && .lambda == "1") {
      .yj <- "2"
      .lambda <- "1"
    }
    if (.yj == "0" && .lambda == "0") {
      .yj <- "3"
      .lambda <- "0"
    }
    .extra <- sprintf("rx_yj_~%s;\nrx_lambda_~%s;\nrx_hi_~%s\nrx_low_~%s\n", .yj, .lambda, .hi, .low)
  }
  return(sprintf("%s%s=%s;", .extra, rxErrEnv.ret, est))
}


rxErrEnvF$`|` <- binaryOp(" | ")
rxErrEnvF$`||` <- binaryOp(" || ")
rxErrEnvF$`&&` <- binaryOp(" && ")
rxErrEnvF$`<=` <- binaryOp(" <= ")
rxErrEnvF$`>=` <- binaryOp(" >= ")
rxErrEnvF$`==` <- binaryOp(" == ")

rxErrEnvF$prop <- function(est) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'prop' can only be in an error function")
  }
  estN <- suppressWarnings(as.numeric(est))
  if (is.na(estN)) {
    ret <- (sprintf("(rx_pred_f_)%s * (%s)%s", rxErrEnv.combined, est, rxErrEnv.combined))
  } else {
    est <- estN
    ret <- ""
    theta <- sprintf("THETA[%s]", rxErrEnv.theta)
    theta.est <- theta
    ret <- (sprintf("(rx_pred_f_)%s*(%s)%s", rxErrEnv.combined, theta.est, rxErrEnv.combined))
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
  }
  return(ret)
}

rxErrEnvF$propT <- function(est) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'propT' can only be in an error function")
  }
  estN <- suppressWarnings(as.numeric(est))
  if (is.na(estN)) {
    ret <- (sprintf("(rx_pred_)%s * (%s)%s", rxErrEnv.combined, est, rxErrEnv.combined))
  } else {
    est <- estN
    ret <- ""
    theta <- sprintf("THETA[%s]", rxErrEnv.theta)
    theta.est <- theta
    ret <- (sprintf("(rx_pred_)%s*(%s)%s", rxErrEnv.combined, theta.est, rxErrEnv.combined))
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 1)
  }
  return(ret)
}

rxErrEnvF$pow <- function(est, pow) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'pow' can only be in an error function", call. = FALSE)
  }
  estN <- suppressWarnings(as.numeric(est))
  if (is.na(estN)) {
    ret <- (sprintf(
      "(rx_pred_f_)^(%s%s) * (%s)%s", ifelse(rxErrEnv.combined == "^2", "2*", ""),
      pow, est, rxErrEnv.combined
    ))
  } else {
    est <- estN
    ret <- ""
    theta <- sprintf("THETA[%s]", rxErrEnv.theta)
    theta2 <- sprintf("THETA[%s]", rxErrEnv.theta + 1)
    theta.est <- theta
    ret <- (sprintf("(rx_pred_f_)^(%s%s) * (%s)%s", ifelse(rxErrEnv.combined == "^2", "2*", ""), theta2, theta.est, rxErrEnv.combined))
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
    tmp[sprintf("THETA[%s]", rxErrEnv.theta + 1)] <- as.numeric(pow)
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 2)
  }
  return(ret)
}

rxErrEnvF$powT <- function(est, pow) {
  if (rxErrEnv.ret != "rx_r_") {
    stop("'powT' can only be in an error function", call. = FALSE)
  }
  estN <- suppressWarnings(as.numeric(est))
  if (is.na(estN)) {
    ret <- (sprintf(
      "(rx_pred_)^(%s%s) * (%s)%s", ifelse(rxErrEnv.combined == "^2", "2*", ""),
      pow, est, rxErrEnv.combined
    ))
  } else {
    est <- estN
    ret <- ""
    theta <- sprintf("THETA[%s]", rxErrEnv.theta)
    theta2 <- sprintf("THETA[%s]", rxErrEnv.theta + 1)
    theta.est <- theta
    ret <- (sprintf("(rx_pred_)^(%s%s) * (%s)%s", ifelse(rxErrEnv.combined == "^2", "2*", ""), theta2, theta.est, rxErrEnv.combined))
    tmp <- rxErrEnv.diag.est
    tmp[sprintf("THETA[%s]", rxErrEnv.theta)] <- as.numeric(est)
    tmp[sprintf("THETA[%s]", rxErrEnv.theta + 1)] <- as.numeric(pow)
    assignInMyNamespace("rxErrEnv.diag.est", tmp)
    assignInMyNamespace("rxErrEnv.theta", rxErrEnv.theta + 2)
  }
  return(ret)
}

.convStr <- function(x) {
  if (is.atomic(x) || is.name(x)) {
    if (is.character(x)) {
      .rxChrToSym(x)
    } else {
      return(x)
    }
  } else if (is.call(x) || is.pairlist(x)) {
    return(as.call(lapply(x, .convStr)))
  } else {
    stop("do not know how to handle type ", typeof(x),
      call. = FALSE
    )
  }
}

rxErrEnv <- function(expr) {
  calls <- allCalls(expr)
  callList <- setNames(lapply(calls, functionOp), calls)
  callEnv <- list2env(callList)

  ## Known functions
  rxErrFEnv <- cloneEnv(rxErrEnvF, callEnv)

  ## Symbols
  names <- allNames(expr)
  n1 <- names
  n2 <- names
  n2[n2 == "time"] <- "t"
  if (any(n2 == "err")) {
    stop("use 'return' for errors", call. = FALSE)
  }
  if (any(n2 == "error")) {
    stop("use 'return' for errors", call. = FALSE)
  }
  if (any(n2 == "rx_r")) {
    stop("use 'return' for errors", call. = FALSE)
  }
  ## n2[n2 == "err"] <- "rx_r_";
  ## n2[n2 == "error"] <- "rx_r_";
  ## n2[n2 == "f"] <- "rx_pred_f_";
  symbol.list <- setNames(as.list(n2), n1)
  symbol.env <- list2env(symbol.list, parent = rxErrFEnv)
  return(symbol.env)
}

#' Parse PK function for inclusion in rxode2
#'
#' @param x PK function
#' @inheritParams rxParseErr
#' @return rxode2 transformed text.
#' @author Matthew L. Fidler
#' @keywords internal
#' @export
rxParsePk <- function(x, init = NULL) {
  return(rxParseErr(x, init = init, ret = ""))
}
#' Prepare Pred function for inclusion in rxode2
#'
#' @param x pred function
#' @inheritParams rxParseErr
#' @return rxode2 transformed text.
#' @author Matthew L. Fidler
#' @keywords internal
#' @export
rxParsePred <- function(x, init = NULL, err = NULL, addProp = c("combined2", "combined1")) {
  if (is.null(err)) {
    return(rxParseErr(x, ret = "rx_pred_", init = init, addProp = addProp))
  } else {
    .ini <- attr(err, "ini")
    .errs <- rxExpandIfElse(rxGetModel(err))
    .prd <- rxParseErr(x, ret = "rx_pred_", init = init)
    .prd <- rxExpandIfElse(rxGetModel(.prd))
    if (length(.prd) > 1) {
      if (length(.prd) == length(.errs)) {
        .prd <- .prd[names(.errs)]
        if (any(is.na(.prd))) {
          stop("errors and predictions need to have the same conditions ('if'/'then' statements)",
            call. = FALSE
          )
        }
      } else if (length(.errs) != 1) {
        stop("do not know how to handle this error/pred combination",
          call. = FALSE
        )
      }
    }
    .ret <- sapply(seq(1, max(length(.errs), length(.prd))), function(en) {
      .e <- .errs[min(length(.errs), en)]
      .p <- .prd[min(length(.prd), en)]
      .reg <- rex::rex("rx_pred_", any_spaces, "=", any_spaces, capture(except_any_of(";\n")), any_of(";\n"))
      if (regexpr(rex::rex("rx_yj_~2;\nrx_lambda_~1;\n"), .e) != -1) {
        .p <- gsub(.reg, "rx_pred_f_~\\1;\nrx_pred_ = \\1", .p)
      } else if (regexpr(rex::rex("rx_yj_~3;\nrx_lambda_~0;\n"), .e) != -1) {
        .p <- gsub(.reg, "rx_pred_f_~\\1;\nrx_pred_ = log(\\1)", .p)
      } else {
        .p <- gsub(.reg, "rx_pred_f_~\\1;\nrx_pred_ = rxTBS(\\1, rx_lambda_, rx_yj_, rx_low_, rx_hi_)", .p)
      }
      return(gsub("rx_r_", sprintf("%s\nrx_r_", .p), .e))
    })
    if (length(.ret) == 1L) {
      .ret <- setNames(.ret, NULL)
      attr(.ret, "ini") <- .ini
      return(.ret)
    } else {
      if (length(.errs) >= length(.prd)) {
        .n <- names(.errs)
      } else {
        .n <- names(.prd)
      }
      .ord <- order(sapply(.n, nchar))
      .n <- .n[.ord]
      .ret <- .ret[.ord]
      .ret <- paste(sapply(seq_along(.n), function(x) {
        if (x > 1) {
          if (.n[x] == sprintf("(!%s)", .n[x - 1])) {
            return(sprintf("else {\n%s\n}", .ret[x]))
          }
        }
        return(sprintf("if %s {\n%s\n}", .n[x], .ret[x]))
      }), collapse = "\n")
      attr(.ret, "ini") <- .ini
      return(.ret)
    }
  }
}
#' Prepare Error function for inclusion in rxode2
#'
#' @param x error function
#' @param baseTheta Base theta to start numbering add(.) and prop(.) from.
#' @param ret Internal return type.  Should not be changed by the user...
#' @param init Initialization vector
#' @return rxode2 transformed text
#' @keywords internal
#' @author Matthew L. Fidler
#' @export
rxParseErr <- function(x, baseTheta, ret = "rx_r_", init = NULL,
                       addProp = c("combined2", "combined1")) {
  addProp <- match.arg(addProp)
  if (!missing(baseTheta)) {
    assignInMyNamespace("rxErrEnv.theta", baseTheta)
  }
  if (!missing(ret)) {
    assignInMyNamespace("rxErrEnv.ret", ret)
  }
  if (!missing(init)) {
    assignInMyNamespace("rxErrEnv.init", init)
  }
  if (!missing(init)) {
    assignInMyNamespace("rxErrEnv.init", init)
  }
  if (addProp == "combined2") {
    assignInMyNamespace("rxErrEnv.combined", "^2")
  } else {
    assignInMyNamespace("rxErrEnv.combined", "")
  }
  if (is(x, "function")) {
    x <- rxAddReturn(x, ret != "")
  }
  if (is(substitute(x), "character")) {
    ret <- eval(parse(text = sprintf("rxode2:::rxParseErr(quote({%s}),addProp=\"%s\")", x, addProp)))
    ret <- substring(ret, 3, nchar(ret) - 2)
    assignInMyNamespace("rxErrEnv.diag.est", NULL)
    assignInMyNamespace("rxErrEnv.theta", 1)
    assignInMyNamespace("rxErrEnv.ret", "rx_r_")
    assignInMyNamespace("rxErrEnv.init", NULL)
    return(ret)
  } else if (is(substitute(x), "name")) {
    ret <- eval(parse(text = sprintf("rxode2:::rxParseErr(%s, addProp=\"%s\")", deparse1(x), addProp)))
    assignInMyNamespace("rxErrEnv.diag.est", NULL)
    assignInMyNamespace("rxErrEnv.theta", 1)
    assignInMyNamespace("rxErrEnv.ret", "rx_r_")
    assignInMyNamespace("rxErrEnv.init", NULL)
    return(ret)
  } else {
    ret <- NULL
    if (is(x, "character")) {
      ret <- eval(parse(text = sprintf("rxode2:::rxParseErr(quote({%s}))", paste(x, collapse = "\n"))))
      ret <- substring(ret, 3, nchar(ret) - 2)
    } else {
      x <- .convStr(x)
      ret <- eval(x, rxErrEnv(x))
    }
    attr(ret, "ini") <- rxErrEnv.diag.est
    assignInMyNamespace("rxErrEnv.diag.est", NULL)
    assignInMyNamespace("rxErrEnv.theta", 1)
    assignInMyNamespace("rxErrEnv.ret", "rx_r_")
    assignInMyNamespace("rxErrEnv.init", NULL)
    return(ret)
  }
}

rxSimpleExprP <- function(x) {
  if (is.name(x) || is.atomic(x)) {
    return(TRUE)
  } else {
    return(FALSE)
  }
}

#' This function splits a function based on + or - terms
#'
#' It uses the parser and does not disturb terms within other
#' functions.  For example:
#'
#' a*exp(b+c)+d*log(e-f)-g*f
#'
#' would return
#'
#' c("a * exp(b + c)", "d * log(e - f)", "- g * f")
#'
#' @param x Quoted R expression for splitting
#' @param level Internal level of parsing
#' @param mult boolean to split based on * and / expressions instead.
#'     By default this is turned off.
#' @return character vector of the split expressions
#' @author Matthew L. Fidler
#' @export
#' @keywords internal
rxSplitPlusQ <- function(x, level = 0, mult = FALSE) {
  if (is(x, "character") && level == 0) {
    return(eval(parse(text = sprintf("rxSplitPlusQ(quote(%s))", x))))
  }
  if (is.name(x) || is.atomic(x)) {
    if (level == 0) {
      return(paste(deparse1(x), collapse = ""))
    } else {
      return(character())
    }
  } else if (is.call(x)) { # Call recurse_call recursively
    if ((mult && ((identical(x[[1]], quote(`*`)) ||
      identical(x[[1]], quote(`/`))) && level == 0)) ||
      (!mult && ((identical(x[[1]], quote(`+`)) ||
        identical(x[[1]], quote(`-`))) && level == 0))) {
      if (length(x) == 3) {
        if (identical(x[[1]], quote(`+`))) {
          one <- paste(deparse1(x[[3]]), collapse = "")
        } else if (!mult) {
          one <- paste("-", paste(deparse1(x[[3]]), collapse = ""))
        } else if (identical(x[[1]], quote(`*`))) {
          one <- paste(deparse1(x[[3]]), collapse = "")
        } else if (mult) {
          one <- paste("1/", paste(deparse1(x[[3]]), collapse = ""))
        }
        tmp <- rxSplitPlusQ(x[[2]], level = 0, mult = mult)
        if (length(tmp) > 0) {
          return(c(tmp, one))
        } else {
          tmp <- paste(deparse1(x[[2]]), collapse = "")
          return(c(tmp, one))
        }
      } else {
        ## Unary + or -
        if (identical(x[[1]], quote(`+`))) {
          one <- paste(deparse1(x[[2]]), collapse = "")
        } else {
          one <- paste("-", paste(deparse1(x[[2]]), collapse = ""))
        }
        return(one)
      }
    } else {
      tmp <- unlist(lapply(x, rxSplitPlusQ, level = 1, mult = mult))
      if (level == 0) {
        if (length(tmp) == 0) {
          tmp <- paste(deparse1(x), collapse = "")
        }
      }
      return(tmp)
    }
  } else if (is.pairlist(x)) {
    ## Call recurse_call recursively
    tmp <- unlist(lapply(x, rxSplitPlusQ, level = level, mult = mult))
    if (level == 0) {
      if (length(tmp) == 0) {
        tmp <- paste(deparse1(x), collapse = "")
      }
    }
    return(tmp)
  } else { # User supplied incorrect input
    stop("Don't know how to handle type '", typeof(x), "'.",
      call. = FALSE
    )
  }
}

.rxSupportedFunsExtra <- FALSE
.rxSupportedFuns <- function(extra = .rxSupportedFunsExtra) {
  .ret <- c(
    names(.rxSEsingle), names(.rxSEdouble), names(.rxSEeq),
    "linCmt", names(.rxOnly), ls(.symengineFs())
  )
  if (extra) {
    .ret <- c(.ret, c("linCmtA","linCmtB",
      "rxEq", "rxNeq", "rxGeq", "rxLeq", "rxLt",
      "rxGt", "rxAnd", "rxOr", "rxNot", "dabs", "dabs2", "abs0",
      "dabs1", "abs1"
    ))
  }

  .df <- rxode2parseGetTranslation()
  .w <- which(.df$package %in% c("rxode2", "rxode2ll"))
  .df <- .df[-.w, ,drop=FALSE]

  .ret <- c(.ret, .df$rxFun)

  # remove operators
  .ret <- setdiff(.ret,
                  c("==", "!=", ">=", "<=", "<", ">", "&&", "||", "&", "|", "!", "+", "-", "*", "**", "^", "/"))
  .ret
}


#' Get list of supported functions
#'
#' @return list of supported functions in rxode2
#' @examples
#' rxSupportedFuns()
#' @export
rxSupportedFuns <- function() {
  .rxSupportedFuns(FALSE)
}

.rxFunEq <- c(
  "Rx_pow_di"=2,
  "Rx_pow"=2,
  "R_pow_di"=2,
  "R_pow"=2,
  "lgamma" = 1,
  "abs" = 1,
  "acos" = 1,
  "acosh" = 1,
  "asin" = 1,
  "asinh" = 1,
  "atan" = 1,
  "atan2" = 2,
  "atanh" = 1,
  "beta" = 2,
  "cos" = 1,
  "cosh" = 1,
  "erf" = 1,
  "erfc" = 1,
  "exp" = 1,
  "log" = 1,
  "sin" = 1,
  "sinh" = 1,
  "sqrt" = 1,
  "tan" = 1,
  "tanh" = 1,
  ## C's math.h library
  "floor" = 1,
  "round" = 1,
  "ceil" = 1,
  "trunc" = 1,
  ## Special R functions
  "bessel_i" = 3,
  "bessel_j" = 2,
  "bessel_k" = 3,
  "bessel_y" = 2,
  "logspace_add" = 2,
  "logspace_sub" = 2,
  "fmax2" = 2,
  "fmin2" = 2,
  "sign" = 1,
  "fsign" = 2,
  "fprec" = 2,
  "fround" = 2,
  "ftrunc" = 2,
  "transit" = NA,
  "gammaq" = 2,
  "gammapDer" = 2,
  "gammapInv" = 2,
  "gammapInva" = 2,
  "gammaqInv" = 2,
  "gammaqInva" = 2,
  "lowergamma" = 2,
  "uppergamma" = 2)

.rxOnly <- c(
  ## Now random number generators
  "rnorm" = NA,
  "rxnorm" = NA,
  "rxbinom" = 2,
  "rbinom" = 2,
  "rxcauchy" = NA,
  "rcauchy" = NA,
  "rchisq" = 1,
  "rxchisq" = 1,
  "rexp" = 1,
  "rxexp" = 1,
  "rbeta" = 2,
  "rxbeta" = 2,
  "rgeom" = 1,
  "rxgeom" = 1,
  "rxpois" = 1,
  "rpois" = 1,
  "rxt" = 1,
  "rt" = 1
)


.rxFun2cNameOrAtomic <- function(x, envir) {
  # see if it is a reserved rxode2 name/function for name clashes
  x <- as.character(x)
  if (!exists("res", envir=envir)) {
    envir$res <- c(rxSupportedFuns(),
                    rxode2::rxReservedKeywords[, 1],
                    strsplit(paste(rxode2::rxReservedKeywords[, 3],collapse=","),"[,]+")[[1]])
  }
  if (x %in% envir$funs) {
    return(paste0("_qf_", x))
  }
  x
}

.rxFun2cArithmeticOperators <- function(x, envir) {
  if (length(x) == 3) {
    if (identical(x[[1]], quote(`/`))) {
      .x2 <- x[[2]]
      .x3 <- x[[3]]
      ## df(%s)/dy(%s)
      if (identical(.x2, quote(`d`)) &&
            identical(.x3[[1]], quote(`dt`))) {
        if (length(.x3[[2]]) == 1) {
          .state <- as.character(.x3[[2]]) # .rxToSE(.x3[[2]], envir = envir)
        } else {
          .state <- .rxFun2c(.x3[[2]], envir = envir)
        }
        stop("d/dt(", .state, ") not supported in functions for translation")
      } else {
        if (length(.x2) == 2 && length(.x3) == 2) {
          if (identical(.x2[[1]], quote(`df`)) &&
                identical(.x3[[1]], quote(`dy`))) {
            if (length(.x2[[2]]) == 1) {
              .state <- as.character(.x2[[2]])
            } else {
              .state <- .rxFun2c(.x2[[2]], envir = envir)
            }
            if (length(.x3[[2]]) == 1) {
              .var <- as.character(.x3[[2]])
            } else {
              .var <- .rxFun2c(.x3[[2]], envir = envir)
            }
            stop("df(", .state, ")/dy(", .var, ") statements are not supported in translation",
                 call. = FALSE)
          }
        }
        .ret <- paste0(
          .rxFun2c(.x2, envir = envir),
          as.character(x[[1]]),
          .rxFun2c(.x3, envir = envir)
        )
      }
    } else if (identical(x[[1]], quote(`^`)) ||
                 identical(x[[1]], quote(`**`))) {
      if (is.numeric(x[[3]]) &&
            checkmate::checkIntegerish(x[[3]])) {
        return(paste0("R_pow_di(", .rxFun2c(x[[2]], envir = envir), ",",
                     as.character(x[[3]]), ")"))
      } else {
        return(paste0("R_pow(", .rxFun2c(x[[2]], envir=envir), ",",
                     .rxFun2c(x[[3]], envir=envir), ")"))
      }
    } else {
      .ret <- paste0(
        .rxFun2c(x[[2]], envir = envir),
        as.character(x[[1]]),
        .rxFun2c(x[[3]], envir = envir)
      )
    }
    return(.ret)
  } else {
    ## Unary Operators
    return(paste(
      as.character(x[[1]]),
      .rxFun2c(x[[2]], envir = envir)
    ))
  }
}
.rxFun2cAssignOperators <- function(x, envir = envir) {
  ## if (!envir$isRx && identical(x[[1]], quote(`~`))) {
  ##   stop("formulas or other expressions with '~` are not supported in translation",
  ##        call.=FALSE)
  ## }
  if (as.character(x[[2]]) %in% envir$args) {
    stop("cannot assign argument '", as.character(x[[2]]),
         "' in functions converted to C",
         call.=FALSE)
  }
  .lhs <- .rxFun2cNameOrAtomic(x[[2]], envir=envir)
  if (!(.lhs %in% envir$args)) {
    envir$vars <- c(envir$vars, .lhs)
  }
  envir$didAssign <- TRUE
  .pre <- paste0(rep(" ", envir$n), collapse="")
  if (envir$isRx) {
    paste0(.lhs, " <- ",
           .rxFun2c(x[[3]], envir=envir), "\n",
           "rxLastValue <-", .lhs, "\n")
  } else {
    paste0(.pre, "_lastValue = ", .lhs, " = ",
                  .rxFun2c(x[[3]], envir=envir), ";\n")
  }
}

.rxFun2cSquareBracket <- function(x, envir) {
  stop("bracket expressions (ie ret[3]) are not supported in translation",
       call. = FALSE)
}

.rxFun2cLogic <- function(x, envir) {
  if (identical(x[[1]], quote(`!`))) {
    return(paste0("!(", .rxFun2c(x[[2]], envir=envir), ")"))
  } else if (identical(x[[1]], quote(`&`))) {
    return(paste0(.rxFun2c(x[[2]], envir=envir), " && ",
                  .rxFun2c(x[[3]], envir=envir)))
  } else if (identical(x[[1]], quote(`|`))) {
    return(paste0(.rxFun2c(x[[2]], envir=envir), " || ",
                  .rxFun2c(x[[3]], envir=envir)))
  } else {
    return(paste0(.rxFun2c(x[[2]], envir=envir), " ", as.character(x[[1]]), " ",
                  .rxFun2c(x[[3]], envir=envir)))
  }
}

.rxFun2cIf <- function(x, envir) {
  .logic <- .rxFun2c(x[[2]], envir=envir)
  .pre <- paste0(rep(" ", envir$n), collapse="")
  .ret <- paste(.pre, "if (", .logic, ") ")
  .ret <- paste0(.ret, .rxFun2c(x[[3]], envir=envir))

  if (length(x) == 3) {
    envir$isExpr <- TRUE
    return(.ret)
  }
  .ret <- sub("else +if", "else if", paste0(.ret, .pre, "else ", .rxFun2c(x[[4]], envir=envir)))
  envir$isExpr <- TRUE
  return(.ret)
}

.rxFun2cCall <- function(x, envir) {
  if (identical(x[[1]], quote(`{`))) {
    .ret <- "{\n"
    envir$n <- envir$n + 2
    .ret <- paste0(.ret,
                   paste(vapply(seq_along(x)[-1],
                                function(i) {
                                  .cur <- x[[i]]
                                  .last <- envir$didAssign
                                  .expr <-  envir$isExpr
                                  on.exit({
                                    assign("isExpr", .expr, envir=envir)
                                    assign("didAssign", .last, envir=envir)
                                  })
                                  envir$didAssign <- FALSE
                                  .cur <- .rxFun2c(.cur, envir=envir)
                                  if(!envir$didAssign && !envir$isExpr) {
                                    .pre <- paste0(rep(" ", envir$n), collapse="")
                                    if (envir$isRx) {
                                      return(paste0(.pre, "rxLastValue <- ", .cur, "\n"))
                                    } else {
                                      return(paste0(.pre, "_lastValue = ", .cur, ";\n"))
                                    }
                                  }
                                  .cur
                                }, character(1), USE.NAMES = FALSE),
                         collapse=""))
    envir$n <- envir$n - 2
    .pre <- paste0(rep(" ", envir$n), collapse="")
    .ret <- paste0(.ret, .pre, "}\n")
    return(.ret)
  } else if (identical(x[[1]], quote(`(`))) {
    return(paste0("(", .rxFun2c(x[[2]], envir = envir), ")"))
  } else if (identical(x[[1]], quote(`&`)) ||
               identical(x[[1]], quote(`&&`)) ||
               identical(x[[1]], quote(`==`)) ||
               identical(x[[1]], quote(`||`)) ||
               identical(x[[1]], quote(`|`)) ||
               identical(x[[1]], quote(`>`)) ||
               identical(x[[1]], quote(`<`)) ||
               identical(x[[1]], quote(`<=`)) ||
               identical(x[[1]], quote(`>=`)) ||
               identical(x[[1]], quote(`!=`)) ||
               identical(x[[1]], quote(`!`))
               ) {
    return(.rxFun2cLogic(x, envir=envir))
  } else if (identical(x[[1]], quote(`*`)) ||
               identical(x[[1]], quote(`**`)) ||
               identical(x[[1]], quote(`^`)) ||
               identical(x[[1]], quote(`+`)) ||
               identical(x[[1]], quote(`-`)) ||
               identical(x[[1]], quote(`/`))) {
    return(.rxFun2cArithmeticOperators(x, envir = envir))
  } else if (identical(x[[1]], quote(`=`)) ||
               identical(x[[1]], quote(`<-`)) ||
               identical(x[[1]], quote(`~`))) {
    return(.rxFun2cAssignOperators(x, envir))
  } else if (identical(x[[1]], quote(`[`))) {
    return(.rxFun2cSquareBracket(x, envir = envir))
  } else if (identical(x[[1]], quote(`if`))) {
    return(.rxFun2cIf(x, envir = envir))
  } else {
    # supported functions
    if (identical(x[[1]], quote(`return`))) {
      envir$hasReturn <- TRUE
      .pre <- paste0(rep(" ", envir$n), collapse="")
      envir$didAssign <- TRUE
      return(paste0(.pre, "return (", .rxFun2c(x[[2]], envir=envir), ");\n"))
    }
    .ret0 <- lapply(x, .stripP)
    .FunEq <- c(.rxFunEq, .rxSEeqUsr())
    .curName <- paste(.ret0[[1]])
    .nargs <- .FunEq[.curName]
    if (!is.na(.nargs)) {
      if (.nargs == length(.ret0) - 1) {
        return(paste0(.curName, "(",
                      paste(vapply(seq_along(.ret0)[-1],
                                  function(i) {
                                    .rxFun2c(.ret0[[i]], envir=envir)
                                  }, character(1), USE.NAMES=FALSE),
                            collapse=","),
                      ")"))
      }
    }
    stop("cannot translate function '", .curName, "'",
         call.=FALSE)
  }
}

.rxFun2c <- function(x, envir) {
  if (is.name(x) || is.atomic(x)) {
    return(.rxFun2cNameOrAtomic(x, envir=envir))
  } else if (is.call(x)) {
    return(.rxFun2cCall(x, envir = envir))
  } else {
    stop("unsupported expression", call. = FALSE)
  }
}

#' Calculate derivatives/C code from a R function
#'
#' @param fun Function to convert to C
#'
#' @param name function name to convert to C, implied if needed
#'
#' @param onlyF Only calculate the C for the function, don't calculate the derivatives
#'
#' @return A list with C code and derivative information
#'
#' @keywords internal
#'
#' @noRd
rxFun2c <- function(fun, name, onlyF=FALSE) {
  .env <- new.env(parent=emptyenv())
  .env$vars <- character(0)
  if (!missing(name)) {
    .funName <- name
  } else {
    .funName <- as.character(substitute(fun))
  }
  .f <- formals(fun)
  .env$args <- names(.f)
  .env$n <- 2
  .env$isExpr <- FALSE
  .env$isRx <- FALSE
  .env$hasReturn <- FALSE
  if (any(.env$args == "...")) {
    stop("functions with ... in them are not supported",
         call. =FALSE)
  }
  .start <- paste0("double ", .funName, "(", paste(paste("double ", .env$args), collapse=", "),
                   ") {\n")

  .body <- as.list(body(fun))
  .body <- paste(vapply(seq_along(.body)[-1], function(i) {
    .extra <- .extra2 <- ""
    .cur <- .body[[i]]
    .env$didAssign <- FALSE
    .cur <- .rxFun2c(.cur, envir=.env)
    if(!.env$didAssign && !.env$isExpr) {
      .pre <- paste0(rep(" ", .env$n), collapse="")
      if (.env$isRx) {
        return(paste0(.pre, "rxLastValue <- ", .cur, "\n"))
      } else {
        return(paste0(.pre, "_lastValue = ", .cur, ";\n"))
      }
    }
    .env$isExpr <- FALSE
    .cur
  },
  character(1), USE.NAMES=FALSE), collapse="")

  .start <- paste0(.start,
                   paste0("  double ",
                          paste(paste0(c("_lastValue", unique(.env$vars)), "=NA_REAL"), collapse=","),
                          ";\n"))
  .stop <- "  return _lastValue;\n}\n"
  .cCode <- paste0(.start, .body, .stop)
  .ret <- list(name=.funName,
               args=.env$args,
               cCode=.cCode)

  if (onlyF) {
    return(.ret)
  }
  if (!.env$hasReturn) {
    # Can calculate derivatives
    # Firs create an rxode2 like model:
    .env <- new.env(parent=emptyenv())
    .env$isRx <- TRUE
    .env$args <- names(.f)
    .env$n <- 2
    .env$isExpr <- FALSE
    .env$hasReturn <- FALSE
    .body <- as.list(body(fun))
    .body <- paste(vapply(seq_along(.body)[-1], function(i) {
      .extra <- .extra2 <- ""
      .cur <- .body[[i]]
      .env$didAssign <- FALSE
      .cur <- .rxFun2c(.cur, envir=.env)
      if(!.env$didAssign && !.env$isExpr) {
        .pre <- paste0(rep(" ", .env$n), collapse="")
        return(paste0(.pre, "rxLastValue = ", .cur, ";\n"))
      }
      .env$isExpr <- FALSE
      .cur
    },
    character(1), USE.NAMES=FALSE), collapse="")
    # take out if/else
    .body <- rxPrune(.body)
    .s <- rxS(.body)
    .lastValue <- .s$rxLastValue
    return(c(list(.ret),
      lapply(.env$args, function(v) {
      .v <- symengine::D(.lastValue, symengine::S(v))
      .v <- paste0("function(", paste(.env$args, collapse=", "), ") {\n", rxOptExpr(paste0("rxLastValue=", rxFromSE(.v)), msg=paste0("d(", .funName, ")/d(", v, ")")),
                   "\nrxLastValue}")
      .v <- eval(str2lang(.v))
      .dName <-  paste0("rx_", .funName, "_d_", v)
      .v <- rxFun2c(.v, .dName, onlyF=TRUE)
      .v2 <- paste0("function(", paste(.env$args, collapse=", "), "){\n",
                  "paste0(\"", .dName, "(\", ",
                  paste(.env$args, collapse=", \", \", "), ", \")\")",
                  "}")
      .v2 <- eval(str2lang(.v2))
      c(.v, list(.v2))
    })))
  } else {
    message("function contains return statement; derivatives not calculated")
  }
  return(list(.ret))
}
