From c6e2935d748401d468a8b35c975a4dedee6ef5b9 Mon Sep 17 00:00:00 2001
From: dj44vuri <julian.sagebiel@idiv.de>
Date: Thu, 14 Dec 2023 19:20:30 +0100
Subject: [PATCH] more code in functions
---
functions.R | 59 ++++++++++++++++++++++++++++++++++++++++++
generatemd.R | 2 +-
simulation_output.rmd | 10 +++----
simulationcore_purrr.R | 52 +------------------------------------
4 files changed, 66 insertions(+), 57 deletions(-)
diff --git a/functions.R b/functions.R
index b5a7abf..acc9341 100644
--- a/functions.R
+++ b/functions.R
@@ -1,5 +1,64 @@
+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
diff --git a/generatemd.R b/generatemd.R
index 6de0494..36f349f 100644
--- a/generatemd.R
+++ b/generatemd.R
@@ -1,7 +1,7 @@
rm(list=ls())
-file <- "Projects/Rbook/parameters_Rbook.R"
+file <- "Projects/feedadditives/parameters_feedadd.R"
# file <- "Projects/CSA/parameters_csa.R"
diff --git a/simulation_output.rmd b/simulation_output.rmd
index fa59672..d3855a6 100644
--- a/simulation_output.rmd
+++ b/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"]])
```
diff --git a/simulationcore_purrr.R b/simulationcore_purrr.R
index 9c7c8f0..0a79543 100644
--- a/simulationcore_purrr.R
+++ b/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
--
GitLab