Skip to content
Snippets Groups Projects
Commit bc73745f authored by dj44vuri's avatar dj44vuri
Browse files

aggregateResults works but arguments need improvement

parent a1261f4a
Branches
No related tags found
No related merge requests found
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export("%>%") export("%>%")
export(aggregateResults)
export(download_and_extract_zip) export(download_and_extract_zip)
export(extract_b_values) export(extract_b_values)
export(readdesign) export(readdesign)
......
...@@ -2,13 +2,14 @@ ...@@ -2,13 +2,14 @@
#' #'
#' Processes the simulation results to extract summaries, coefficients, and graphs. #' Processes the simulation results to extract summaries, coefficients, and graphs.
#' #'
#' @param all_designs A list of simulation results from sim_choice. #' @param all_designs A list of simulation results from sim_choice. Can contain different designs but need to have the common structure returned by simchoice
#' @param bcoeff A named list of true parameter values used in the simulation. #' @param bcoeff A named list of true parameter values used in the simulation.
#' @param designname A character vector of design names used in the simulation. #' @param designname A character vector of design names used in the simulation.
#' @param reshape_type Method for reshaping data: "auto", "stats", or "tidyr". #' @param reshape_type Method for reshaping data: "auto", "stats", or "tidyr".
#' #'
#' @return A list with aggregated results including summary, coefficients, graphs, and power. #' @return A list with aggregated results including summary, coefficients, graphs, and power.
aggregateResults <- function(){ #' @export
aggregateResults <- function(all_designs, designname, bcoeff, reshape_type){
...@@ -106,18 +107,5 @@ all_designs[["graphs"]] = p ...@@ -106,18 +107,5 @@ all_designs[["graphs"]] = p
all_designs[["powa"]] = powa all_designs[["powa"]] = powa
all_designs[["time"]] = time
all_designs[["arguements"]] = list(
"Beta values" = bcoeff,
"Utility functions" = u ,
"Decision groups" = decisiongroups ,
"Manipulation of vars" = manipulations,
"Number Simulations" = nosim,
"Respondents" = resps,
"Designpath" = designpath
)
return(all_designs) return(all_designs)
} }
...@@ -171,102 +171,10 @@ sim_all <- function(nosim = 2, ...@@ -171,102 +171,10 @@ sim_all <- function(nosim = 2,
print(time) print(time)
if (estimate == TRUE) { if (estimate == TRUE) {
powa <- purrr::map(all_designs, ~ .x$power) all_designs<- simulateDCE::aggregateResults(all_designs=all_designs, designname=designname, bcoeff=bcoeff, reshape_type=reshape_type)
summaryall <- as.data.frame(purrr::map(all_designs, ~ .x$summary)) %>%
dplyr::select(!dplyr::ends_with("vars")) %>%
tibble::rownames_to_column("parname") %>%
dplyr::mutate(parname = stringr::str_remove(parname, "^est_")) %>%
dplyr::left_join(data.frame(truepar = unlist(bcoeff)) %>% tibble::rownames_to_column("parname") %>%
dplyr::mutate(parname=stringr::str_replace_all(parname,"\\.","_")), ##because parameters have been renamed for mixl, we have to make sure we substitute all . with _
by="parname") %>%
dplyr::relocate(parname, dplyr::ends_with(c(
".n", "truepar", "mean", "sd", "min" , "max", "range" , "se"
)))
coefall <- purrr::map(all_designs, ~ .x$coefs)
pat <- paste0("(", paste(designname, collapse = "|"), ").") # needed to identify pattern to be replaced
preprocessed <- as.data.frame(coefall) %>%
dplyr::select(!dplyr::matches("pval|run")) %>%
dplyr::rename_with(~ sub("est_", "", .x), dplyr::everything()) %>%
dplyr::rename_with( ~ paste0(., "_", stringr::str_extract(., pat)),
dplyr::everything()) %>% # rename attributes for reshape part 1
dplyr::rename_with( ~ stringr::str_replace(., pattern = pat, replacement =
""),
dplyr::everything())
s <- switch(
reshape_type,
"stats" = {
message("Using stats::reshape for reshaping...")
stats::reshape(
preprocessed,
varying = 1:ncol(preprocessed),
sep = "_",
direction = "long",
timevar = "design"
) %>%
dplyr::select(-id)
},
"tidyr" = {
message("Using tidyr::pivot_longer for reshaping...")
tidyr::pivot_longer(
preprocessed,
cols = dplyr::everything(),
names_to = c(".value", "design"),
names_sep = "_",
values_drop_na = TRUE
)
},
"auto" = {
tryCatch(
{
message("Trying tidyr::pivot_longer for reshaping...")
tidyr::pivot_longer(
preprocessed,
cols = dplyr::everything(),
names_to = c(".value", "design"),
names_sep = "_",
values_drop_na = TRUE
)
},
error = function(e) {
message("tidyr::pivot_longer failed, falling back to stats::reshape...")
stats::reshape(
preprocessed,
varying = 1:ncol(preprocessed),
sep = "_",
direction = "long",
timevar = "design"
) %>%
dplyr::select(-id)
} }
)
},
stop("You need to specify either 'tidyr', 'stats', or 'auto' as the reshape_type")
)
p = list()
for (att in names(dplyr::select(s, -c("design")))) {
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 all_designs[["time"]] = time
all_designs[["arguements"]] = list( all_designs[["arguements"]] = list(
"Beta values" = bcoeff, "Beta values" = bcoeff,
......
...@@ -4,15 +4,15 @@ ...@@ -4,15 +4,15 @@
\alias{aggregateResults} \alias{aggregateResults}
\title{Aggregate Simulation Results} \title{Aggregate Simulation Results}
\usage{ \usage{
aggregateResults() aggregateResults(all_designs, designname, bcoeff, reshape_type)
} }
\arguments{ \arguments{
\item{all_designs}{A list of simulation results from sim_choice.} \item{all_designs}{A list of simulation results from sim_choice. Can contain different designs but need to have the common structure returned by simchoice}
\item{bcoeff}{A named list of true parameter values used in the simulation.}
\item{designname}{A character vector of design names used in the simulation.} \item{designname}{A character vector of design names used in the simulation.}
\item{bcoeff}{A named list of true parameter values used in the simulation.}
\item{reshape_type}{Method for reshaping data: "auto", "stats", or "tidyr".} \item{reshape_type}{Method for reshaping data: "auto", "stats", or "tidyr".}
} }
\value{ \value{
......
...@@ -21,14 +21,14 @@ bcoeff <- list( ...@@ -21,14 +21,14 @@ bcoeff <- list(
manipulations = list(alt1.professional= expr(alt1.initiator==1), manipulations = list(alt1.professional= rlang::expr(alt1.initiator==1),
alt2.professional= expr(alt2.initiator==1), alt2.professional= rlang::expr(alt2.initiator==1),
alt1.expert = expr(alt1.initiator==2), alt1.expert = rlang::expr(alt1.initiator==2),
alt2.expert = expr(alt2.initiator==2), alt2.expert = rlang::expr(alt2.initiator==2),
alt1.domestic = expr(alt1.funding==1), alt1.domestic = rlang::expr(alt1.funding==1),
alt2.domestic = expr(alt2.funding==1), alt2.domestic = rlang::expr(alt2.funding==1),
alt1.foreign = expr(alt1.funding==2), alt1.foreign = rlang::expr(alt1.funding==2),
alt2.foreign = expr(alt2.funding==2)) alt2.foreign = rlang::expr(alt2.funding==2))
#place your utility functions here #place your utility functions here
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment