Merge pull request #580 from nlmixr2/579-plot-for-confint-objects-all…

…ows-subsetting

579 plot for confint objects allows subsetting

NEWS.md

@@ -88,15 +88,20 @@ mu-referencing style to run the optimization.
   intervals without bands on each of the percentiles; You can also
   choose not to match the secondary bands limits with `levels` but use
   your own `ci=0.99` for instance
-  
+
 - A new function was introduced `meanProbs()` which calculates the
   mean and expected quantiles under either the normal or t
   distribution
-    
+
 - When calculating the intervals for `rxode2` simulated objects you
   can also use `mean=TRUE` to use the mean for the first level of
   confidence using `meanProbs()`
 
+- When plotting the `confint` derived intervals from an `rxode2`
+  simulation, you can now subset based on a simulated value like
+  `plot(ci, Cc)` which will only plot the variable `Cc` that you
+  summarized even if you also summarized `eff` (for instance).
+
 ## Internal new features
 
 - Add `as.model()` for list expressions, which implies `model(ui) <-

R/plot.R

@@ -358,8 +358,26 @@ plot.rxSolve <- function(x, y, ..., log = "", xlab = "Time", ylab = "") {
 #' @export
 plot.rxSolveConfint1 <- function(x, y, ..., xlab = "Time", ylab = "", log = "") {
   .data <- NULL
+  .y <- as.character(substitute(y))
+  .call0 <- match.call()[-(1:2)]
+  .call <- as.list(.call0)
+  .w <- which(names(.call) %in% c("x", "y", "log", "xlab", "ylab"))
+  if (length(.w) > 0) {
+    .call <- .call[-.w]
+  }
+  .cmts <- c(
+    as.character(substitute(y)),
+    names(vapply(as.character(.call), `c`, character(1), USE.NAMES=FALSE)),
+    as.character(unlist(.call))
+  )
+  .cmts <- .cmts[.cmts != ""]
+  .cmts <- unique(.cmts)
   .lvl <- attr(class(x), ".rx")$lvl
   .parm <- attr(class(x), ".rx")$parm
+  if (length(.cmts) > 0) {
+    .parm <- intersect(.parm, .cmts)
+    x  <- x[x$trt %in% .parm,]
+  }
   .by <- attr(class(x), ".rx")$by
   .aes <- aes(.data$time, .data$eff)
   .facet <- NULL
@@ -421,9 +439,27 @@ plot.rxSolveConfint1 <- function(x, y, ..., xlab = "Time", ylab = "", log = "")
 #' @export
 plot.rxSolveConfint2 <- function(x, y, ..., xlab = "Time", ylab = "", log = "") {
   .data <- NULL
+  .y <- as.character(substitute(y))
+  .call0 <- match.call()[-(1:2)]
+  .call <- as.list(.call0)
+  .w <- which(names(.call) %in% c("x", "y", "log", "xlab", "ylab"))
+  if (length(.w) > 0) {
+    .call <- .call[-.w]
+  }
+  .cmts <- c(
+    as.character(substitute(y)),
+    names(vapply(as.character(.call), `c`, character(1), USE.NAMES=FALSE)),
+    as.character(unlist(.call))
+  )
+  .cmts <- .cmts[.cmts != ""]
+  .cmts <- unique(.cmts)
+  .parm <- attr(class(x), ".rx")$parm
+  if (length(.cmts) > 0) {
+    .parm <- intersect(.parm, .cmts)
+    x  <- x[x$trt %in% .parm,]
+  }
   .lvl <- attr(class(x), ".rx")$lvl
   .ci  <- attr(class(x), ".rx")$ci
-  .parm <- attr(class(x), ".rx")$parm
   .by <- attr(class(x), ".rx")$by
   .aes <- aes(.data$time, .data$p50,
     color = .data$Percentile,

tests/testthat/test-zzzz-plot.R

@@ -153,18 +153,20 @@ rxTest({
 
       ci1.C2 <- confint(sim, "C2", ci=0.99)
 
+      ci1.C3 <- confint(sim,  ci=0.99)
+
       ci1.C2.e <- confint(sim, "C2", by="extra")
 
       ci1.C2.eff <- confint(sim, c("C2", "eff"))
 
       ci1.C2.eff.e <- confint(sim, c("C2", "eff"), by="extra")
 
       sim2 <- rxSolve(m2, ev, omega = omega, nSub = 2500, keep="extra")
-      
+
       sim2R <- rxSolve(m2, evR, omega = omega, nSub = 2500)
 
       ci2.C2 <- confint(sim2, "C2")
-      
+
       ci2.C2.e <- confint(sim2, "C2", by="extra")
 
       ci2.C2.eff <- confint(sim2, c("C2", "eff"))
@@ -203,6 +205,8 @@ rxTest({
           vdiffr::expect_doppelganger(paste0("plot-", .xgxtxt, "all-log-yx-r"), suppressWarnings(sR %>% plot(log = "yx")))
 
           vdiffr::expect_doppelganger(paste0("plot-ci1c2", .xgxtxt), suppressWarnings(ci1.C2 %>% plot()))
+          vdiffr::expect_doppelganger(paste0("plot-ci1c3", .xgxtxt, "-centr"), suppressWarnings(ci1.C3 %>% plot("centr")))
+          vdiffr::expect_doppelganger(paste0("plot-ci1c3", .xgxtxt, "-full"), suppressWarnings(ci1.C3 %>% plot()))
           vdiffr::expect_doppelganger(paste0("plot-ci1c2", .xgxtxt, "log-x"), suppressWarnings(ci1.C2 %>% plot(log = "x")))
           vdiffr::expect_doppelganger(paste0("plot-ci1c2", .xgxtxt, "log-y"), suppressWarnings(ci1.C2 %>% plot(log = "y")))
           vdiffr::expect_doppelganger(paste0("plot-ci1c2", .xgxtxt, "log-xy"), suppressWarnings(ci1.C2 %>% plot(log = "xy")))