Merge pull request #178 from ronkeizer/fixes-vpc

fixes to account for new versions vpc-1.2.0 and tibble-3.0.0
UUPharmacometrics · May 10, 2020 · ef623ac · ef623ac
2 parents ee1c060 + 35f0e8f
commit ef623ac
Show file tree

Hide file tree

Showing 3 changed files with 7 additions and 3 deletions.
diff --git a/R/vpc_data.R b/R/vpc_data.R
@@ -153,15 +153,17 @@ vpc_data <- function(xpdb,
         tidyr::gather(key = 'tmp', value = 'value', dplyr::matches('\\.(low|med|up)')) %>% 
         tidyr::separate(col = !!rlang::sym('tmp'), 
                         into = c('Simulations', 'ci'), sep = '\\.') %>% 
-        tidyr::spread(key = 'ci', value = 'value')
+        tidyr::spread(key = 'ci', value = 'value') %>%
+        dplyr::ungroup()
 
       if (vpc_type == 'continuous') {
         x <- dplyr::mutate(.data = x, 
                            Simulations = factor(x$Simulations, levels = c('q5', 'q50', 'q95'),
                                                 labels = c(stringr::str_c(min(opt$pi)*100, 'th percentile'), 
                                                            'Median', stringr::str_c(max(opt$pi)*100, 'th percentile'))))
       } else {
-        x <- dplyr::mutate(.data = x, Simulations = factor(x$Simulations, levels = 'q50', labels = 'Median'))
+        x <- dplyr::mutate(.data = x, 
+                           Simulations = factor(x$Simulations, levels = 'q50', labels = 'Median'))
       }
       if ('strat2' %in% colnames(x)) {
         x$strat1 <- stringr::str_replace(x$strat1, stringr::str_c(vpc_dat$stratify[1], '='), '')
@@ -176,12 +178,14 @@ vpc_data <- function(xpdb,
     purrr::map_at('aggr_obs', function(x) {
       if (vpc_type == 'continuous') {
         x <- x %>% 
+          dplyr::ungroup() %>%
           tidyr::gather(key = 'Observations', value = 'value', dplyr::one_of('obs5', 'obs50', 'obs95')) %>% 
           dplyr::mutate(Observations = factor(.$Observations, levels = c('obs5', 'obs50', 'obs95'),
                                               labels = c(stringr::str_c(min(opt$pi)*100, 'th percentile'), 
                                                          'Median', stringr::str_c(max(opt$pi)*100, 'th percentile'))))
       } else {
         x <- x %>% 
+          dplyr::ungroup() %>%
           tidyr::gather(key = 'Observations', value = 'value', dplyr::one_of('obs50')) %>% 
           dplyr::mutate(Observations = factor(.$Observations, levels = 'obs50', labels = 'Median'))
       }

diff --git a/tests/testthat/data/ctrl_special.RData b/tests/testthat/data/ctrl_special.RData
diff --git a/tests/testthat/test-vpc.R b/tests/testthat/test-vpc.R
@@ -4,7 +4,7 @@ context('Check VPCs')
 # ctrl_special <- xpdb_ex_pk %>%
 #   vpc_data(opt = vpc_opt(n_bins = 3, lloq = 0.1)) %>%
 #   vpc_data(vpc_type = 'cens', opt = vpc_opt(n_bins = 3, lloq = 0.4))
-#  save(ctrl_special, file = 'data/ctrl_special.RData', 
+#  save(ctrl_special, file = 'data/ctrl_special.RData',
 #       compress = 'xz', version = 2)
 load(file = 'data/ctrl_special.RData')