more code in functions

functions.R

 
+sim_all <- function(){
 
+ 
+  
+if (!exists("destype")) destype="ngene"
+
+tictoc::tic()
+
+all_designs<- purrr::map(designfile, sim_choice,
+                         no_sim= nosim,respondents = resps, mnl_U = mnl_U, destype=destype) %>%  ## iterate simulation over all designs
+  setNames(designname)
+
+
+time <- tictoc::toc()
+
+print(time)
+
+
+
+powa <- map(all_designs, ~ .x$power)
+
+
+
+
+summaryall <- as.data.frame(purrr::map(all_designs, ~.x$summary)) %>% 
+  dplyr::select(!ends_with("vars")) %>% 
+  relocate(ends_with(c(".n", "mean","sd", "min" ,"max", "range" , "se" )))
+
+coefall <- map(all_designs, ~ .x$coefs)
+
+pat<-paste0("(",paste(designname,collapse = "|"),").") # needed to identify pattern to be replaced
+
+s<-as.data.frame(coefall) %>% 
+  dplyr::select(!matches("pval|run")) %>%
+  rename_with(~ sub("est_b", "", .x), everything()) %>%
+  #  rename_with(~ sub("est_asc_", "asc", .x), everything()) %>%
+  rename_with( ~ paste0(.,"_",stringr::str_extract(.,pat )), everything() ) %>%   # rename attributes for reshape part 1
+  rename_with( ~ stringr::str_replace(.,pattern = pat,replacement=""), everything() )  %>% 
+  reshape(varying =1:ncol(.), sep = "_"  , direction = "long" ,timevar = "design", idvar = "run" )
+
+
+p=list()
+
+for (att in names(dplyr::select(s,-c("design","run")))) {
+  
+  p[[att]] <- plot_multi_histogram(s,att,"design")
+  
+  print(p[[att]])
+  
+}
+
+all_designs[["summaryall"]] = summaryall
+all_designs[["graphs"]]=p
+all_designs[["powa"]]=powa
+all_designs[["time"]]=time
+
+
+
+return(all_designs)
+}
 
 ##test 
 

generatemd.R

 
 rm(list=ls())
 
-file <- "Projects/Rbook/parameters_Rbook.R"
+file <- "Projects/feedadditives/parameters_feedadd.R"
 #  file <- "Projects/CSA/parameters_csa.R"
 
 

simulation_output.rmd

@@ -34,7 +34,7 @@ source("simulationcore_purrr.R" ,echo = TRUE, local = knitr::knit_global() )
 ```
 
 
-The simulation has `r resps` respondents and `r nosim` runs.
+The simulation has `r resps` respondents and `r nosim` runs. The simulation itself took `r all_designs[["time"]]$toc - all_designs[["time"]]$tic` seconds.
 
 
 
@@ -74,13 +74,13 @@ if (exists("notes")) cat(notes)
 Here you see the statistics of your parameters for the `r nosim` runs.
 
 ```{r}
-kable(summaryall ,digits = 3) %>% kable_styling()
+kable(all_designs[["summaryall"]] ,digits = 3) %>% kable_styling()
 ```
 
 
 
 ```{r}
-powa
+all_designs[["powa"]]
 
 ```
 
@@ -93,10 +93,10 @@ To facilitate interpretation and judgement of the different designs, you can plo
 
 ```{r echo=FALSE, message=FALSE, warning=FALSE}
 
-map(p,print)
+map(all_designs[["graphs"]],print)
 
 
-do.call(grid.arrange,p)
+do.call(grid.arrange,all_designs[["graphs"]])
 ```
 
 

simulationcore_purrr.R

@@ -22,59 +22,9 @@ designname <- str_remove_all(list.files(designpath,full.names = F),
 
 #plan(multisession, workers = 8)
 #plan(sequential)
-tictoc::tic()
 
 
 
-if (!exists("destype")) destype="ngene"
 
-all_designs<- purrr::map(designfile, sim_choice,
-                         no_sim= nosim,respondents = resps, mnl_U = mnl_U, destype=destype) %>% 
-  setNames(designname)
+all_designs <- sim_all()
 
-
-#all_designs<- furrr::future_map(list.files("designs/",full.names = T), sim_choice,no_sim= nosim,respondents = resps, mnl_U = mnl_U, .options = furrr_options(seed = T)) %>% 
-#setNames(designname) ### Issue is somewhere here
-
-time <- tictoc::toc()
-
-print(time)
-
-
-
-powa <- map(all_designs, ~ .x$power)
-
-
-
-
-summaryall <- as.data.frame(purrr::map(all_designs, ~.x$summary)) %>% 
-  dplyr::select(!ends_with("vars")) %>% 
-  relocate(ends_with(c(".n", "mean","sd", "min" ,"max", "range" , "se" )))
-
-coefall <- map(all_designs, ~ .x$coefs)
-
-pat<-paste0("(",paste(designname,collapse = "|"),").") # needed to identify pattern to be replaced
-
-s<-as.data.frame(coefall) %>% 
-  dplyr::select(!matches("pval|run")) %>%
-  rename_with(~ sub("est_b", "", .x), everything()) %>%
-#  rename_with(~ sub("est_asc_", "asc", .x), everything()) %>%
-  rename_with( ~ paste0(.,"_",stringr::str_extract(.,pat )), everything() ) %>%   # rename attributes for reshape part 1
-  rename_with( ~ stringr::str_replace(.,pattern = pat,replacement=""), everything() )  %>% 
-  reshape(varying =1:ncol(.), sep = "_"  , direction = "long" ,timevar = "design", idvar = "run" )
-
-
-p=list()
-
-for (att in names(dplyr::select(s,-c("design","run")))) {
-  
-  p[[att]] <- plot_multi_histogram(s,att,"design")
-  
-  print(p[[att]])
-  
-}
-
-do.call(grid.arrange,p)
-
-all_designs[["time"]]=time
-#saveRDS(all_designs, file = paste0("output/",respondents,"_",no_sim,"runs_4designs_mixl.RDS"))
\ No newline at end of file