From 0e0479bb82388a60509a1422121d060b53b939dd Mon Sep 17 00:00:00 2001
From: Julian Sagebiel <julian.sagebiel@idiv.de>
Date: Sat, 21 Dec 2024 00:32:19 +0100
Subject: [PATCH] added tests for exact, made sure compatibility with old
destype argument
---
.gitignore | 2 +
DESCRIPTION | 1 -
R/readdesign.R | 24 +++++++---
R/sim_all.R | 8 ++--
R/sim_choice.R | 20 ++++----
R/simulate_choices.R | 6 +--
man/readdesign.Rd | 4 +-
man/sim_all.Rd | 5 ++
man/sim_choice.Rd | 9 +++-
man/simulate_choices.Rd | 3 +-
tests/manual-tests/Rbookfull.R | 2 +-
tests/manual-tests/SE-Agri.R | 5 +-
tests/manual-tests/SE_Drive.R | 3 +-
tests/manual-tests/agora.R | 4 +-
tests/manual-tests/csa.R | 2 +-
tests/manual-tests/feedadditives.R | 2 +-
tests/manual-tests/test_decisiongroups.R | 2 +-
tests/testthat.R | 2 +-
tests/testthat/test-readdesign.R | 2 +-
tests/testthat/test-sim_all.R | 61 ++++++++++++++----------
vignettes/SE_Agri-vignette.Rmd | 2 +-
vignettes/SE_drive-vignette.Rmd | 2 +-
vignettes/csa-vignette.Rmd | 2 +-
23 files changed, 103 insertions(+), 70 deletions(-)
diff --git a/.gitignore b/.gitignore
index 6e753d3..250a00e 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 ccc9d94..3a7f43c 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 6077351..0d500f0 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 e61449c..9f7decc 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 f7d8890..ed50e05 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 6931481..5cb5f32 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 72011ee..a393fc8 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 a614b53..ce87f06 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 f78072f..dce176a 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 e23bb26..e5eacb3 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 aa9025a..504ac72 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 af380da..eaa1ba1 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 453ffa3..8943e7b 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 8aa18f7..65085fb 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 b8d9f83..e671569 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 38854bc..23f91a7 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 147a736..db37960 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 54b8562..0c7bf78 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 dcb699e..97e09e4 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 3f1321d..edc1054 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 ee38858..a213399 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 b809125..be67eae 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 d5ebb3a..8bd04b4 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)
--
GitLab