Merge pull request #107 from guiastrennec/master

Update master to 0.4.3

DESCRIPTION

@@ -1,43 +1,23 @@
 Package: xpose
 Type: Package
 Title: Diagnostics for Pharmacometric Models
-Version: 0.4.2
+Version: 0.4.3
 Authors@R: c(
       person('Benjamin', 'Guiastrennec',
              role  = c('aut', 'cre', 'cph'),
              email = 'guiastrennec@gmail.com'),
       person('Andrew C.', 'Hooker', 
              role  = c('aut', 'cph'),
              email = 'andrew.hooker@farmbio.uu.se'),
-      person('Anna', 'Olofsson', 
-             role  = c('aut', 'cph'),
-             email = 'anna.olofsson@pharmetheus.com'),
       person('Sebastian', 'Ueckert',
              role  = c('aut', 'cph'),
              email = 'sebastian.ueckert@farmbio.uu.se'),
-      person('Ron', 'Keizer', 
-             role  = 'aut',
-             email = 'ronkeizer@gmail.com'),
-      person('Nick', 'Solomon', 
-             role    = 'ctb',
-             comment = 'Wrote the geom_qq_line function',
-             email   = 'nick@nicksolomon.me'),
-      person('Kajsa', 'Harling', 
-             role  = 'ctb',
-             email = 'kajsa.harling@pharmetheus.com'),
       person('Mike K.', 'Smith', 
              role  = 'ctb',
              email = 'mike.k.smith@pfizer.com'),
-      person('Elodie', 'Plan', 
-             role  = 'ctb',
-             email = 'elodie.plan@pharmetheus.com'),
       person('Mats O.', 'Karlsson',
              role  = c('aut', 'cph'),
-             email = 'mats.karlsson@farmbio.uu.se'),
-      person('Pharmetheus', 
-             role  = 'ctb',
-             email = 'info@pharmetheus.com'),
-      person('Pfizer', role = 'ctb'))
+             email = 'mats.karlsson@farmbio.uu.se'))
 Description: Diagnostics for non-linear mixed-effects (population) 
     models from 'NONMEM' <http://www.iconplc.com/innovation/nonmem/>. 
     'xpose' facilitates data import, creation of numerical run summary 
@@ -73,4 +53,4 @@ BugReports: https://github.com/UUPharmacometrics/xpose/issues
 Encoding: UTF-8
 LazyData: true
 VignetteBuilder: knitr
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.0

NAMESPACE

@@ -26,6 +26,9 @@ export(amt_vs_idv)
 export(append_suffix)
 export(as.ctime)
 export(as.nm.table.list)
+export(as.xpdb)
+export(as.xpose.plot)
+export(as.xpose.theme)
 export(check_plot_type)
 export(check_problem)
 export(check_quo_vars)
@@ -69,9 +72,9 @@ export(irep)
 export(is.formula)
 export(is.nm.model)
 export(is.nm.table.list)
-export(is.xp.theme)
 export(is.xpdb)
 export(is.xpose.plot)
+export(is.xpose.theme)
 export(last_data_problem)
 export(last_file_method)
 export(last_file_problem)

NEWS.md

@@ -1,3 +1,10 @@
+# xpose 0.4.3
+### General
+* Fixed bug in `get_prm()`/`prm_table()` where off diagonal correlations were improperly computed.
+* Fixed bug in `print.xpose_data()`where a warning from stringi was returned.
+* Fixed multiple bugs introduced by the new versions of tidyverse packages
+* Added compatibility to ggplot2 v3.0.0
+
 # xpose 0.4.2
 ### General
 * Address CRAN requests

R/fetch_data.R

@@ -92,13 +92,27 @@ only_obs <- function(xpdb, .problem, quiet) {
 only_distinct <- function(xpdb, .problem, facets, quiet) {
   if (is.formula(facets)) facets <- all.vars(facets)
   vars <- c(xp_var(xpdb, .problem, type = c('id'))$col[1], facets)
-  string <- c('Removing duplicated rows based on: ', stringr::str_c(vars, collapse = ', '))
+
+
   fun <- function(x) {}
   body(fun) <- bquote({
-    msg(.(string), .(quiet))
-    dplyr::distinct_(.data = x, .dots = .(vars), .keep_all = TRUE)
+
+    var_stg <- .(vars)
+
+    # Silently remove "variable" when not in the data
+    if ('variable' %in% var_stg && !'variable' %in% colnames(x)) {
+      var_stg <- var_stg[-which(var_stg == 'variable')]
+    }
+
+    msg_stg <- c('Removing duplicated rows based on: ', 
+                 stringr::str_c(var_stg, collapse = ', '))
+    msg(msg_stg, .(quiet))
+
+    dplyr::distinct_(.data = x, .dots = var_stg, .keep_all = TRUE)
   })
+
   fun
+
 }
 
 

R/plot_amt.R

@@ -22,6 +22,7 @@ amt_vs_idv <- function(xpdb,
                        title      = 'Compartments amount vs. @x | @run',
                        subtitle   = 'Ofv: @ofv',
                        caption    = '@dir',
+                       tag        = NULL,
                        log        = NULL,
                        facets,
                        .problem,
@@ -61,5 +62,5 @@ amt_vs_idv <- function(xpdb,
                  xscale = check_scales('x', log), 
                  yscale = check_scales('y', log), 
                  title = title, subtitle = subtitle, caption = caption,
-                 plot_name = as.character(match.call()[[1]]))))
+                 tag = tag, plot_name = as.character(match.call()[[1]]))))
 }

R/plot_distibution.R

@@ -34,6 +34,7 @@ prm_distrib <- function(xpdb,
                         title    = 'Parameter distribution | @run',
                         subtitle = 'Based on @nind individuals',
                         caption  = '@dir',
+                        tag      = NULL,
                         log      = NULL,
                         guide    = FALSE,
                         facets,
@@ -65,7 +66,7 @@ prm_distrib <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]), ...)
+                tag = tag, plot_name = as.character(match.call()[[1]]), ...)
 }
 
 #' @rdname distrib_plot
@@ -77,6 +78,7 @@ eta_distrib <- function(xpdb,
                         title    = 'Eta distribution | @run',
                         subtitle = 'Based on @nind individuals, Eta shrink: @etashk',
                         caption  = '@dir',
+                        tag      = NULL,
                         log      = NULL,
                         guide    = FALSE,
                         facets,
@@ -115,7 +117,7 @@ eta_distrib <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]), ...)
+                tag = tag, plot_name = as.character(match.call()[[1]]), ...)
 }
 
 #' @param res Only used for \code{res_distrib}. Defines the type of residual to be used. Default is "CWRES".
@@ -128,6 +130,7 @@ res_distrib <- function(xpdb,
                         title    = '@x distribution | @run',
                         subtitle = 'Based on @nobs observations',
                         caption  = '@dir',
+                        tag      = NULL,
                         log      = NULL,
                         guide    = FALSE,
                         facets,
@@ -165,7 +168,7 @@ res_distrib <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]), ...)
+                tag = tag, plot_name = as.character(match.call()[[1]]), ...)
 }
 
 #' @rdname distrib_plot
@@ -177,6 +180,7 @@ cov_distrib <- function(xpdb,
                         title    = 'Continuous covariates distribution | @run',
                         subtitle = 'Based on @nind individuals',
                         caption  = '@dir',
+                        tag      = NULL,
                         log      = NULL,
                         guide    = FALSE,
                         facets,
@@ -208,5 +212,5 @@ cov_distrib <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]), ...)
+                tag = tag, plot_name = as.character(match.call()[[1]]), ...)
 }

R/plot_gof.R

@@ -12,6 +12,7 @@
 #' @param title Plot title. Use \code{NULL} to remove.
 #' @param subtitle Plot subtitle. Use \code{NULL} to remove.
 #' @param caption Page caption. Use \code{NULL} to remove.
+#' @param tag Plot identification tag. Use \code{NULL} to remove.
 #' @param log String assigning logarithmic scale to axes, can be either '', 
 #' 'x', y' or 'xy'.
 #' @param guide Enable guide display (e.g. unity line).
@@ -40,6 +41,7 @@ dv_vs_ipred <- function(xpdb,
                         title    = '@y vs. @x | @run',
                         subtitle = 'Ofv: @ofv, Eps shrink: @epsshk',
                         caption  = '@dir',
+                        tag      = NULL,
                         log      = NULL,
                         guide    = TRUE,
                         facets,
@@ -60,8 +62,8 @@ dv_vs_ipred <- function(xpdb,
                 type = type, guide = guide, facets = facets, 
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
-                title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]),
+                title = title, subtitle = subtitle, caption = caption, 
+                tag = tag, plot_name = as.character(match.call()[[1]]),
                 guide_slope = 1, ...)
 }
 
@@ -74,6 +76,7 @@ dv_vs_pred <- function(xpdb,
                        title    = '@y vs. @x | @run',
                        subtitle = 'Ofv: @ofv',
                        caption  = '@dir',
+                       tag      = NULL,
                        log      = NULL,
                        guide    = TRUE,
                        facets,
@@ -95,6 +98,6 @@ dv_vs_pred <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]),
+                tag = tag, plot_name = as.character(match.call()[[1]]),
                 guide_slope = 1, ...)
 }

R/plot_individuals.R

@@ -29,6 +29,7 @@ ind_plots <- function(xpdb,
                       title         = 'Individual plots | @run',
                       subtitle      = 'Ofv: @ofv, Eps shrink: @epsshk',
                       caption       = '@dir | Page @page of @lastpage',
+                      tag           = NULL,
                       log           = NULL,
                       facets,
                       .problem,
@@ -70,8 +71,8 @@ ind_plots <- function(xpdb,
                  type = type, facets = facets,
                  xscale = check_scales('x', log),
                  yscale = check_scales('y', log), 
-                 title = title, subtitle = subtitle, caption = caption,
-                 plot_name = as.character(match.call()[[1]])))) +
+                 title = title, subtitle = subtitle, caption = caption, 
+                 tag = tag, plot_name = as.character(match.call()[[1]])))) +
     scale_alpha_manual(values = point_alpha) +
     scale_color_manual(values = color) +
     scale_linetype_manual(values = line_linetype)

R/plot_minimization.R

@@ -25,6 +25,7 @@ prm_vs_iteration <- function(xpdb,
                              title    = 'Parameter @y vs. @x | @run',
                              subtitle = 'Method: @method, minimization time: @runtime\nTermination message: @term',
                              caption  = '@dir',
+                             tag      = NULL,
                              log      = NULL,
                              guide    = FALSE,
                              facets,
@@ -37,8 +38,8 @@ prm_vs_iteration <- function(xpdb,
   check_xpdb(xpdb, check = 'files')
   if (missing(.problem)) .problem <- last_file_problem(xpdb, 'ext')
   if (missing(.subprob)) .subprob <- last_file_subprob(xpdb, 'ext', .problem)
-  if (missing(.method)) .method  <- last_file_method(xpdb, ext = 'ext', 
-                                                     .problem = .problem, .subprob = .subprob)
+  if (missing(.method)) .method   <- last_file_method(xpdb, ext = 'ext', 
+                                                      .problem = .problem, .subprob = .subprob)
   check_problem(.problem, .subprob, .method)
   if (missing(quiet)) quiet <- xpdb$options$quiet
   if (missing(facets)) facets <- 'variable'
@@ -63,7 +64,7 @@ prm_vs_iteration <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]),
+                tag = tag, plot_name = as.character(match.call()[[1]]),
                 scales = 'free_y', ...)
 }
 
@@ -76,6 +77,7 @@ grd_vs_iteration <- function(xpdb,
                              title    = 'Gradient @y vs. @x | @run',
                              subtitle = 'Method: @method, minimization time: @runtime\nTermination message: @term',
                              caption  = '@dir',
+                             tag      = NULL,
                              log      = NULL,
                              guide    = FALSE,
                              facets,
@@ -88,8 +90,8 @@ grd_vs_iteration <- function(xpdb,
   check_xpdb(xpdb, check = 'files')
   if (missing(.problem)) .problem <- last_file_problem(xpdb, 'grd')
   if (missing(.subprob)) .subprob <- last_file_subprob(xpdb, 'grd', .problem)
-  if (missing(.method)) .method  <- last_file_method(xpdb, ext = 'grd', 
-                                                     .problem = .problem, .subprob = .subprob)
+  if (missing(.method)) .method   <- last_file_method(xpdb, ext = 'grd', 
+                                                      .problem = .problem, .subprob = .subprob)
   check_problem(.problem, .subprob, .method)
   if (missing(quiet)) quiet <- xpdb$options$quiet
   if (missing(facets)) facets <- 'variable'
@@ -114,6 +116,6 @@ grd_vs_iteration <- function(xpdb,
                 xscale = check_scales('x', log), 
                 yscale = check_scales('y', log), 
                 title = title, subtitle = subtitle, caption = caption,
-                plot_name = as.character(match.call()[[1]]),
+                tag = tag, plot_name = as.character(match.call()[[1]]),
                 scales = 'free_y', ...)
 }

R/plot_qq.R

@@ -34,6 +34,7 @@ prm_qq <- function(xpdb,
                    title    = 'QQ plot of parameters | @run',
                    subtitle = 'Based on @nind individuals',
                    caption  = '@dir',
+                   tag      = NULL,
                    log      = NULL,
                    guide    = TRUE,
                    facets,
@@ -65,7 +66,7 @@ prm_qq <- function(xpdb,
            xscale = check_scales('x', log), 
            yscale = check_scales('y', log), 
            title = title, subtitle = subtitle, caption = caption,
-           plot_name = as.character(match.call()[[1]]), 
+           tag = tag, plot_name = as.character(match.call()[[1]]), 
            xscale_name = 'Quantiles of normal', 
            yscale_name = 'Quantiles of parameter', ...)
 }
@@ -79,6 +80,7 @@ eta_qq <- function(xpdb,
                    title    = 'QQ plot of etas | @run',
                    subtitle = 'Based on @nind individuals, Eta shrink: @etashk',
                    caption  = '@dir',
+                   tag      = NULL,
                    log      = NULL,
                    guide    = TRUE,
                    facets,
@@ -116,7 +118,7 @@ eta_qq <- function(xpdb,
            xscale = check_scales('x', log), 
            yscale = check_scales('y', log), 
            title = title, subtitle = subtitle, caption = caption,
-           plot_name = as.character(match.call()[[1]]), 
+           tag = tag, plot_name = as.character(match.call()[[1]]), 
            xscale_name = 'Quantiles of normal', 
            yscale_name = 'Quantiles of eta', ...)
 }
@@ -131,6 +133,7 @@ res_qq <- function(xpdb,
                    title    = 'QQ plot of @sample | @run',
                    subtitle = 'Based on @nobs observations',
                    caption  = '@dir',
+                   tag      = NULL,
                    log      = NULL,
                    guide    = TRUE,
                    facets,
@@ -168,7 +171,7 @@ res_qq <- function(xpdb,
            xscale = check_scales('x', log), 
            yscale = check_scales('y', log), 
            title = title, subtitle = subtitle, caption = caption,
-           plot_name = as.character(match.call()[[1]]), ...) +
+           tag = tag, plot_name = as.character(match.call()[[1]]), ...) +
     labs(x = 'Quantiles of normal', 
          y = 'Quantiles of @sample')
 }
@@ -182,6 +185,7 @@ cov_qq <- function(xpdb,
                    title    = 'QQ plot of continuous covariates | @run',
                    subtitle = 'Based on @nind individuals',
                    caption  = '@dir',
+                   tag      = NULL,
                    log      = NULL,
                    guide    = TRUE,
                    facets,
@@ -213,7 +217,7 @@ cov_qq <- function(xpdb,
            xscale = check_scales('x', log), 
            yscale = check_scales('y', log), 
            title = title, subtitle = subtitle, caption = caption,
-           plot_name = as.character(match.call()[[1]]), 
+           tag = tag, plot_name = as.character(match.call()[[1]]), 
            xscale_name = 'Quantiles of normal', 
            yscale_name = 'Quantiles of covariate', ...)
 }