diff --git a/DESCRIPTION b/DESCRIPTION
index fd093775c2ddc81a77927ca2ccc6156092411f99..8c5f730a485f90e4b9ab7ba9c8afe5649d06437a 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: simulateDCE
Title: Simulate data for discrete choice experiments
-Version: 0.1.1
+Version: 0.1.2
Authors@R:
person(given = "Julian", family = "Sagebiel", email = "julian.sagebiel@idiv.de", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-0253-6875"))
diff --git a/NAMESPACE b/NAMESPACE
index e08595a730259e521012c3c53014724b8dc2ec8e..3c8cce7bbfa0ce262b1bfe1fb678ca5930e27cb1 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,6 +2,7 @@
export("%>%")
export(download_and_extract_zip)
+export(extract_b_values)
export(readdesign)
export(sim_all)
export(sim_choice)
diff --git a/R/readdesign.R b/R/readdesign.R
index 781b964d98dc81f5dd6fa6c49a04a87fa49601a0..d512e32722ef9d0adea053029dd76d91fe5eb9c5 100644
--- a/R/readdesign.R
+++ b/R/readdesign.R
@@ -22,21 +22,35 @@
readdesign <- function(design = designfile, designtype = destype) {
design <- switch(designtype,
- "ngene" = suppressWarnings(readr::read_delim(design,
- delim = "\t",
- escape_double = FALSE,
- trim_ws = TRUE,
- col_select = c(-Design, -tidyr::starts_with("...")),
- name_repair = "universal", show_col_types = FALSE ,guess_max = Inf
- )) %>%
- dplyr::filter(!is.na(Choice.situation)),
- "spdesign" = as.data.frame(readRDS(design)) %>%
- dplyr::mutate(Choice.situation = 1:dplyr::n()) %>%
- dplyr::rename_with(~ stringr::str_replace(., pattern = "_", "\\."), tidyr::everything()) %>%
- dplyr::rename_with(~ dplyr::case_when(
- . == "block" ~ "Block",
- TRUE ~ .
- ), tidyr::everything()),
- stop("Invalid value for design. Please provide either 'ngene' or 'spdesign'.")
+ "ngene" = suppressWarnings(readr::read_delim(design,
+ delim = "\t",
+ escape_double = FALSE,
+ trim_ws = TRUE,
+ col_select = c(-Design, -tidyr::starts_with("...")),
+ name_repair = "universal", show_col_types = FALSE ,guess_max = Inf
+ )) %>%
+ dplyr::filter(!is.na(Choice.situation)),
+ "spdesign" = {
+ designf <- readRDS(design)
+ if (is.list(designf) & !is.data.frame(designf)){
+ if (!"design" %in% names(designf)) {
+ stop("The 'design' list element is missing. Make sure to provide a proper spdesign object.")
+ }
+ designf<-designf[["design"]]
+ }
+ as.data.frame(designf) %>%
+ dplyr::mutate(Choice.situation = 1:dplyr::n()) %>%
+ dplyr::rename_with(~ stringr::str_replace(., pattern = "_", "\\."), tidyr::everything()) %>%
+ dplyr::rename_with(~ dplyr::case_when(
+ . == "block" ~ "Block",
+ TRUE ~ .
+ ), tidyr::everything())
+
+ }
+ ,
+ stop("Invalid value for design. Please provide either 'ngene' or 'spdesign'.")
)
+
}
+
+
diff --git a/R/spdesign_utils.R b/R/spdesign_utils.R
new file mode 100644
index 0000000000000000000000000000000000000000..a13fd764741825a9a09da1720f1ffc71ad9ac526
--- /dev/null
+++ b/R/spdesign_utils.R
@@ -0,0 +1,30 @@
+#' Title Extracts beta values from an spdesign object
+#'
+#' @param input_list the list where the parameters are stored. Usually this is `design$utility`
+#'
+#' @return A named list with parameter values which can be used in `sim_all`
+#' @export
+#'
+#' @examples \dontrun{
+#' extract_b_values(design$utility)
+#' }
+extract_b_values <- function(input_list) {
+ extract_b_value <- function(input_string) {
+
+ matches <- gregexpr("b_\\w+\\[(-?\\d+\\.?\\d*)\\]", input_string)
+ matches <- regmatches(input_string, matches)
+ matches <- unlist(matches)
+
+
+ names <- gsub("\\[.*", "", matches)
+
+ values <- gsub(".*\\[(-?\\d+\\.?\\d*)\\]", "\\1", matches)
+
+ result <- stats::setNames(as.numeric(values), names)
+ return(result)
+ }
+
+ b_values <- unlist(lapply(input_list, extract_b_value))
+ b_values<- stats::setNames(b_values,gsub("alt\\d+\\.","",names(b_values)))
+ return(as.list(b_values))
+}
diff --git a/inst/extdata/ValuGaps/des1.RDS b/inst/extdata/ValuGaps/des1.RDS
new file mode 100644
index 0000000000000000000000000000000000000000..f6c78a8867d7a9e284744752684f0f9832d95ad6
Binary files /dev/null and b/inst/extdata/ValuGaps/des1.RDS differ
diff --git a/inst/extdata/testfiles/nousefullist.RDS b/inst/extdata/testfiles/nousefullist.RDS
new file mode 100644
index 0000000000000000000000000000000000000000..46a6570c2ccaf58d1531baf573def5360ce0377d
Binary files /dev/null and b/inst/extdata/testfiles/nousefullist.RDS differ
diff --git a/man/extract_b_values.Rd b/man/extract_b_values.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..e93fbe02fa57969f3dd70b1c7bbbe44dbb43c49b
--- /dev/null
+++ b/man/extract_b_values.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/spdesign_utils.R
+\name{extract_b_values}
+\alias{extract_b_values}
+\title{Title Extracts beta values from an spdesign object}
+\usage{
+extract_b_values(input_list)
+}
+\arguments{
+\item{input_list}{the list where the parameters are stored. Usually this is \code{design$utility}}
+}
+\value{
+A named list with parameter values which can be used in \code{sim_all}
+}
+\description{
+Title Extracts beta values from an spdesign object
+}
+\examples{
+\dontrun{
+extract_b_values(design$utility)
+}
+}
diff --git a/tests/testthat/test-readdesign.R b/tests/testthat/test-readdesign.R
index 849f213e02cf98cff3340f755f855da0490dd9d4..caf80a3b6182469775d37275c73fdd9285095a97 100644
--- a/tests/testthat/test-readdesign.R
+++ b/tests/testthat/test-readdesign.R
@@ -15,4 +15,29 @@ test_that("all is correct", {
expect_no_error(readdesign(design = design_path, designtype = "ngene"))
})
+### Tests for spdesign
+design_path <- system.file("extdata","CSA", "design2.RDS" ,package = "simulateDCE")
+
+test_that("all is correct", {
+ expect_no_error(readdesign(design = design_path, designtype = "spdesign"))
+})
+
+
+## trying objects that do not work
+
+design_path <- system.file("extdata","testfiles", "nousefullist.RDS" ,package = "simulateDCE")
+
+test_that("spdesign object is a list but does not contain the right element design", {
+ expect_error(readdesign(design = design_path, designtype = "spdesign"),
+ "list element is missing. Make sure to provide a ")
+})
+
+
+## test spdesign object containing original object
+
+design_path <- system.file("extdata","ValuGaps", "des1.RDS" ,package = "simulateDCE")
+
+test_that("all is correct with full spdesign objects", {
+ expect_no_error(readdesign(design = design_path, designtype = "spdesign"))
+})
diff --git a/vignettes/SE_Agri-vignette.Rmd b/vignettes/SE_Agri-vignette.Rmd
index f69d31c9b6bfeba0d79699df1f1153a8c4a4225a..ee3885846098717124ae8c67987eed5affeeda16 100644
--- a/vignettes/SE_Agri-vignette.Rmd
+++ b/vignettes/SE_Agri-vignette.Rmd
@@ -89,7 +89,7 @@ The simulation can be ran using spdesign or NGENE design files which will be con
```{r other}
-designpath<- system.file("extdata","se_AGRI" ,package = "simulateDCE")
+designpath<- system.file("extdata","SE_AGRI" ,package = "simulateDCE")
## can also be specified using relative path eg. designpath<- "Projects/CSA/Designs/"
#notes <- "This design consists of different heuristics. One group did not attend the methan attribute, another group only decided based on the payment"