diff --git a/R/readdesign.R b/R/readdesign.R
index 0d500f0888b9da1e04ec2c8eec3573147e94d60a..db8803bb0e0145f0047448b4a676c34f5b42043a 100644
--- a/R/readdesign.R
+++ b/R/readdesign.R
@@ -49,6 +49,41 @@ readdesign <- function(design = designfile, designtype = NULL, destype = NULL) {
}
+
+ read_test <- function() {
+
+ 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()
+ }
+
+ }
+ idefix <- function() {
+
+ # Process the data
+ read_test() %>%
+ tibble::rownames_to_column(var = "row_id") %>%
+ dplyr::filter(!grepl("no.choice", row_id)) %>% # Exclude no.choice rows
+ dplyr::select(!contains("cte")) %>% # Drop unnecessary columns
+ dplyr::mutate(
+ # Extract Choice.situation as number after 'set'
+ Choice.situation = as.integer(sub("^set(\\d+).*", "\\1", row_id)),
+ # Extract alt as the alternative identifier
+ alt = sub(".*\\.", "", row_id)
+ ) %>%
+ dplyr::select(-row_id) %>% # Drop the original row_id
+ tidyr::pivot_wider(
+ id_cols = "Choice.situation", # Group by Choice.situation
+ names_from = alt, # Use alt to create column suffixes
+ values_from = -c("Choice.situation", "alt"), # Values from other columns
+ names_glue = "{alt}.{.value}" # Custom naming convention
+ )
+ }
+
design <- switch(designtype,
"ngene" = suppressWarnings(readr::read_delim(design,
delim = "\t",
@@ -59,14 +94,8 @@ readdesign <- function(design = designfile, designtype = NULL, destype = NULL) {
)) %>%
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) %>%
+
+ read_test() %>%
dplyr::mutate(Choice.situation = 1:dplyr::n()) %>%
dplyr::rename_with(~ stringr::str_replace(., pattern = "_", "\\."), tidyr::everything()) %>%
dplyr::rename_with(~ dplyr::case_when(
@@ -76,7 +105,8 @@ readdesign <- function(design = designfile, designtype = NULL, destype = NULL) {
}
,
- 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.")
+ "idefix" = idefix() ,
+ stop("Invalid value for design. Please provide either NULL, 'ngene', 'spdesign'or 'idefix', or do not use the argument 'designtype'. NULL lets us to guess the design.")
)
}
diff --git a/inst/extdata/Idefix_designs/test_design2.RDS b/inst/extdata/Idefix_designs/test_design2.RDS
new file mode 100644
index 0000000000000000000000000000000000000000..5342ed3964fde6973f6ed491f332375ec0ae5a44
--- /dev/null
+++ b/inst/extdata/Idefix_designs/test_design2.RDS
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:ed06cf2f7581ab987359402457c46ef05b11ca9e1c6a3a9fa7e08fe5b47de5ae
+size 747
diff --git a/tests/manual-tests/test_idefix.R b/tests/manual-tests/test_idefix.R
new file mode 100644
index 0000000000000000000000000000000000000000..7da2b575c749f6015e8d385aa64fb7e06ea64052
--- /dev/null
+++ b/tests/manual-tests/test_idefix.R
@@ -0,0 +1,14 @@
+devtools::load_all()
+
+
+design_sp <- system.file("extdata","ValuGaps", "des1.RDS" ,package = "simulateDCE")
+
+
+design_idefix <- system.file("extdata","Idefix_designs", "test_design2.RDS" ,package = "simulateDCE")
+
+
+t <-readdesign(design_sp)
+t2 <-readdesign(design_sp, designtype = "spdesign")
+identical(t,t2)
+
+t3 <-readdesign(design_idefix, designtype = "idefix")
diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf
deleted file mode 100644
index 1600ab8ce3ced068a1eca13f40b162b161130c29..0000000000000000000000000000000000000000
Binary files a/tests/testthat/Rplots.pdf and /dev/null differ
diff --git a/tests/testthat/test-readdesign.R b/tests/testthat/test-readdesign.R
index 97e09e4abe5716b66917e99c6a21f36566bca437..d1bd5043b896b2a3b989ba754408518999179afb 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 NULL, 'ngene' or 'spdesign', or do not use the argument 'designtype'. NULL lets us to guess the design.")
+ expect_error(readdesign(design = design_path, designtype = "ng"),"Invalid value for design. Please provide either NULL, 'ngene', 'spdesign'or 'idefix', or do not use the argument 'designtype'. NULL lets us to guess the design.")
})
@@ -22,6 +22,19 @@ test_that("expect message of guess", {
})
+test_that("with or without autodetct get same results for ngene", {
+
+ t <-readdesign(design_path)
+ t2 <-readdesign(design_path, designtype = "ngene")
+
+ expect_equal(t,t2)
+
+
+}
+
+)
+
+
### Tests for spdesign
design_path <- system.file("extdata","CSA", "linear", "BLIbay.RDS" ,package = "simulateDCE")
@@ -30,12 +43,29 @@ test_that("all is correct", {
expect_no_error(readdesign(design = design_path, designtype = "spdesign"))
})
+
+
+
+
+
# Same Tests for spdesign, but detect automatically if it is spdesign
test_that("prints message for guessing", {
expect_message(readdesign(design = design_path), "I assume it is a spdesign")
})
+test_that("with or without autodetct get same results for spdesign", {
+
+ t <-readdesign(design_path)
+ t2 <-readdesign(design_path, designtype = "spdesign")
+
+ expect_equal(t,t2)
+
+
+}
+
+ )
+
## trying objects that do not work
diff --git a/tests/testthat/test-sim_all.R b/tests/testthat/test-sim_all.R
index edc1054b5379eb150ac4eaf55814d315a617f12d..f8ceda7e434571dcdde5db006f519b6973f89c7e 100644
--- a/tests/testthat/test-sim_all.R
+++ b/tests/testthat/test-sim_all.R
@@ -19,7 +19,7 @@ comprehensive_design_test <- function(nosim, resps, designtype, designpath, ul,
test_that("wrong designtype", {
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.")
+ designpath = designpath, u=ul, bcoeff = bcoeff, decisiongroups = decisiongroups),"Invalid value for design. Please provide either NULL, 'ngene', 'spdesign'or 'idefix', or do not use the argument 'designtype'. NULL lets us to guess the design.")
})