diff --git a/DESCRIPTION b/DESCRIPTION index 3b218f31b44f0131c61d99891c5d2ddddfb35ed5..083153476d297efeab577f0c0bc08d54286dfbd1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,6 +13,8 @@ Imports: dplyr (>= 1.1.4), evd, formula.tools, + ggplot2, + magrittr, mixl, psych, purrr, diff --git a/NAMESPACE b/NAMESPACE index e6af3a9d80812d55195938ef44ad432cb1475164..e08595a730259e521012c3c53014724b8dc2ec8e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,9 @@ # Generated by roxygen2: do not edit by hand +export("%>%") export(download_and_extract_zip) export(readdesign) export(sim_all) export(sim_choice) export(simulate_choices) +importFrom(magrittr,"%>%") diff --git a/R/sim_all.R b/R/sim_all.R index 6e30cb708a77726a38f35822ed5c46debc9efa1a..f051369ef853b8706c0217bd2a7ca56e0172dbcc 100644 --- a/R/sim_all.R +++ b/R/sim_all.R @@ -1,15 +1,20 @@ -#' Title +#' Title Is a wrapper for sim_choice executing the simulation over all designs stored in a specific folder #' -#' @return +#' @return a list, with all information on the simulation. This list an be easily processed by the user and in the rmarkdown template. #' @export #' #' @examples +#' +#' designpath<- system.file("extdata","Rbook" ,package = "simulateDCE") +#' resps =240 # number of respondents +#' nosim=2 # number of simulations to run (about 500 is minimum) +#' sim_all <- function(){ - require("stringr") + designfile<-list.files(designpath,full.names = T) - designname <- str_remove_all(list.files(designpath,full.names = F), + designname <- stringr::str_remove_all(list.files(designpath,full.names = F), "(.ngd|_|.RDS)") ## Make sure designnames to not contain file ending and "_", as the may cause issues when replace if (!exists("destype")) destype="ngene" @@ -27,25 +32,24 @@ sim_all <- function(){ - powa <- map(all_designs, ~ .x$power) + powa <- purrr::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" ))) + dplyr::relocate(ends_with(c(".n", "mean","sd", "min" ,"max", "range" , "se" ))) - coefall <- map(all_designs, ~ .x$coefs) + coefall <- purrr::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() ) %>% + dplyr::rename_with(~ sub("est_b", "", .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=""), everything() ) %>% reshape(varying =1:ncol(.), sep = "_" , direction = "long" ,timevar = "design", idvar = "run" ) diff --git a/R/sim_choice.R b/R/sim_choice.R index 74a14a7eee2b377e6a53e7cc2cb7039ad00d97a3..9fdf8b5bbadb205e620c1ed33f2d7b22187c9303 100644 --- a/R/sim_choice.R +++ b/R/sim_choice.R @@ -1,33 +1,23 @@ #' Title #' -#' @param designfile -#' @param no_sim -#' @param respondents -#' @param mnl_U -#' @param utils -#' @param destype +#' @param designfile path to a file containing a design. +#' @param no_sim Number of runs i.e. how often do you want the simulation to be repeated +#' @param respondents Number of respondents. How many respondents do you want to simulate in each run. +#' @param mnl_U a list containing utility functions as formulas +#' @param utils The first element of the utility function list +#' @param destype Specify which type of design you use. Either ngene or spdesign #' -#' @return +#' @return a list with all information on the run #' @export #' #' @examples +#' sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1]] ,destype) { - - require("tictoc") - require("readr") - require("psych") - require("dplyr") - require("evd") - require("tidyr") - require("kableExtra") require("gridExtra") - require("stringr") - require("mixl") - require("furrr") - require("purrr") + require("ggplot2") - require("formula.tools") + require("rlang") @@ -47,7 +37,7 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1] } mnl_U <-paste(map_chr(utils,as.character,keep.source.attr = TRUE),collapse = "",";") %>% - str_replace_all( c( "priors\\[\"" = "" , "\"\\]" = "" , "~" = "=", "\\." = "_" , " b" = " @b" , "V_"="U_", " alt"="$alt")) + stringr::str_replace_all( c( "priors\\[\"" = "" , "\"\\]" = "" , "~" = "=", "\\." = "_" , " b" = " @b" , "V_"="U_", " alt"="$alt")) cat("mixl \n") cat(mnl_U) @@ -71,10 +61,10 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1] replications <- respondents/nblocks datadet<- design %>% - arrange(Block,Choice.situation) %>% - slice(rep(row_number(), replications)) %>% ## replicate design according to number of replications - mutate(ID = rep(1:respondents, each=setpp)) %>% # create Respondent ID. - relocate(ID,`Choice.situation`) %>% + dplyr::arrange(Block,Choice.situation) %>% + dplyr::slice(rep(dplyr::row_number(), replications)) %>% ## replicate design according to number of replications + dplyr::mutate(ID = rep(1:respondents, each=setpp)) %>% # create Respondent ID. + dplyr::relocate(ID,`Choice.situation`) %>% as.data.frame() database <- simulate_choices(data=datadet, utility = utils, setspp = setpp) @@ -93,10 +83,10 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1] - coefs<-map(1:length(output),~summary(output[[.]])[["coefTable"]][c(1,8)] %>% + coefs<-purrr::map(1:length(output),~summary(output[[.]])[["coefTable"]][c(1,8)] %>% tibble::rownames_to_column() %>% - pivot_wider(names_from = rowname, values_from = c(est, rob_pval0)) ) %>% - bind_rows(.id = "run") + tidyr::pivot_wider(names_from = rowname, values_from = c(est, rob_pval0)) ) %>% + dplyr::bind_rows(.id = "run") output[["summary"]] <-psych::describe(coefs[,-1], fast = TRUE) @@ -110,7 +100,7 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1] output[["metainfo"]] <- c(Path = designfile, NoSim = no_sim, NoResp =respondents) - print(kable(output[["summary"]],digits = 2, format = "rst")) + print(kableExtra::kable(output[["summary"]],digits = 2, format = "rst")) print(output[["power"]]) diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 0000000000000000000000000000000000000000..fd0b1d13db4ff91b7f836f72b7d5d88d958f6e1f --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,14 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +#' @param lhs A value or the magrittr placeholder. +#' @param rhs A function call using the magrittr semantics. +#' @return The result of calling `rhs(lhs)`. +NULL diff --git a/R/utils.R b/R/utils.R index 27126824f7aeff84a7c2c2f587d57992ee701634..d2a978472b6ee6ee4682a9b6a0ccf13c7bdccaa2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,10 +1,13 @@ -plot_multi_histogram <- function(df, feature, label_column) { #function to create nice multi histograms, taken somewhere from the web - plt <- ggplot(df, aes(x=eval(parse(text=feature)), fill=eval(parse(text=label_column)))) + - #geom_histogram(alpha=0.7, position="identity", aes(y = ..density..), color="black") + - geom_density(alpha=0.5) + - geom_vline(aes(xintercept=mean(eval(parse(text=feature)))), color="black", linetype="dashed", linewidth=1) + ## this makes a vertical line of the mean - labs(x=feature, y = "Density") - plt + guides(fill=guide_legend(title=label_column)) +plot_multi_histogram <- function(df, feature, label_column, hist=FALSE) { #function to create nice multi histograms, taken somewhere from the web + plt <- ggplot2::ggplot(df, ggplot2::aes(x=eval(parse(text=feature)), fill=eval(parse(text=label_column)))) + + ggplot2::geom_density(alpha=0.5) + + ggplot2::geom_vline(ggplot2::aes(xintercept=mean(eval(parse(text=feature)))), color="black", linetype="dashed", linewidth=1) + ## this makes a vertical line of the mean + ggplot2::labs(x=feature, y = "Density") + + ggplot2::guides(fill=guide_legend(title=label_column)) + if (hist==TRUE) plt + ggplot2::geom_histogram(alpha=0.7, position="identity", ggplot2::aes(y = ..density..), color="black") + + return(plt) + } diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a648c2969b222841abe76fb2e13c62c351078b2e --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-pipe.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\arguments{ +\item{lhs}{A value or the magrittr placeholder.} + +\item{rhs}{A function call using the magrittr semantics.} +} +\value{ +The result of calling \code{rhs(lhs)}. +} +\description{ +See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +} +\keyword{internal} diff --git a/man/sim_all.Rd b/man/sim_all.Rd index 90c3ac1bf5fd065c7d089b7f581d21ece6df1f9a..7a11efc10b2390edfc7bf027f763b66c41ef826e 100644 --- a/man/sim_all.Rd +++ b/man/sim_all.Rd @@ -2,10 +2,20 @@ % Please edit documentation in R/sim_all.R \name{sim_all} \alias{sim_all} -\title{Title} +\title{Title Is a wrapper for sim_choice executing the simulation over all designs stored in a specific folder} \usage{ sim_all() } +\value{ +a list, with all information on the simulation. This list an be easily processed by the user and in the rmarkdown template. +} \description{ -Title +Title Is a wrapper for sim_choice executing the simulation over all designs stored in a specific folder +} +\examples{ + + designpath<- system.file("extdata","Rbook" ,package = "simulateDCE") + resps =240 # number of respondents + nosim=2 # number of simulations to run (about 500 is minimum) + } diff --git a/man/sim_choice.Rd b/man/sim_choice.Rd index 94a36d6b55a1fffcd305209cc465c2e2786c45b8..02ac2709b54a2665242c04883ab03eb8ad383940 100644 --- a/man/sim_choice.Rd +++ b/man/sim_choice.Rd @@ -14,7 +14,20 @@ sim_choice( ) } \arguments{ -\item{destype}{} +\item{designfile}{path to a file containing a design.} + +\item{no_sim}{Number of runs i.e. how often do you want the simulation to be repeated} + +\item{respondents}{Number of respondents. How many respondents do you want to simulate in each run.} + +\item{mnl_U}{a list containing utility functions as formulas} + +\item{utils}{The first element of the utility function list} + +\item{destype}{Specify which type of design you use. Either ngene or spdesign} +} +\value{ +a list with all information on the run } \description{ Title diff --git a/tests/manualtests.R b/tests/manualtests.R index cf484f0acd99e274878bfa01786843212daa405e..f92597de8963211a4def5dd3c7cd439ba4de0802 100644 --- a/tests/manualtests.R +++ b/tests/manualtests.R @@ -1,6 +1,6 @@ rm(list=ls()) -#devtools::load_all() +devtools::load_all()