Merge pull request #348 from ggPMXdevelopment/347-drop-tibble-as-imports

Drop tibble import

DESCRIPTION

@@ -39,7 +39,7 @@ Imports:
     yaml,
     R6,
     gtable,
-    ggplot2 (>= 2.2.0),
+    ggplot2 (>= 3.4.0),
     ggforce,
     magrittr,
     stringr,
@@ -53,7 +53,6 @@ Imports:
     purrr,
     readr,
     rlang,
-    tibble,
     checkmate,
     scales
 License: GPL-2
@@ -67,7 +66,8 @@ Suggests:
     nlmixr2data,
     lixoftConnectors,
     xgxr,
-    withr
+    withr,
+    lifecycle
 VignetteBuilder: knitr
 NeedsCompilation: no
 RoxygenNote: 7.2.3

NAMESPACE

@@ -120,6 +120,7 @@ importFrom(knitr,kable)
 importFrom(knitr,knit_hooks)
 importFrom(knitr,opts_chunk)
 importFrom(magrittr,"%>%")
+importFrom(rlang,.data)
 importFrom(rmarkdown,draft)
 importFrom(rmarkdown,render)
 importFrom(stats,cor)

R/ggPMX-package.R

@@ -32,4 +32,5 @@
 #' @importFrom yaml yaml.load_file
 #' @import data.table
 #' @importFrom assertthat assert_that
+#' @importFrom rlang .data
 NULL

R/plot-base.R

@@ -79,12 +79,20 @@ plot_pmx.pmx_gpar <- function(gpar, p, bloq_cens) {
     }
 
     if (scale_x_log10) {
-      p <- p %+% scale_x_log10(limits = ranges[["x"]])
+      if (rlang::is_installed("xgxr")) {
+        p <- p %+% xgxr::xgx_scale_x_log10(limits = ranges[["x"]])
+      } else {
+        p <- p %+% scale_x_log10(limits = ranges[["x"]])
+      }
       warning("Applying log to x variable will cause nonpositive values to be dropped.")
     }
 
     if (scale_y_log10) {
-      p <- p %+% scale_y_log10(limits = ranges[["y"]])
+      if (rlang::is_installed("xgxr")) {
+        p <- p %+% xgxr::xgx_scale_y_log10(limits = ranges[["y"]])
+      } else {
+        p <- p %+% scale_y_log10(limits = ranges[["y"]])
+      }
       warning("Applying log to y-variable will cause nonpositive values to be dropped.")
     }
 

R/plot-density.R

@@ -28,21 +28,21 @@
 #' \itemize{
 #' \item {\strong{linetype:}} {default to 1}
 #' \item {\strong{color:}} {default to black}
-#' \item {\strong{size:}} {default to 1}
+#' \item {\strong{linewidth:}} {default to 1}
 #' }
 #'
 #' \strong{snd_line} is a list that contains:
 #' \itemize{
 #' \item {\strong{linetype:}} {default to 2}
 #' \item {\strong{color:}} {default to black}
-#' \item {\strong{size:}} {default to 1}
+#' \item {\strong{linewidth:}} {default to 1}
 #' }
 #'
 #' \strong{vline} is a list that contains:
 #' \itemize{
 #' \item {\strong{linetype:}} {default to 3}
 #' \item {\strong{color:}} {default to black}
-#' \item {\strong{size:}} {default to 1}
+#' \item {\strong{linewidth:}} {default to 1}
 #' }
 #'
 pmx_dens <- function(
@@ -68,11 +68,11 @@ pmx_dens <- function(
     )
   }
   assert_that(is_list(labels))
-  default_var_line <- list(linetype = 1, colour = "black", size = 1)
+  default_var_line <- list(linetype = 1, colour = "black", linewidth = 1)
   var_line <- l_left_join(default_var_line, var_line)
-  default_snd_line <- list(linetype = 2, colour = "black", size = 1)
+  default_snd_line <- list(linetype = 2, colour = "black", linewidth = 1)
   snd_line <- l_left_join(default_snd_line, snd_line)
-  default_vline <- list(linetype = 3, colour = "black", size = 1)
+  default_vline <- list(linetype = 3, colour = "black", linewidth = 1)
   vline <- l_left_join(default_vline, snd_line)
   labels$subtitle <- ""
   structure(list(
@@ -138,7 +138,7 @@ plot_pmx.pmx_dens <- function(x, dx, ...) {
         guide="none"
       ) +
       guides(
-        linetype=guide_legend(title=NULL, override.aes=list(size=c(1,1))),
+        linetype=guide_legend(title=NULL, override.aes=list(linewidth=c(1,1))),
         colour=guide_legend(title=NULL)
       ) +
       vline_layer

R/plot-distribution.R

@@ -132,10 +132,13 @@ distrib.hist <- function(dx, strat.facet, strat.color, x) {
     formula("~EFFECT")
   }
   with(x, {
-    p <- ggplot(data = dx, aes_string(x = "VALUE"))
+    p <- ggplot(data = dx, aes(x = .data$VALUE))
     if (!is.null(strat.color)) {
+      if (is.formula(strat.color)) {
+        strat.color <- setdiff(as.character(strat.color), "~")
+      }
       histogram$fill <- NULL
-      histogram$mapping <- aes_string(fill = strat.color)
+      histogram$mapping <- aes(fill = .data[[strat.color]])
     }
     p <- p + do.call(geom_histogram, histogram)
     if (is.shrink && !is.null(x[["shrink.dx"]])) {
@@ -153,11 +156,13 @@ distrib.hist <- function(dx, strat.facet, strat.color, x) {
 }
 
 distrib.box <- function(dx, strat.color, strat.facet, x) {
-  EFFECT <- VALUE <- NULL
-  p <- ggplot(data = dx, aes_string(x = "EFFECT", y = "VALUE"))
+  p <- ggplot(data = dx, aes(x = .data$EFFECT, y = .data$VALUE))
 
   if (!is.null(strat.color)) {
-    p <- ggplot(data = dx, aes_string(fill = strat.color, x = "EFFECT", y = "VALUE"))
+    if (is.formula(strat.color)) {
+      strat.color <- setdiff(as.character(strat.color), "~")
+    }
+    p <- ggplot(data = dx, aes(fill = .data[[strat.color]], x = .data$EFFECT, y = .data$VALUE))
   }
 
   if (x$is.jitter) p <- p + jitter_layer(x$jitter, strat.color)

R/plot-eta-cov.R

@@ -135,12 +135,12 @@ plot_pmx.eta_cov <- function(x, dx, ...) {
       if (x$is.strat.color) {
         if(length(cats) > 1) {
           dx.cats <- dx.cats[, var_val = paste0(variable, value)]
-          boxplot_layers <- geom_boxplot(aes_string(x = "value", y = "VALUE", fill = "var_val"))
+          boxplot_layers <- geom_boxplot(aes(x = .data$value, y = .data$VALUE, fill = .data$var_val))
         }
-        else boxplot_layers <- geom_boxplot(aes_string(x = "value", y = "VALUE", fill = "value"))
+        else boxplot_layers <- geom_boxplot(aes(x = .data$value, y = .data$VALUE, fill = .data$value))
       }
       else {
-        boxplot_layers <- geom_boxplot(aes_string(x = "value", y = "VALUE"))
+        boxplot_layers <- geom_boxplot(aes(x = .data$value, y = .data$VALUE))
       }
 
       ggplot(dx.cats, measure.vars = cats) +
@@ -163,8 +163,8 @@ plot_pmx.eta_cov <- function(x, dx, ...) {
             ]
           )
       }
-      x$facets$facets <- stats::as.formula("EFFECT~variable")
-      p <- ggplot(dx.conts, aes_string(x = "value", y = "VALUE")) +
+      x$facets$rows <- stats::as.formula("EFFECT~variable")
+      p <- ggplot(dx.conts, aes(x = .data$value, y = .data$VALUE)) +
         do.call(geom_point, x$point) +
         ## do.call(geom_smooth, x$smooth) +
         do.call(facet_grid, x$facets)

R/plot-eta-pairs.R

@@ -75,7 +75,7 @@ eta_pairs <- function(
 
 lower.plot <- function(data, x, y, point, is.smooth, smooth, gp, is.hline, hline, ymax) {
   p <-
-    ggplot(data = data, aes_string(x = x, y = y)) + do.call(geom_point, point)
+    ggplot(data = data, aes(x = .data[[x]], y = .data[[y]])) + do.call(geom_point, point)
   if (is.smooth) {
     p <- p + do.call(geom_smooth, smooth)
   }
@@ -89,7 +89,7 @@ lower.plot <- function(data, x, y, point, is.smooth, smooth, gp, is.hline, hline
 }
 
 diag.plot <- function(data, x, gp, is.vreference_line, vreference_line) {
-  p <- ggally_densityDiag(data = data, aes_string(x = x))
+  p <- ggally_densityDiag(data = data, aes(x = .data[[x]]))
     if (is.vreference_line) {
       vreference_line1 <- vreference_line
       vreference_line1$xintercept <- -1.96
@@ -107,7 +107,7 @@ diag.plot <- function(data, x, gp, is.vreference_line, vreference_line) {
 
 
 upper.plot <- function(data, x, y, text_color, gp) {
-  p <- ggally_cor(data = data, aes_string(x = x, y = y), colour = text_color)
+  p <- ggally_cor(data = data, aes(x = .data[[x]], y = .data[[y]]), colour = text_color)
   plot_pmx(gp, p)
 }
 

R/plot-individual.R

@@ -89,8 +89,8 @@ plot_pmx.individual <-
         } else {strat.facet}
       }
 
-      dx <- tidyr::drop_na(dx, faceting_column)
-      x[["dx"]] <- tidyr::drop_na(x[["dx"]], faceting_column)
+      dx <- tidyr::drop_na(dx, tidyr::all_of(faceting_column))
+      x[["dx"]] <- tidyr::drop_na(x[["dx"]], tidyr::all_of(faceting_column))
     }
 
     strat.color <- x[["strat.color"]]
@@ -130,11 +130,11 @@ plot_pmx.individual <-
           if (bloq$limit %in% names(bloq$data)) {
             bloq$data[!is.na(get(bloq$limit)), "y_end" := as.numeric(get(bloq$limit))]
             bloq$mapping <-
-            aes_string(
-              xend = "TIME",
-              yend = "y_end"
+            aes(
+              xend = .data$TIME,
+              yend = .data$y_end
             )
-          bloq$cens <- bloq$limit <- NULL
+            bloq$cens <- bloq$limit <- bloq$size <- NULL
           do.call(geom_segment, bloq)
           }
         }
@@ -163,7 +163,7 @@ plot_pmx.individual <-
 
       shape_values <- c(rep(point.shape, n + 1))
       shape_values_leg <- c(rep(point.shape, n - 1), rep(20, 2))
-      size_values <- c(rep(1, n - 1), ipred_line$size, pred_line$size)
+      linewidth_values <- c(rep(1, n - 1), ipred_line$linewidth, pred_line$linewidth)
       if (any(point$data$isobserv == "ignored"))
         colour_values <- c(point$colour[1],
                            get_invcolor(point$colour),
@@ -175,35 +175,14 @@ plot_pmx.individual <-
                            pred_line$colour)
       keywidth_values <- c(rep(0, n - 1), rep(2, 2))
 
-      # boolean to see if ggplot2 is >= v 3.4.0 (some impact on syntax)
-      ggp2_gte_340 <- compareVersion(
-        as.character(packageVersion("ggplot2")), "3.3.6.9000"
-      ) > 0
-
-      # setting size_lw param depending on ggplot2 version
-      size_or_linewidth <- ifelse(ggp2_gte_340, "linewidth", "size")
-
       p <- ggplot(dx, aes(TIME, DV, shape = isobserv, colour = isobserv)) +
         p_point +
-        do.call(geom_line, setNames(
-          list(
-            aes(
-              y = IPRED, linetype = "individual predictions",
-              colour = "individual predictions"
-            ),
-            ipred_line[["size"]]
-          ),
-          c("mapping", size_or_linewidth)
-        )) + do.call(geom_line, setNames(
-          list(
-            aes(
-              y = PRED, linetype = "population predictions",
-              colour = "population predictions"
-            ),
-            pred_line[["size"]]
-          ),
-          c("mapping", size_or_linewidth)
-        )) +
+        geom_line(aes(y=.data$IPRED, linetype = "individual predictions",
+                      colour = "individual predictions"),
+                  linewidth=ipred_line[["linewidth"]]) +
+        geom_line(aes(y = .data$PRED, linetype = "population predictions",
+                    colour = "population predictions"),
+                linewidth=pred_line[["linewidth"]]) +
         scale_linetype_manual(
           values = setNames(
             linetype_values,
@@ -227,7 +206,7 @@ plot_pmx.individual <-
             override.aes = list(
               linetype = linetype_values,
               shape = shape_values_leg,
-              size = size_values
+              linewidth = linewidth_values
             ),
             title = NULL,
             keywidth = keywidth_values

R/plot-qq.R

@@ -174,7 +174,7 @@ plot_pmx.pmx_qq <- function(x, dx, ...) {
   }
 
 
-  p <- ggplot(dx, aes_string(sample = x$x)) +
+  p <- ggplot(dx, aes(sample = .data[[x$x]])) +
     with(
       x$point,
       geom_point(
@@ -194,12 +194,15 @@ plot_pmx.pmx_qq <- function(x, dx, ...) {
   }
 
   reference_layer <- if (!is.null(x$is.reference_line) && x$is.reference_line) {
-    x$reference_line$mapping <- aes_string(slope = "slope", intercept = "intercept")
+    x$reference_line$mapping <- aes(slope = .data$slope, intercept = .data$intercept)
     if (!is.null(strat.color)) {
+      if (is.formula(strat.color)) {
+        strat.color <- setdiff(as.character(strat.color), "~")
+      }
       x$reference_line$colour <- NULL
-      x$reference_line$mapping <- aes_string(
-        slope = "slope", intercept = "intercept",
-        colour = strat.color
+      x$reference_line$mapping <- aes(
+        slope = .data$slope, intercept = .data$intercept,
+        colour = .data[[strat.color]]
       )
     }
     x$reference_line$data <- dx.ref
@@ -243,7 +246,10 @@ plot_pmx.pmx_qq <- function(x, dx, ...) {
   }
 
   layer_color <- if (!is.null(strat.color)) {
-    geom_point(stat = "qq", aes_string(colour = strat.color))
+    if (is.formula(strat.color)) {
+      strat.color <- setdiff(as.character(strat.color), "~")
+    }
+    geom_point(stat = "qq", aes(colour = .data[[strat.color]]))
   }
   p <- p + layer_facet + layer_shrink +
     layer_color + reference_layer + hline_layer + vline_layer

R/plot-residual.R

@@ -105,13 +105,17 @@ plot_pmx.residual <- function(x, dx, ...) {
     }
     dx <- dx[!is.infinite(get(aess$x)) & !is.infinite(get(aess$y))]
 
-    p <- ggplot(dx, with(aess, ggplot2::aes_string(x, y)))
+    p <- ggplot(dx, with(aess, ggplot2::aes(.data[[x]], .data[[y]])))
 
     # applying strat.color as color aesthetic mapping for point
     if (!is.null(x[["strat.color"]])) {
       if(is.null(point[["mapping"]])) point[["mapping"]] <- aes()
       with(point, {
-        mapping <- modifyList(mapping, aes(color=x[["strat.color"]]))
+        strat.color <- x[["strat.color"]]
+        if (is.formula(strat.color)) {
+          strat.color <- setdiff(as.character(strat.color), "~")
+        }
+        mapping <- modifyList(mapping, aes(color=strat.color))
         mapping[["colour"]] <- NULL
       })
     }
@@ -121,7 +125,7 @@ plot_pmx.residual <- function(x, dx, ...) {
     bloq_cens <- bloq[["cens"]]
     if (!is.null(bloq)) {
       bloq$data <- dx[get(bloq_cens) != 0]
-      bloq$cens <- bloq$limit <- NULL
+      bloq$cens <- bloq$limit <- bloq$linewidth <- NULL
       p <- p + do.call(geom_point, bloq)
     }