diff --git a/.gitignore b/.gitignore
index 6e753d3ef77a7230413d5b383ce2436c0d5db6d6..250a00e0bd88ef7b0f4c757a336f839f56c858a8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,5 @@
inst/doc
/doc/
/Meta/
+*.pdf
+tests/testthat/Rplots.pdf
diff --git a/DESCRIPTION b/DESCRIPTION
index ccc9d94b797f31f32a30d15501b042f04b2a6d2b..3a7f43ced2e8781d1fdad1ca5cd3f7ed0c6e7e7c 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -23,7 +23,6 @@ Imports:
readr,
rmarkdown,
stats,
- rlang,
utils,
stringr,
tibble,
diff --git a/R/readdesign.R b/R/readdesign.R
index 60773518f3a13facf7b8d3df973c2a445489d2e2..0d500f0888b9da1e04ec2c8eec3573147e94d60a 100644
--- a/R/readdesign.R
+++ b/R/readdesign.R
@@ -1,12 +1,8 @@
-
-
-
-
#' Creates a dataframe with the design.
#'
#' @param design The path to a design file
#' @param designtype Is it a design created with ngene or with spdesign. Ngene desings should be stored as the standard .ngd output. spdesign should be the spdesign object stored as an RDS file. If designtype is not specified, I try to guess what it is. This is especially helpful if you want to carry out a simulation for both spdesign designs and ngene designs at the same time.
-#'
+#' @param destype Deprecated. Use designtype instead.
#' @return a dataframe
#' @export
#'
@@ -20,7 +16,21 @@
-readdesign <- function(design = designfile, designtype = NULL) {
+readdesign <- function(design = designfile, designtype = NULL, destype = NULL) {
+
+
+ # Ensure both designtype and destype are not set simultaneously
+ if (!is.null(designtype) && !is.null(destype)) {
+ stop("Both 'designtype' and 'destype' cannot be specified at the same time. Please use only 'designtype'.")
+ }
+
+ # Handle deprecated 'destype' argument
+ if (!is.null(destype)) {
+ message("'destype' is deprecated. Please use 'designtype' instead.")
+ designtype <- destype
+ }
+
+
if (is.null(designtype)) {
@@ -66,7 +76,7 @@ readdesign <- function(design = designfile, designtype = NULL) {
}
,
- stop("Invalid value for design. Please provide either 'ngene' or 'spdesign', or do not use the argument 'designtype'.")
+ stop("Invalid value for design. Please provide either NULL, 'ngene' or 'spdesign', or do not use the argument 'designtype'. NULL lets us to guess the design.")
)
}
diff --git a/R/sim_all.R b/R/sim_all.R
index e61449c0cea0d2e6d8a2eae60c4fe66cce3f446c..9f7decc68cc83b97aec6d8159454023485fefa45 100644
--- a/R/sim_all.R
+++ b/R/sim_all.R
@@ -27,7 +27,7 @@
#' bheight2=0.25,
#' bheight3=0.50)
#'
-sim_all <- function(nosim=2, resps, destype=NULL, designpath, u, bcoeff, decisiongroups = c(0,1), manipulations = list(), estimate = TRUE, chunks=1, utility_transform_type = "simple"){
+sim_all <- function(nosim=2, resps, designtype=NULL, destype = NULL, designpath, u, bcoeff, decisiongroups = c(0,1), manipulations = list(), estimate = TRUE, chunks=1, utility_transform_type = "simple"){
#################################################
########## Input Validation Test ###############
@@ -67,7 +67,7 @@ sim_all <- function(nosim=2, resps, destype=NULL, designpath, u, bcoeff, decisio
}
# Check if decisiongroups ends with 1
- if (tail(decisiongroups, 1) != 1) {
+ if (utils::tail(decisiongroups, 1) != 1) {
stop("Decision groups must end with 1.")
}
@@ -83,7 +83,7 @@ sim_all <- function(nosim=2, resps, destype=NULL, designpath, u, bcoeff, decisio
formula_strings <- unlist(u)
coef_names <- unique(unlist(lapply(formula_strings, function(f) {
# Parse the formula to extract coefficient names
- all_vars <- all.vars(as.formula(f))
+ all_vars <- all.vars(stats::as.formula(f))
coef_vars <- all_vars[grep("^b", all_vars)]
return(coef_vars)
})))
@@ -116,7 +116,7 @@ sim_all <- function(nosim=2, resps, destype=NULL, designpath, u, bcoeff, decisio
tictoc::tic()
all_designs<- purrr::map(designfile, sim_choice,
- no_sim= nosim,respondents = resps, destype=destype, ut=u, bcoefficients = bcoeff, decisiongroups = decisiongroups, manipulations = manipulations, estimate = estimate, chunks =chunks, utility_transform_type = utility_transform_type) %>% ## iterate simulation over all designs
+ no_sim= nosim,respondents = resps, designtype=designtype, destype =destype, ut=u, bcoefficients = bcoeff, decisiongroups = decisiongroups, manipulations = manipulations, estimate = estimate, chunks =chunks, utility_transform_type = utility_transform_type) %>% ## iterate simulation over all designs
stats::setNames(designname)
diff --git a/R/sim_choice.R b/R/sim_choice.R
index f7d88906e0049ba1d67776dfb832947bead01292..ed50e05628ea8e55358e34adbc9409ea3911b72b 100644
--- a/R/sim_choice.R
+++ b/R/sim_choice.R
@@ -5,7 +5,6 @@
#' @param respondents Number of respondents. How many respondents do you want to simulate in each run.
#' @param ut The first element of the utility function list
#' @inheritParams readdesign
-#' @param estimate If TRUE models will be estimated. If false only a dataset will be simulated. Default is true
#' @inheritParams simulate_choices
#' @param chunks The number of chunks determines how often results should be stored on disk as a safety measure to not loose simulations if models have already been estimated. For example, if no_sim is 100 and chunks = 2, the data will be saved on disk after 50 and after 100 runs.
#' @param utility_transform_type How the utility function you entered is transformed to the utility function required for mixl. You can use the classic way (simple) where parameters have to start with "b" and variables with "alt" or the more flexible (but potentially error prone) way (exact) where parameters and variables are matched exactly what how the are called in the dataset and in the bcoeff list. Default is "simple". In the long run, simple will be deleted, as exact should be downwards compatible.
@@ -13,13 +12,13 @@
#' @export
#'
#' @examples \dontrun{ simchoice(designfile="somefile", no_sim=10, respondents=330,
-#' mnl_U,ut=u[[1]] ,destype="ngene")}
+#' mnl_U,ut=u[[1]] ,designtype="ngene")}
#'
-sim_choice <- function(designfile, no_sim=10, respondents=330,ut ,destype=destype, bcoefficients, decisiongroups=c(0,1), manipulations = list() , estimate, chunks=1, utility_transform_type = "simple") {
+sim_choice <- function(designfile, no_sim = 10, respondents = 330,ut ,designtype = NULL, destype = NULL, bcoefficients, decisiongroups=c(0,1), manipulations = list() , estimate, chunks=1, utility_transform_type = "simple") {
if (utility_transform_type == "simple") {
- warning("'simple' is deprecated and will be removed in the future. Use 'exact' instead.", call. = FALSE)
+ message("'simple' is deprecated and will be removed in the future. Use 'exact' instead.", call. = FALSE)
}
@@ -66,7 +65,7 @@ designs_all <- list()
- design<- readdesign(design = designfile, designtype = destype)
+ design<- readdesign(design = designfile, designtype = designtype, destype = destype)
if (!("Block" %in% colnames(design))) design$Block=1 # If no Blocks exist, create a variable Blocks to indicate it is only one block
@@ -110,8 +109,11 @@ designs_all <- list()
transform_util2 <- function() {
- # Filter relevant database variables
- relevant_database_vars <- setdiff(names(database), c("V_1", "V_2", "U_1", "U_2", "CHOICE"))
+ # Exclude columns that match "V_<any integer>" or "U_<any integer>" pattern
+ relevant_database_vars <- setdiff(
+ names(database),
+ c(grep("^(V_|U_|e_)\\d+$", names(database), value = TRUE), "CHOICE")
+ )
mnl_U <- paste(
purrr::map_chr(ut[[1]], as.character, keep.source.attr = TRUE),
@@ -119,7 +121,7 @@ transform_util2 <- function() {
";"
) %>%
# Replace coefficients with exact matches
- stringr::str_replace_all(setNames(
+ stringr::str_replace_all(stats::setNames(
paste0("@", names(bcoefficients)),
paste0("(?<![._a-zA-Z0-9])", names(bcoefficients), "(?![._a-zA-Z0-9-])")
)) %>%
@@ -132,7 +134,7 @@ transform_util2 <- function() {
`V_` = "U_"
)) %>%
# Replace only relevant database variables
- stringr::str_replace_all(setNames(
+ stringr::str_replace_all(stats::setNames(
paste0("$", relevant_database_vars),
paste0("(?<![._a-zA-Z0-9])", relevant_database_vars, "(?![._a-zA-Z0-9-])")
)) %>%
diff --git a/R/simulate_choices.R b/R/simulate_choices.R
index 6931481cb4fbdc2cd2df77e7c222fd7076316483..5cb5f32880672a956a0510118e473dd3aeeca479 100644
--- a/R/simulate_choices.R
+++ b/R/simulate_choices.R
@@ -3,15 +3,15 @@
#' @param data a dataframe that includes a design repeated for the number of observations
#' @param utility a list with the utility functions, one utility function for each alternatives
#' @param setspp an integer, the number of choice sets per person
-#' @inheritParams readdesign
#' @param bcoefficients List of initial coefficients for the utility function. List content/length can vary based on application, but should all begin with b and be the same as those entered in the utility functions
#' @param decisiongroups A vector showing how decision groups are numerically distributed
#' @param manipulations A variable to alter terms of the utility functions examples may be applying a factor or applying changes to terms selectively for different groups
+#' @param estimate If TRUE models will be estimated. If false only a dataset will be simulated. Default is true
#' @return a dataframe that includes simulated choices and a design
#' @export
#'
#' @examples \dontrun{simulate_choices(datadet, ut,setspp)}
-simulate_choices <- function(data, utility, setspp, destype, bcoefficients, decisiongroups = c(0,1), manipulations = list(), estimate) { #the part in dataset that needs to be repeated in each run
+simulate_choices <- function(data, utility, setspp, bcoefficients, decisiongroups = c(0,1), manipulations = list(), estimate) { #the part in dataset that needs to be repeated in each run
@@ -83,7 +83,7 @@ simulate_choices <- function(data, utility, setspp, destype, bcoefficients, deci
## add random component and calculate total utility
data<- data %>%
dplyr::rename_with(~ stringr::str_replace_all(.,pattern = "\\.","_"), tidyr::everything()) %>%
- dplyr::mutate(dplyr::across(.cols=n,.fns = ~ evd::rgumbel(setspp,loc=0, scale=1), .names = "{'e'}_{n}" ),
+ dplyr::mutate(dplyr::across(.cols=dplyr::all_of(n),.fns = ~ evd::rgumbel(setspp,loc=0, scale=1), .names = "{'e'}_{n}" ),
dplyr::across(dplyr::starts_with("V_"), .names = "{'U'}_{n}") + dplyr::across(dplyr::starts_with("e_")) ) %>% dplyr::ungroup() %>%
dplyr::mutate(CHOICE=max.col(.[,grep("U_",names(.))])
) %>%
diff --git a/man/readdesign.Rd b/man/readdesign.Rd
index 72011ee146d2df2389a101d24e0427090c0ad0f8..a393fc84e902eea0f6b734e52d467e4cce9ed039 100644
--- a/man/readdesign.Rd
+++ b/man/readdesign.Rd
@@ -4,12 +4,14 @@
\alias{readdesign}
\title{Creates a dataframe with the design.}
\usage{
-readdesign(design = designfile, designtype = NULL)
+readdesign(design = designfile, designtype = NULL, destype = NULL)
}
\arguments{
\item{design}{The path to a design file}
\item{designtype}{Is it a design created with ngene or with spdesign. Ngene desings should be stored as the standard .ngd output. spdesign should be the spdesign object stored as an RDS file. If designtype is not specified, I try to guess what it is. This is especially helpful if you want to carry out a simulation for both spdesign designs and ngene designs at the same time.}
+
+\item{destype}{Deprecated. Use designtype instead.}
}
\value{
a dataframe
diff --git a/man/sim_all.Rd b/man/sim_all.Rd
index a614b53aa93a55ca5b172ba90cd7d2cce33cb1b5..ce87f0682dd22fefdf21e0222e98ac2f4ea6c134 100644
--- a/man/sim_all.Rd
+++ b/man/sim_all.Rd
@@ -8,6 +8,7 @@ update}
sim_all(
nosim = 2,
resps,
+ designtype = NULL,
destype = NULL,
designpath,
u,
@@ -24,6 +25,10 @@ sim_all(
\item{resps}{Number of respondents you want to simulate}
+\item{designtype}{Is it a design created with ngene or with spdesign. Ngene desings should be stored as the standard .ngd output. spdesign should be the spdesign object stored as an RDS file. If designtype is not specified, I try to guess what it is. This is especially helpful if you want to carry out a simulation for both spdesign designs and ngene designs at the same time.}
+
+\item{destype}{Deprecated. Use designtype instead.}
+
\item{designpath}{The path to the folder where the designs are stored. For example "c:/myfancydec/Designs"}
\item{u}{A list with utility functions. The list can incorporate as many decision rule groups as you want. However, each group must be in a list in this list. If you just use one group (the normal), this group still has to be in a list in the u list. As a convention name beta coefficients starting with a lower case "b"}
diff --git a/man/sim_choice.Rd b/man/sim_choice.Rd
index f78072f23ec808b264fc111cca52d98513037871..dce176ab7438b89747b203af3d368e1f73ec3a9f 100644
--- a/man/sim_choice.Rd
+++ b/man/sim_choice.Rd
@@ -9,7 +9,8 @@ sim_choice(
no_sim = 10,
respondents = 330,
ut,
- destype = destype,
+ designtype = NULL,
+ destype = NULL,
bcoefficients,
decisiongroups = c(0, 1),
manipulations = list(),
@@ -27,6 +28,10 @@ sim_choice(
\item{ut}{The first element of the utility function list}
+\item{designtype}{Is it a design created with ngene or with spdesign. Ngene desings should be stored as the standard .ngd output. spdesign should be the spdesign object stored as an RDS file. If designtype is not specified, I try to guess what it is. This is especially helpful if you want to carry out a simulation for both spdesign designs and ngene designs at the same time.}
+
+\item{destype}{Deprecated. Use designtype instead.}
+
\item{bcoefficients}{List of initial coefficients for the utility function. List content/length can vary based on application, but should all begin with b and be the same as those entered in the utility functions}
\item{decisiongroups}{A vector showing how decision groups are numerically distributed}
@@ -47,6 +52,6 @@ Simulate and estimate choices
}
\examples{
\dontrun{ simchoice(designfile="somefile", no_sim=10, respondents=330,
- mnl_U,ut=u[[1]] ,destype="ngene")}
+ mnl_U,ut=u[[1]] ,designtype="ngene")}
}
diff --git a/man/simulate_choices.Rd b/man/simulate_choices.Rd
index e23bb261cb78528d670d3b91e0c896fc925a6774..e5eacb3acdb8d620201d9f77d38c53ac8392fa14 100644
--- a/man/simulate_choices.Rd
+++ b/man/simulate_choices.Rd
@@ -8,7 +8,6 @@ simulate_choices(
data,
utility,
setspp,
- destype,
bcoefficients,
decisiongroups = c(0, 1),
manipulations = list(),
@@ -27,6 +26,8 @@ simulate_choices(
\item{decisiongroups}{A vector showing how decision groups are numerically distributed}
\item{manipulations}{A variable to alter terms of the utility functions examples may be applying a factor or applying changes to terms selectively for different groups}
+
+\item{estimate}{If TRUE models will be estimated. If false only a dataset will be simulated. Default is true}
}
\value{
a dataframe that includes simulated choices and a design
diff --git a/tests/manual-tests/Rbookfull.R b/tests/manual-tests/Rbookfull.R
index aa9025a5e86e67e369c1b278a69ee5409bb9c337..504ac7254dbd551292ded6e10a0fd67d95b5b004 100644
--- a/tests/manual-tests/Rbookfull.R
+++ b/tests/manual-tests/Rbookfull.R
@@ -38,7 +38,7 @@ ul<- list(u1= list(
-rbook <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype,
+rbook <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype,
designpath = designpath, u= ul, bcoeff = bcoeff, chunks = 4, utility_transform_type = "exact")
diff --git a/tests/manual-tests/SE-Agri.R b/tests/manual-tests/SE-Agri.R
index af380da733d3646ba6f19c955348ea919fc735aa..eaa1ba1e3d4aaf83263819ce36fb3fa9e29c2bf3 100644
--- a/tests/manual-tests/SE-Agri.R
+++ b/tests/manual-tests/SE-Agri.R
@@ -2,7 +2,6 @@ rm(list=ls())
devtools::load_all()
-library(rlang)
designpath<- system.file("extdata","SE_AGRI", package = "simulateDCE")
@@ -40,6 +39,6 @@ ul<- list(u1=
v3 =V.3 ~ basc)
)
-seagri <- sim_all(nosim = nosim, resps=resps, destype = destype,
- designpath = designpath, u=ul, bcoeff = bcoeff, manipulations = manipulations)
+seagri <- sim_all(nosim = nosim, resps=resps, designtype = destype,
+ designpath = designpath, u=ul, bcoeff = bcoeff, manipulations = manipulations, utility_transform_type = "exact")
diff --git a/tests/manual-tests/SE_Drive.R b/tests/manual-tests/SE_Drive.R
index 453ffa3785a9ea3610efd84c59186e33a923a831..8943e7b08c11ec51a204931dd9ddb619e061e5d6 100644
--- a/tests/manual-tests/SE_Drive.R
+++ b/tests/manual-tests/SE_Drive.R
@@ -4,7 +4,6 @@ rm(list=ls())
devtools::load_all()
-library(rlang)
designpath<- system.file("extdata","SE_DRIVE" ,package = "simulateDCE")
@@ -50,5 +49,5 @@ ul<-list( u1 =
destype="ngene"
-sedrive <- sim_all(nosim = nosim, resps=resps, destype = destype,
+sedrive <- sim_all(nosim = nosim, resps=resps ,destype = "ngene",
designpath = designpath, u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups, manipulations = manipulations, utility_transform_type = "exact")
diff --git a/tests/manual-tests/agora.R b/tests/manual-tests/agora.R
index 8aa18f7939abac554e0ddfaa6a8093241afc9d47..65085fb15e4db4f91e134dcb62f78651941248cd 100644
--- a/tests/manual-tests/agora.R
+++ b/tests/manual-tests/agora.R
@@ -41,5 +41,5 @@ ul<-list( u1 =
destype="ngene"
-agora <- sim_all(nosim = nosim, resps=resps, destype = destype,
- designpath = designpath, u=ul, bcoeff = bcoeff)
+agora <- sim_all(nosim = nosim, resps=resps, designtype = destype,
+ designpath = designpath, u=ul, bcoeff = bcoeff, utility_transform_type = "exact")
diff --git a/tests/manual-tests/csa.R b/tests/manual-tests/csa.R
index b8d9f83796057dfb213f9fa4f4e5eea0b63a33fc..e67156925ed668bfad7ba047b302df16db07b603 100644
--- a/tests/manual-tests/csa.R
+++ b/tests/manual-tests/csa.R
@@ -43,7 +43,7 @@ ul<- list(u1= list(
-csa <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype,
+csa <- simulateDCE::sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u= ul, bcoeff = bcoeff, utility_transform_type = "exact")
diff --git a/tests/manual-tests/feedadditives.R b/tests/manual-tests/feedadditives.R
index 38854bc5abe4b738fbc58d5fc34c9024b79b7904..23f91a7b78e8a6fbd57848a52a2dd9b8c020402a 100644
--- a/tests/manual-tests/feedadditives.R
+++ b/tests/manual-tests/feedadditives.R
@@ -45,5 +45,5 @@ ul<- list(u1= list(
v3 =V.3 ~ basc)
)
-feedadditives <- sim_all(nosim = nosim, resps=resps, destype = destype,
+feedadditives <- sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
diff --git a/tests/manual-tests/test_decisiongroups.R b/tests/manual-tests/test_decisiongroups.R
index 147a7366cfb98bdb21d99ff89b46ca4bc0f08bde..db3796037d140d2dca8da2e4a606203f04b32077 100644
--- a/tests/manual-tests/test_decisiongroups.R
+++ b/tests/manual-tests/test_decisiongroups.R
@@ -30,7 +30,7 @@ ul<- list(uA=
)
-simplesim <- sim_all(nosim = nosim, resps = resps,designpath = designpath, bcoeff = bcoeff, u = ul,destype = "spdesign" , decisiongroups = desisiongroups)
+simplesim <- sim_all(nosim = nosim, resps = resps,designpath = designpath, bcoeff = bcoeff, u = ul,designtype = "spdesign" , decisiongroups = desisiongroups)
testdata = simplesim[["twoattr"]][[1]][["data"]] %>%
distinct(group, Choice_situation ,.keep_all = T) %>%
diff --git a/tests/testthat.R b/tests/testthat.R
index 54b85629fb05d0fab04cc555ca808741c06cccd1..0c7bf785aa902951670d5c41288b92dde9e852c4 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -7,6 +7,6 @@
# * https://testthat.r-lib.org/reference/test_package.html#special-files
library(testthat)
-library(simulateDCE)
+
test_check("simulateDCE")
diff --git a/tests/testthat/test-readdesign.R b/tests/testthat/test-readdesign.R
index dcb699e5a537c583ef8019d9f26fe83becac7ff6..97e09e4abe5716b66917e99c6a21f36566bca437 100644
--- a/tests/testthat/test-readdesign.R
+++ b/tests/testthat/test-readdesign.R
@@ -2,7 +2,7 @@ design_path <- system.file("extdata","agora", "altscf_eff.ngd" ,package = "simul
test_that("wrong designtype", {
- expect_error(readdesign(design = design_path, designtype = "ng"),"Invalid value for design. Please provide either 'ngene' or 'spdesign'.")
+ expect_error(readdesign(design = design_path, designtype = "ng"),"Invalid value for design. Please provide either NULL, 'ngene' or 'spdesign', or do not use the argument 'designtype'. NULL lets us to guess the design.")
})
diff --git a/tests/testthat/test-sim_all.R b/tests/testthat/test-sim_all.R
index 3f1321da5a9fc4a687f069a89234097bfcc95dd8..edc1054b5379eb150ac4eaf55814d315a617f12d 100644
--- a/tests/testthat/test-sim_all.R
+++ b/tests/testthat/test-sim_all.R
@@ -1,32 +1,30 @@
-library(rlang)
library(formula.tools)
## all tests are wrapped in single function to make it easier to call on different designs,
## which is done at the end of this script
-comprehensive_design_test <- function(nosim, resps, destype, designpath, ul, bcoeff, decisiongroups=c(0,1)) {
+comprehensive_design_test <- function(nosim, resps, designtype, designpath, ul, bcoeff, decisiongroups=c(0,1)) {
# Test cases related to sim_all function
test_that("u is not a list of lists", {
- expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u=data.frame(u=" alp"), bcoeff = bcoeff),
"must be provided and must be a list containing at least one list")
})
test_that("no value provided for utility", {
- expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, bcoeff = bcoeff),
"must be provided and must be a list containing at least one list")
})
-
test_that("wrong designtype", {
- expect_error(sim_all(nosim = nosim, resps=resps, destype = "ng",
- designpath = designpath, u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups),"Invalid value for design. Please provide either 'ngene' or 'spdesign'.")
+ expect_error(sim_all(nosim = nosim, resps=resps, designtype = "ng",
+ designpath = designpath, u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups),"Invalid value for design. Please provide either NULL, 'ngene' or 'spdesign', or do not use the argument 'designtype'. NULL lets us to guess the design.")
})
test_that("folder does not exist", {
- expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = system.file("da/bullshit", package = "simulateDCE"), u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
,
"The folder where your designs are stored does not exist.")
@@ -34,24 +32,35 @@ comprehensive_design_test <- function(nosim, resps, destype, designpath, ul, bc
test_that("seed setting makes code reproducible", {
set.seed(3333)
- result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
+ result1 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
set.seed(3333)
- result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
+ result2 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
expect_identical(result1[["summaryall"]], result2[["summaryall"]])
})
test_that("No seed setting makes code results different", {
- result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
+ result1 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
- result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
+ result2 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
expect_failure(expect_identical(result1[["summaryall"]], result2[["summaryall"]]))
})
+ test_that("exact and simple produce same results", {
+ set.seed(3333)
+ result1 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups, utility_transform_type = "simple")
+
+ set.seed(3333)
+ result2 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups , , utility_transform_type = "exact")
+
+ expect_identical(result1[["summaryall"]], result2[["summaryall"]])
+ })
+
+
test_that("Length of utility functions matches number of decision groups", {
# Define test inputs
badbcoeff = list(
@@ -86,35 +95,35 @@ comprehensive_design_test <- function(nosim, resps, destype, designpath, ul, bc
baddecisiongroups <- c(0,0.3,0.6,1)
# Test that the function throws an error when lengths don't match
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = badlist, bcoeff = badbcoeff, decisiongroups = baddecisiongroups), "Number of decision groups must equal number of utility functions!")
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = badlist, bcoeff = badbcoeff, decisiongroups = baddecisiongroups), "Number of decision groups must equal number of utility functions!")
# Define test inputs where lengths match
gooddecisiongroups <- c(0,0.3,0.6, 0.8, 1)
# Test that the function does not throw an error when lengths match (assumed true in input)
- expect_no_error(sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups))
+ expect_no_error(sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups))
})
########### Additional Tests ##############
test_that("bcoeff is provided", {
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype,
designpath = designpath, u = ul))
})
test_that("bcoeff contains valid values", {
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype,
designpath = designpath, u = ul, bcoeff = list(bsq = "invalid")))
})
test_that("bcoeff is a list", {
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype,
designpath = designpath, u = ul, bcoeff = "not a list")
)
})
test_that("B coefficients in the utility functions dont match those in the bcoeff list", {
- expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
+ expect_error(sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u = ul, bcoeff = list(bWRONG = 0.00)))
})
@@ -125,24 +134,24 @@ comprehensive_design_test <- function(nosim, resps, destype, designpath, ul, bc
test_that("Design path must be a valid directory", {
# Test case: designpath is not a character string
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype, designpath = 123, u = ul, bcoeff = bcoeff))
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = 123, u = ul, bcoeff = bcoeff))
# Test case: designpath does not exist
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype, designpath = '/nonexistent/path', u = ul, bcoeff = bcoeff))
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = '/nonexistent/path', u = ul, bcoeff = bcoeff))
# Test case: designpath is not a directory
- expect_error(sim_all(nosim = nosim, resps = resps, destype = destype, designpath = 'path/to/a/file.txt', u = ul, bcoeff = bcoeff))
+ expect_error(sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = 'path/to/a/file.txt', u = ul, bcoeff = bcoeff))
})
test_that("Resps must be an integer", {
# Test case: resps is missing
- expect_error(sim_all(nosim = nosim, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff))
+ expect_error(sim_all(nosim = nosim, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff))
# Test case: resps is not an integer
- expect_error(sim_all(nosim = nosim, resps = "abc", destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff))
+ expect_error(sim_all(nosim = nosim, resps = "abc", designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff))
# Test case: resps is a numeric but not an integer
- expect_error(sim_all(nosim = nosim, resps = 1.5, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff))
+ expect_error(sim_all(nosim = nosim, resps = 1.5, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff))
})
@@ -152,7 +161,7 @@ comprehensive_design_test <- function(nosim, resps, destype, designpath, ul, bc
test_that("Simulation results are reasonable", {
- result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
+ result1 <- sim_all(nosim = nosim, resps = resps, designtype = destype, designpath = designpath, u = ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
# obtain the names of the design files (without extensions)
designs <- tools::file_path_sans_ext(list.files(designpath, full.names = FALSE))
@@ -221,7 +230,7 @@ ul<- list(u1= list(
)
)
-comprehensive_design_test(nosim=nosim, resps=resps, destype=destype, designpath=designpath, ul = ul, bcoeff = bcoeff)
+comprehensive_design_test(nosim=nosim, resps=resps, designtype=destype, designpath=designpath, ul = ul, bcoeff = bcoeff)
###############################
#### From feedadditives #######
diff --git a/vignettes/SE_Agri-vignette.Rmd b/vignettes/SE_Agri-vignette.Rmd
index ee3885846098717124ae8c67987eed5affeeda16..a213399d78465ffdb52d56066df577a4c05adbd0 100644
--- a/vignettes/SE_Agri-vignette.Rmd
+++ b/vignettes/SE_Agri-vignette.Rmd
@@ -117,7 +117,7 @@ set.seed(3393)
The sim_all function returns a multidimensional R list containing graphs, simulated observations and a dataframe containing sumaries of estimated beta coefficients. In general these will be printed to the console, but the entire results can also be assigned to an r list object.
```{r output}
-seagri <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype,
+seagri <- simulateDCE::sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u= ul, bcoeff = bcoeff, manipulations = manipulations)
diff --git a/vignettes/SE_drive-vignette.Rmd b/vignettes/SE_drive-vignette.Rmd
index b8091250670ac6c3531bf0b7db34b92b7e740bf6..be67eae8b71b9dd1721e389694b214a8528099d5 100644
--- a/vignettes/SE_drive-vignette.Rmd
+++ b/vignettes/SE_drive-vignette.Rmd
@@ -108,7 +108,7 @@ destype="ngene"
The sim_all function returns a multidimensional R list containing graphs, simulated observations and a dataframe containing sumaries of estimated b coefficients. In general these will be printed to the console, but the entire results can also be assigned to an r list object.
```{r output}
- sedrive <- sim_all(nosim = nosim, resps=resps, destype = destype,
+ sedrive <- sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups)
diff --git a/vignettes/csa-vignette.Rmd b/vignettes/csa-vignette.Rmd
index d5ebb3a6df56a06b23b64b6458b7ffab4bae0378..8bd04b40b8ca2b43556489598e1dc9f144c0319e 100644
--- a/vignettes/csa-vignette.Rmd
+++ b/vignettes/csa-vignette.Rmd
@@ -99,7 +99,7 @@ set.seed(3393)
The sim_all function returns a multidimensional R list containing graphs, simulated observations and a dataframe containing sumaries of estimated b coefficients. In general these will be printed to the console, but the entire results can also be assigned to an r list object.
```{r output}
-csa <- simulateDCE::sim_all(nosim = nosim, resps=resps, destype = destype,
+csa <- simulateDCE::sim_all(nosim = nosim, resps=resps, designtype = destype,
designpath = designpath, u= ul, bcoeff = bcoeff)