R/utils.R

Defines functions .stop update_list combine_list cvec_cs split_id select_par re_id list_2_idata

Documented in select_par

list_2_idata <- function(x) {
  imap(x, function(value,name) {
    tibble(ID = seq(length(value)),!!sym(name) := value)
  }) %>% re_id()
}

re_id <- function(x) {
  maxid <- 0
  for(i in seq_along(x)) {
    if(i==1) {
      maxid <- max(x[[i]][["ID"]])  
      next
    }
    x[[i]][["ID"]] <- x[[i]][["ID"]] + maxid
    maxid <- max(x[[i]][["ID"]])
  }
  x
}

#' Identify parameters in a model for sensitivity analysis
#' 
#' @param mod an mrgsolve model object
#' @param ... unquoted parameter names
#' 
#' @examples
#' mod <- mrgsolve::house()
#' select_par(mod, CL, VC)
#' 
#' @export
select_par <- function(mod, ...) {
  assert_that(inherits(mod, "mrgmod"))
  p <- vars_select(names(param(mod)),!!!quos(...))
  mod@args[["select"]] <- p
  mod
}

split_id <- function(x) {
  split(x,x$ID)  
}

cvec_cs <- function(x) {
  if(is.null(x) | length(x)==0) return(character(0))
  x <- unlist(strsplit(as.character(x),",",fixed=TRUE),use.names=FALSE)
  x <- unlist(strsplit(x," ",fixed=TRUE),use.names=FALSE)
  x <- x[x!=""]
  if(length(x)==0) {
    return(character(0))
  } else {
    return(x) 
  }
}

combine_list <- function(left, right) {
  if(!all(is.list(left),is.list(right))) {
    stop("input are not lists")
  }
  left[names(right)] <-  right
  left
}

update_list <- function(left, right) {
  if(!all(is.list(left),is.list(right))) {
    stop("input are not lists")
  }
  common <- intersect(names(left), names(right))
  left[common] <-  right[common]
  left
}

.stop <- function(...) stop(..., call. = FALSE)

Try the mrgsim.sa package in your browser

Any scripts or data that you put into this service are public.

mrgsim.sa documentation built on Nov. 30, 2020, 5:08 p.m.