Merge pull request #43 from Calvagone/develop

Develop
Calvagone · Sep 11, 2024 · 264f677 · 264f677
2 parents f271467 + 2532d25
commit 264f677
Show file tree

Hide file tree

Showing 12 changed files with 211 additions and 90 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: campsismisc
 Title: Campsis Miscellaneous Package
-Version: 0.4.0
+Version: 0.4.1
 Authors@R: 
     person("Nicolas", "Luyckx", , "nicolas.luyckx@calvagone.com", role = c("aut", "cre"))
 Description: Campsis miscellaneous: a bunch of useful wrapper & helper
@@ -20,6 +20,7 @@ Imports:
     ggplot2,
     ggrepel,
     plyr,
+    progressr,
     purrr,
     rlang,
     tibble,

diff --git a/NAMESPACE b/NAMESPACE
@@ -44,4 +44,6 @@ exportClasses(sensitivity_analysis_item)
 exportClasses(sensitivity_analysis_items)
 importFrom(assertthat,assert_that)
 importFrom(plyr,is.formula)
+importFrom(progressr,with_progress)
+importFrom(progressr,without_progress)
 importFrom(rlang,as_function)
diff --git a/R/generic.R b/R/generic.R
@@ -49,6 +49,7 @@ setGeneric("getLabel", function(object, ...) {
 #' @param show_range show vertical dashed lines, logical
 #' @param range vertical dashed lines range, default is c(0.8, 1.25)
 #' @param ci confidence interval, default is 0.9, which corresponds to a 90\% CI
+#' @param limits limits of the forest plot, numeric vector (2 values)
 #' @param ... extra arguments like 'geom_label_vjust', 'geom_label_nudge_x', 'geom_label_nudge_y', 'geom_label_size', 'label_nsig', 'geom_hline_color'
 #' @return ggplot
 #' @export
@@ -57,7 +58,7 @@ getForestPlot <- function(object, index, relative, show_labels, show_ref, show_r
   stop("No default function is provided")
 }
 
-setGeneric("getForestPlot", function(object, index=NULL, relative=NULL, show_labels=NULL, show_ref=NULL, show_range=NULL, range=NULL, ci=NULL, ...) {
+setGeneric("getForestPlot", function(object, index=NULL, relative=NULL, show_labels=NULL, show_ref=NULL, show_range=NULL, range=NULL, ci=NULL, limits=NULL, ...) {
   if (is.null(index)) {
     index <- 1L
   } else {
@@ -81,6 +82,9 @@ setGeneric("getForestPlot", function(object, index=NULL, relative=NULL, show_lab
   if (is.null(ci)) {
     ci <- 0.9
   }
+  if (is.null(limits)) {
+    limits <- as.numeric(NA)
+  }
   standardGeneric("getForestPlot")
 })
 
@@ -94,7 +98,8 @@ setGeneric("getForestPlot", function(object, index=NULL, relative=NULL, show_lab
 #' @param index output number, 1 by default
 #' @param relative relative change or absolute value, logical
 #' @param show_labels show the numeric labels
-#' @param show_ref show vertical reference (at 0 or at the baseline) 
+#' @param show_ref show vertical reference (at 0 or at the baseline)
+#' @param limits limits of the tornado plot, numeric vector (2 values)
 #' @param ... extra arguments like 'geom_bar_width', 'geom_text_nudge_y', 'label_nsig', 'geom_hline_color', 'geom_text_size'
 #' @return ggplot
 #' @export
@@ -103,7 +108,7 @@ getTornadoPlot <- function(object, index, relative, show_labels, show_ref, ...)
   stop("No default function is provided")
 }
 
-setGeneric("getTornadoPlot", function(object, index=NULL, relative=NULL, show_labels=NULL, show_ref=NULL, ...) {
+setGeneric("getTornadoPlot", function(object, index=NULL, relative=NULL, show_labels=NULL, show_ref=NULL, limits=NULL, ...) {
   if (is.null(index)) {
     index <- 1L
   } else {
@@ -118,6 +123,9 @@ setGeneric("getTornadoPlot", function(object, index=NULL, relative=NULL, show_la
   if (is.null(show_ref)) {
     show_ref <- TRUE
   }
+  if (is.null(limits)) {
+    limits <- as.numeric(NA)
+  }
   standardGeneric("getTornadoPlot")
 })
 
diff --git a/R/oat_analysis.R b/R/oat_analysis.R
@@ -121,6 +121,7 @@ outfunNCA <- function(metric, x) {
 }
 
 #' @rdname prepare
+#' @importFrom progressr with_progress without_progress
 setMethod("prepare", signature=c("oat_analysis"), definition=function(object) {
   # Fix IIV, VARCOV_OMEGA, VARCOV_SIGMA at the beginning!
   # This way, calling disable is not needed in the scenarios
@@ -140,7 +141,10 @@ setMethod("prepare", signature=c("oat_analysis"), definition=function(object) {
   outvars <- outputs@list %>% purrr::map_chr(~getOutvars(.x)) %>% unique()
 
   # Compute and store baseline value of each output
-  base_scenario <- simulate(model=model, dataset=base_dataset, outvars=outvars, seed=seed, dest=dest)
+  # Progress from campsis is deactivated for the base scenario
+  base_scenario <- progressr::without_progress(
+    simulate(model=model, dataset=base_dataset, outvars=outvars, seed=seed, dest=dest)
+  )
   baselines <- base_scenario %>% computeBaseline(output=outputs)
 
   # Generate scenarios
@@ -195,8 +199,8 @@ setMethod("prepare", signature=c("oat_analysis"), definition=function(object) {
 #' @param geom_label_size size argument of method geom_label
 #' @param label_nsig number of significant digits in label
 #' @param geom_hline_color color argument of method geom_hline
-setMethod("getForestPlot", signature=c("oat_analysis", "integer", "logical", "logical", "logical", "logical", "numeric", "numeric"),
-          definition=function(object, index, relative, show_labels, show_ref, show_range, range, ci, 
+setMethod("getForestPlot", signature=c("oat_analysis", "integer", "logical", "logical", "logical", "logical", "numeric", "numeric", "numeric"),
+          definition=function(object, index, relative, show_labels, show_ref, show_range, range, ci, limits, 
                               geom_label_vjust=0, geom_label_nudge_x=0.15, geom_label_nudge_y=0, geom_label_size=3, label_nsig=3, geom_hline_color="darkblue", ...) {
 
   alpha <- (1-ci)/2
@@ -206,6 +210,11 @@ setMethod("getForestPlot", signature=c("oat_analysis", "integer", "logical", "lo
   results <- iResults@results
   baseline <- iResults@baseline
 
+  # Check limits argument
+  if (any(is.na(limits))) {
+    limits <- NULL
+  }
+
   # Recompute VALUE as relative value if relative is TRUE
   if (relative) {
     results$VALUE <- formula(results$VALUE, baseline)
@@ -238,7 +247,7 @@ setMethod("getForestPlot", signature=c("oat_analysis", "integer", "logical", "lo
   }
 
   plot <- plot +
-    ggplot2::coord_flip() +
+    ggplot2::coord_flip(ylim=limits) +
     ggplot2::ylab(paste0(ifelse(relative, "Relative ", ""), output %>% getName())) +
     ggplot2::xlab(NULL)
 
@@ -255,15 +264,20 @@ setMethod("getForestPlot", signature=c("oat_analysis", "integer", "logical", "lo
 #' @param label_nsig number of significant digits in label
 #' @param geom_hline_color color argument of method geom_hline
 #' @param geom_text_size size argument of method geom_text
-setMethod("getTornadoPlot", signature=c("oat_analysis", "integer", "logical", "logical", "logical"),
-          definition=function(object, index, relative, show_labels, show_ref,
+setMethod("getTornadoPlot", signature=c("oat_analysis", "integer", "logical", "logical", "logical", "numeric"),
+          definition=function(object, index, relative, show_labels, show_ref, limits,
                               geom_bar_width=0.5, geom_text_nudge_y=1, label_nsig=3, geom_hline_color="grey", geom_text_size=3, ...) {
   isSensitivityAnalysis <- is(object, "sensitivity_analysis")
   iResults <- object@results@list[[index]]
   output <- iResults@output
   results <- iResults@results
   baseline <- iResults@baseline
 
+  # Check limits argument
+  if (any(is.na(limits))) {
+    limits <- NULL
+  }
+
   # Tornado plots are bidirectional, forest plots aren't
   if (isSensitivityAnalysis) {
     results <- results %>%
@@ -321,19 +335,22 @@ setMethod("getTornadoPlot", signature=c("oat_analysis", "integer", "logical", "l
   summary$LABEL <- paste0(signif(summary %>% dplyr::pull(TORNADO_VALUE), digits=label_nsig))
 
   plot <- ggplot2::ggplot(data=summary, mapping=ggplot2::aes(x=ITEM_NAME, y=TORNADO_VALUE, fill=DIRECTION, label=LABEL)) +
-    ggplot2::coord_flip() +
-    ggplot2::geom_bar(stat="identity", position="identity", width=geom_bar_width) +
-    ggrepel::geom_text_repel(nudge_y=summary$NUDGE_Y, size=geom_text_size) +
+    ggplot2::coord_flip(ylim=limits) +
+    ggplot2::geom_bar(stat="identity", position="identity", width=geom_bar_width)
+
+  if (show_labels) {
+    plot <- plot +
+      ggrepel::geom_text_repel(nudge_y=summary$NUDGE_Y, size=geom_text_size)
+  }
+
+  plot <- plot +
     ggplot2::xlab(NULL) +
     ggplot2::labs(fill="Direction")
 
   if (show_ref) {
     plot <- plot + ggplot2::geom_hline(yintercept=ifelse(relative, 0,  baseline), color=geom_hline_color)
   }
 
-  if (!relative) {
-    plot <- plot 
-  }
   if (relative) {
     plot <- plot +
       ggplot2::ylab(paste0("Change in ", output %>% getName(), " (%)"))

diff --git a/README.Rmd b/README.Rmd
@@ -32,10 +32,6 @@ This model contains:
 # Configure hardware
 settings <- Settings(Hardware(cpu=8, replicate_parallel=TRUE))
 dest <- "mrgsolve" # Much faster than RxODE
-
-# Progress bar
-options(progressr.enable=TRUE)
-handlers(campsis::campsis_handler())
 ```
 
 

diff --git a/README.md b/README.md
@@ -84,10 +84,6 @@ This model contains:
 # Configure hardware
 settings <- Settings(Hardware(cpu=8, replicate_parallel=TRUE))
 dest <- "mrgsolve" # Much faster than RxODE
-
-# Progress bar
-options(progressr.enable=TRUE)
-handlers(campsis::campsis_handler())
 ```
 
 ### Effect of metabolism effect and weight on model parameters

diff --git a/man/getForestPlot.Rd b/man/getForestPlot.Rd
diff --git a/man/getTornadoPlot.Rd b/man/getTornadoPlot.Rd
diff --git a/tests/testthat/non_regression/oat_analysis/sensitivity_bio_ka_cl_vc_on_auc.csv b/tests/testthat/non_regression/oat_analysis/sensitivity_bio_ka_cl_vc_on_auc.csv
@@ -0,0 +1,9 @@
+"id","VALUE","SCENARIO"
+1,666.5,"BIO, up"
+1,166.63,"BIO, down"
+1,333.17,"KA, up"
+1,333.29,"KA, down"
+1,166.61,"CL, up"
+1,666,"CL, down"
+1,333,"VC, up"
+1,333.19,"VC, down"