Code owners
Assign users and groups as approvers for specific file changes. Learn more.
readdesign.R 4.44 KiB
#' Creates a dataframe with the design.
#'
#' @param design The path to a design file
#' @param designtype Is it a design created with ngene, spdesign or idefix. use 'ngene', 'spdesign' or 'idefix. Ngene designs should be stored as the standard .ngd output. spdesign should be the spdesign object stored as an RDS file. Idefix objects should also be 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
#'
#' @examples library(simulateDCE)
#' mydesign <-readdesign(
#' system.file("extdata","agora", "altscf_eff.ngd" ,package = "simulateDCE"),
#' "ngene")
#'
#' print(mydesign)
#'
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)) {
# Check if the string ends with ".ngd"
if (grepl("\\.ngd$", design)) {
# Code to execute if condition is true
designtype = "ngene"
message("I guessed it is an ngene file")
} else if("spdesign" %in% class(readRDS(design)) ) {
designtype = "spdesign"
message("I assume it is a spdesign.")
} else {
designtype <- "idefix"
message("I assume it is an idefix design.")
}
}
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()
}
as.data.frame(designf)
}
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(!dplyr::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",
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" = {
read_test() %>%
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())
}
,
"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.")
)
}