some improvements in createSets function

R/makesets.R → R/createSets.R

-createSets <- function(.data, choice, attributes , uniquerow) {
+createSets <- function(.data, choice, attributes , uniquerow, prefix="a") {
   require("dplyr")
   require("tidyr")
   require("purrr")
-  
 
-  
-  sets <- .data %>% 
+  if (!is.data.frame(.data)) {
+    stop("The input data (.data) must be a data frame or tibble.")
+  }
+  if (!all(c(choice, uniquerow) %in% names(.data))) {
+    stop("Both choice and uniquerow columns must exist in the input data.")
+  }
+  attribute_cols <- select(.data, {{ attributes }}) %>% names()
+  if (length(setdiff(attribute_cols, names(.data))) > 0) {
+    stop("Some columns specified in attributes do not exist in the input data.")
+  }
+
+  if (any(is.na(.data[c(choice, uniquerow, attribute_cols)]))) {
+    stop("The columns choice, uniquerow, and attributes should not have missing values.")
+  }
+
+  sets <- .data %>%
     select({{ attributes }}, {{ choice }}, {{ uniquerow }} ) %>%
-    group_by(!!rlang::sym(uniquerow), !!rlang::sym(choice)) %>% 
-    add_count() %>% ungroup %>% 
-    group_by(!!rlang::sym(uniquerow)) %>% 
-    distinct(n, .keep_all=TRUE) %>% 
-    mutate(perc = round((n / sum(n) * 100))) %>% 
+    group_by(!!rlang::sym(uniquerow), !!rlang::sym(choice)) %>%
+    add_count() %>% ungroup %>%
+    group_by(!!rlang::sym(uniquerow)) %>%
+    distinct(n, .keep_all=TRUE) %>%
+    mutate(perc = round((n / sum(n) * 100))) %>%
     arrange({{ uniquerow }}, {{ choice }}) %>%
-    group_split() %>% 
+    group_split() %>%
     set_names(map(., ~ unique(as.character(.x[[rlang::as_string(uniquerow)]]))))
-  
 
-  
+
+
   makesets <- function(.data) {
 
-    
+
     .data %>%
       pivot_wider(
         id_cols = c({{ uniquerow }}, everything()),
@@ -28,11 +41,11 @@ createSets <- function(.data, choice, attributes , uniquerow) {
         values_from = c(n, perc),
         names_sep = "."
       )  %>%
-      select(- {{ uniquerow }}) %>% 
+      select(- {{ uniquerow }}) %>%
       rename_with(
-        ~ gsub("^(a([12]))_(.*)$", "\\3.\\2", .),
-        starts_with("a1") | starts_with("a2")
-      ) %>% 
+        ~ gsub(paste0("^(", prefix, "(\\d+))_(.*)$"), "\\3.\\2", .),
+        matches(paste0("^", prefix, "\\d+_"))
+      ) %>%
       pivot_longer(
         cols = everything(),
         names_to = c("name", "suffix"),
@@ -43,13 +56,13 @@ createSets <- function(.data, choice, attributes , uniquerow) {
         values_from = value
       )
   }
-  
+
   finalsets <- map(sets, ~makesets(.x ))
 
-  
-  
+
+
   return(finalsets)
-  
+
 }
 
 #finalsets2 <- createFreq(database, choice = "pref1", attributes = ends_with(c("ZEIT","x1")), uniquerow = "UniqueRow")