# Copyright (C) 2013 - 2019 Metrum Research Group
#
# This file is part of mrgsolve.
#
# mrgsolve is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# mrgsolve is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with mrgsolve. If not, see <http://www.gnu.org/licenses/>.
##' Re-evaluate the code in the ENV block
##'
##' The \code{$ENV} block is a block of R code that can
##' realize any sort of R object that might be used in running
##' a model.
##'
##' @seealso \code{\link{env_get}}, \code{\link{env_ls}}
##'
##' @param x model object
##' @param seed passed to \code{\link{set.seed}} if a numeric value is supplied
##'
##' @export
env_eval <- function(x,seed=NULL) {
if(is.numeric(seed)) set.seed(seed)
eval_ENV_block(x=x@envir$.code,where=project(x),envir=x@envir)
return(invisible(x))
}
##' List objects in the model environment
##'
##' Each model keeps an internal environment that allows the user
##' to carry any \code{R} object along. Objects are coded in \code{$ENV}.
##'
##' @param x model object
##' @param ... passed to \code{\link{ls}}
##'
##' @export
env_ls <- function(x,...) {
objects <- ls(x@envir,...)
cl <- sapply(objects,function(o) {
paste(class(get(o,x@envir)),collapse=',')
})
ans <- data.frame(object=objects,class=cl)
rownames(ans) <- NULL
arrange__(ans, .dots=c("class"))
}
##' Return model environment
##'
##' @param x model object
##' @param tolist should the environment be coerced to \code{list}?
##'
##' @export
env_get <- function(x,tolist=TRUE) {
if(tolist) {
return(as.list(x@envir))
} else {
return(x@envir)
}
}
##' @rdname env_get
##' @export
env_get_env <- function(x) {
x@envir
}
##' Update objects in model environment
##'
##' @param .x model object
##' @param .dots list of objects to updated
##' @param ... objects to update
##'
##' @export
env_update <- function(.x,...,.dots=list()) {
right <- c(list(...),.dots)
left <- as.list(.x@envir)
.x@envir <- as.environment(merge.list(left,right))
return(invisible(.x))
}
##' Run the model cama function
##'
##' @param mod model object
##' @param fn function name
##' @param ... passed to update
##'
##' @details \code{sah-mah}
##'
##' @keywords internal
##' @export
cama <- function(mod,fn="cama",...) {
stop("this function is deprecated.")
# object_exists(fn, mod@envir, "function", inherits=FALSE)
# f <- get(fn, mod@envir, inherits=FALSE)
# mod %>% update(...) %>% f
}
# param_in_env <- function(x) {
# p <- as.list(param(x))
# list2env(p[setdiff(names(p),ls(x@envir))],envir=x@envir)
# }
#
# param_out_env <- function(x) {
# what <- intersect(names(param(x)),ls(envir=x@envir))
# rm(list=what,envir=x@envir)
# return(invisible(x))
# }
#
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.