Select vpc vpc_vpc based on vpc version installed.

NAMESPACE

@@ -215,5 +215,4 @@ importFrom(utils,sessionInfo)
 importFrom(utils,stack)
 importFrom(utils,str)
 importFrom(utils,tail)
-importFrom(vpc,vpc)
 useDynLib(nlmixr, .registration=TRUE)

R/vpc.R

@@ -56,10 +56,13 @@ vpc <- function (sim, ...)
 vpc.default <- function(sim, ...){
     ns <- loadNamespace("vpc");
     if (exists("vpc_vpc",ns)){
-        vpc::vpc_vpc(sim, ...)
+        vpcn <- "vpc_vpc"
     } else {
-        vpc::vpc(sim, ...)
+        vpcn <- "vpc"
     }
+    call <- as.list(match.call(expand.dots=TRUE))[-1];
+    call <- call[names(call) %in% methods::formalArgs(getFromNamespace(vpcn,"vpc"))]
+    p = do.call(getFromNamespace(vpcn,"vpc"), call, envir = parent.frame(1))
 }
 
 #' Visual predictive check (VPC) for nlmixr nlme objects
@@ -69,14 +72,15 @@ vpc.default <- function(sim, ...){
 #' @param fit nlme fit object
 #' @param nsim number of simulations
 #' @param condition conditional variable
+#' @param ... Additional arguments
 #' @inheritParams vpc::vpc
 #' @return NULL
 #' @examples
 #' specs <- list(fixed=lKA+lCL+lV~1, random = pdDiag(lKA+lCL~1), start=c(lKA=0.5, lCL=-3.2, lV=-1))
 #' fit <- nlme_lin_cmpt(theo_md, par_model=specs, ncmt=1, verbose=TRUE)
 #' vpc(fit, nsim = 100, condition = NULL)
 #' @export
-vpc_nlmixr_nlme = function(fit, nsim=100, condition=NULL)
+vpc_nlmixr_nlme = function(fit, nsim=100, condition=NULL, ...)
 {
     nlmeModList(fit$env);
     on.exit({nlmeModList(new.env(parent=emptyenv()))})

R/vpc.nlme.R

@@ -1,4 +1,4 @@
-vpc.nlme = function (fit, nsim = 100, by = NULL, ...) 
+vpc.nlme = function (fit, nsim = 100, by = NULL, ...)
 {
     if (class(fit) == "nlmixr.ui.nlme") fit = as.nlme(fit)
     dat = getData(fit)
@@ -30,11 +30,19 @@ vpc.nlme = function (fit, nsim = 100, by = NULL, ...)
     xs = do.call("cbind", s)
 
     df = cbind(xd[ord, c("ID", "TIME", "grp")], DV = as.vector(xs), SIM = sim)
-    if (!is.null(by)) {
-        p = vpc::vpc(sim = df, obs = dat, strat = c("grp"), facet = "wrap", ...)
+    ns <- loadNamespace("vpc");
+    if (exists("vpc_vpc",ns)){
+        vpcn <- "vpc_vpc"
     } else {
-        p = vpc::vpc(sim = df, obs = dat, ...)
+        vpcn <- "vpc"
+    }
+    call <- as.list(match.call(expand.dots=TRUE))[-1];
+    if (!is.null(by)) {
+        call$strat <- c("grp")
+        call$facet <- "wrap";
     }
+    call <- call[names(call) %in% methods::formalArgs(getFromNamespace(vpcn,"vpc"))]
+    p = do.call(getFromNamespace(vpcn,"vpc"), c(list(sim=df, obs=dat), call), envir = parent.frame(1))
     print(p)
     invisible(df)
 }

R/vpc.saemFit.R

@@ -57,11 +57,19 @@ vpc_saemFit = function(fit, dat, nsim = 100, by=NULL, ...) {
   xs = do.call("cbind",s)
   df = cbind(xd[ord, c("ID", "TIME", "grp")], DV=as.vector(xs), SIM=sim)
 
-  if (!is.null(by)) {
-      p = vpc::vpc(sim = df, obs = dat, strat=c("grp"), facet="wrap", ...)
+  ns <- loadNamespace("vpc");
+  if (exists("vpc_vpc",ns)){
+      vpcn <- "vpc_vpc"
   } else {
-      p = vpc::vpc(sim = df, obs = dat, ...)
+      vpcn <- "vpc"
+  }
+  call <- as.list(match.call(expand.dots=TRUE))[-1];
+  if (!is.null(by)) {
+      call$strat <- c("grp")
+      call$facet <- "wrap";
   }
+  call <- call[names(call) %in% methods::formalArgs(getFromNamespace(vpcn,"vpc"))]
+  p = do.call(getFromNamespace(vpcn,"vpc"), c(list(sim=df, obs=dat), call), envir = parent.frame(1))
   print(p)
 
   invisible(df)

R/vpc.ui.R

@@ -9,7 +9,7 @@
 ##' @inheritParams vpc::vpc
 ##' @inheritParams RxODE::rxSolve
 ##' @param ... Args sent to \code{\link[RxODE]{rxSolve}}
-##' @inheritParams vpc::vpc
+##' @return Simulated dataset (invisibly)
 ##' @author Matthew L. Fidler
 ##' @export
 vpc_ui <- function(fit, data=NULL, n=100, bins = "jenks",
@@ -100,7 +100,9 @@ vpc_ui <- function(fit, data=NULL, n=100, bins = "jenks",
     call$obs_cols = list(id="id", dv="dv", idv="time")
     call$sim_cols = list(id="id", dv="dv", idv="time")
     call$stratify = stratify
-    do.call(getFromNamespace(vpcn,"vpc"), c(list(sim=sim, obs=dat), call), envir = parent.frame(1))
+    p = do.call(getFromNamespace(vpcn,"vpc"), c(list(sim=sim, obs=dat), call), envir = parent.frame(1))
+    print(p);
+    return(invisible(sim));
 }
 
 
@@ -128,7 +130,3 @@ vpc.nlmixr.ui.nlme <- function(sim, ...){
 vpc.ui <- function(sim, ...){
     vpc_ui(fit=sim, ...);
 }
-
-##' @importFrom vpc vpc
-##' @export
-vpc::vpc