diff --git a/NAMESPACE b/NAMESPACE index d9dc970c..b5a5f7d5 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -254,13 +254,16 @@ importFrom(plotly,plot_ly) importFrom(plotly,plotly_build) importFrom(plotly,renderPlotly) importFrom(plotly,subplot) +importFrom(purrr,imap) importFrom(purrr,keep) +importFrom(purrr,list_flatten) importFrom(purrr,list_rbind) importFrom(purrr,map) importFrom(purrr,map2) importFrom(purrr,map_chr) importFrom(purrr,map_df) importFrom(purrr,map_lgl) +importFrom(purrr,map_vec) importFrom(purrr,pluck) importFrom(purrr,reduce) importFrom(readr,read_file) @@ -358,6 +361,7 @@ importFrom(stats,wilcox.test) importFrom(stringr,regex) importFrom(stringr,str_glue) importFrom(stringr,str_replace) +importFrom(stringr,str_split) importFrom(tidyr,crossing) importFrom(tidyr,extract) importFrom(tidyr,fill) diff --git a/R/PM_compare.R b/R/PM_compare.R index 7d5ba742..fb52fa62 100755 --- a/R/PM_compare.R +++ b/R/PM_compare.R @@ -118,8 +118,8 @@ PM_compare <- function(..., icen = "median", outeq = 1, plot = FALSE) { } }) tibble( - bias = map_chr(res, 1), - imp = map_chr(res, 2) + bias = purrr::map_chr(res, 1), + imp = purrr::map_chr(res, 2) ) @@ -316,7 +316,7 @@ PM_compare <- function(..., icen = "median", outeq = 1, plot = FALSE) { if(length(not_same$outeq)>0){ ft1 <- gamlam %>% select(Run, dplyr::everything()) %>% - purrr::set_names(c("Run", "Cycle", "Value", "Outeq", "Type")) %>% + rlang::set_names(c("Run", "Cycle", "Value", "Outeq", "Type")) %>% mutate(Value = round2(Value)) %>% flextable::flextable() %>% flextable::theme_zebra() %>% @@ -397,10 +397,10 @@ PM_compare <- function(..., icen = "median", outeq = 1, plot = FALSE) { sort() - tbl_par <- map(par, \(x){ + tbl_par <- purrr::map(par, \(x){ all_par %in% x - })%>% map(~ set_names(., all_par)) %>% + })%>% purrr::map(~ rlang::set_names(., all_par)) %>% bind_rows() %>% mutate(Run = objNames[1:n()]) %>% select(Run, dplyr::everything()) @@ -461,7 +461,7 @@ if (getPMoptions("ic_method") == "aic"){ results$aic <- NULL } -op_tbl <- op %>% map(\(i) { +op_tbl <- op %>% purrr::map(\(i) { i %>% filter(icen == "median") %>% group_by(pred.type) %>% group_map(~ { fit <- lm(obs ~ pred, data = .x) @@ -470,16 +470,16 @@ op_tbl <- op %>% map(\(i) { sl = coef(fit)[2], r2 = summary(fit)$r.squared ) - }) %>% list_rbind() -}) %>% set_names(objNames[1:nobj]) %>% -map(~ .x %>% mutate(pred.type = c("pop", "post"))) %>% -list_rbind(names_to = "run") %>% + }) %>% purrr::list_rbind() +}) %>% rlang::set_names(objNames[1:nobj]) %>% +purrr::map(~ .x %>% mutate(pred.type = c("pop", "post"))) %>% +purrr::list_rbind(names_to = "run") %>% pivot_wider(id_cols = c(run), names_from = c(pred.type), names_glue = "{pred.type}{stringr::str_to_title({.value})}", values_from = c(int, sl, r2)) results <- bind_cols(results, op_tbl %>% select(-run)) results$pval <- t -results$best <- results %>% select(c(-run, -nvar, -converged, -pval)) %>% map(~ which(.x == min(.x))) %>% unlist() %>% table() +results$best <- results %>% select(c(-run, -nvar, -converged, -pval)) %>% purrr::map(~ which(.x == min(.x))) %>% unlist() %>% table() attr(results, "highlight") <- TRUE class(results) <- c("PM_compare", "data.frame") @@ -492,7 +492,7 @@ if(plot){ p3 = p3, # likelihood comparison ft1 = ft1, # gamlam comparison: NULL if equal within PMoptions digits ft2 = ft2, # model parameter comparison - metric_types = sumobjPop[[1]]$pe %>% get_metric_info() %>% pluck("metric_types") + metric_types = sumobjPop[[1]]$pe %>% get_metric_info() %>% purrr::pluck("metric_types") ) diff --git a/R/PMutilities.R b/R/PMutilities.R index 9fbf7c7f..37e54c09 100755 --- a/R/PMutilities.R +++ b/R/PMutilities.R @@ -1463,7 +1463,7 @@ wtd.var <- function(x, weights = NULL, df_tab <- knitr::kable(df_chr, format = "simple") # rebuild the data frame - df2 <- map_vec(df_tab, \(x) str_split(x, "(?<=\\s)(?=\\S)")) + df2 <- purrr::map_vec(df_tab, \(x) stringr::str_split(x, "(?<=\\s)(?=\\S)")) df2 <- as.data.frame(do.call(rbind, df2)) # replace minima with highlighted versions diff --git a/R/Pmetrics-package.R b/R/Pmetrics-package.R index ad023234..dee7a954 100755 --- a/R/Pmetrics-package.R +++ b/R/Pmetrics-package.R @@ -23,12 +23,12 @@ #' theme ggtitle element_blank element_text geom_segment aes_string aes_string theme_bw theme_grey #' coord_fixed facet_wrap labs geom_smooth xlim ylim theme_void #' scale_color_identity scale_fill_identity -#' @importFrom purrr map map2 reduce map_chr keep pluck map_lgl map_df list_rbind +#' @importFrom purrr map map2 reduce map_chr keep pluck map_lgl map_df list_rbind map_vec imap list_flatten #' @importFrom magrittr %>% # #' @importFrom tibble as_tibble tibble #' @importFrom tidyr pivot_longer pivot_wider nest unnest extract separate fill #' crossing separate_wider_delim -#' @importFrom stringr str_replace regex +#' @importFrom stringr str_replace regex str_glue str_split # #' @importFrom mclust Mclust #' @importFrom grDevices col2rgb dev.off devAskNewPage gray.colors jpeg #' pdf png postscript rgb setEPS