idefix implemented but some errors and bad error handling

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.")
   )
 
 }

tests/manual-tests/test_idefix.R

+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")

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
 

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.")
   })