Added simpliy parameter to every test and added tests for said parameter

NAMESPACE

@@ -1,9 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
 export(align_column_types)
+export(check_column_exactinput)
 export(check_column_names)
 export(check_column_notempty)
 export(check_column_number)
+export(check_column_patterninput)
 export(check_column_types)
 export(check_validity)
 export(filter_column_empty)

R/check_column_empty.R

@@ -1,11 +1,9 @@
-
 #' @title Checks for Empty Entries
 #' @param check_table Data Frame. The table that will be checked against the specified rules in the validity table.
 #' @param validity_table Data Frame. A table that stores the rules by which the check table is compared to.
 #' @param simply Boolean. Changes the return value of the function to a single logical vector of length 1.
 #' @export
 check_column_notempty <- function(check_table, validity_table, simply = FALSE) {
-
   # TODO: check column empty works with values that indicate non empty strings.
   xafty_notempty <- "##!!notempty"
   columns_with_syntax <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = xafty_notempty)
@@ -16,50 +14,38 @@ check_column_notempty <- function(check_table, validity_table, simply = FALSE) {
 
     if (simply) {
       return(result)
-
     } else {
       return(data.frame("Check" = "Column Classes", "Check_Result" = result, "Message" = message))
-
     }
-
   }
 
   list_result <- list()
 
   for (i in seq(length(columns_with_syntax))) {
-
     column_name <- columns_with_syntax[i]
 
     list_result[[i]] <- all(!filter_column_empty(check_table = check_table, filter_column = column_name))
-
   }
 
   names(list_result) <- columns_with_syntax
 
   results_unlisted <- unlist(list_result)
 
   if (all(results_unlisted)) {
-
     result <- TRUE
     message <- paste0("ALL GOOD!")
     columns <- NA
-
-    } else {
-
-      result <- FALSE
-      wrong_columns <- names(results_unlisted)[!results_unlisted]
-      wrong_columns_collapsed <- paste0(wrong_columns, collapse = ", ")
-      columns <- wrong_columns_collapsed
-      message <- paste0("Rule Broken: Column Not Empty. Following columns '##!!notempty' have NA entries: ")
-
-    }
+  } else {
+    result <- FALSE
+    wrong_columns <- names(results_unlisted)[!results_unlisted]
+    wrong_columns_collapsed <- paste0(wrong_columns, collapse = ", ")
+    columns <- wrong_columns_collapsed
+    message <- paste0("Rule Broken: Column Not Empty. Following columns '##!!notempty' have NA entries: ")
+  }
 
   if (simply) {
     return(result)
-
-  } else {
-    return(data.frame("Check" = "Column Not Empty", "Check_Result" = result, "Message" = message, "Columns" = columns))
-
   }
 
+  data.frame("Check" = "Column Not Empty", "Check_Result" = result, "Message" = message, "Columns" = columns)
 }

R/check_column_input.R

@@ -1,9 +1,9 @@
-
 #' @title Check a Table for Exact Value Rules
 #' @param check_table Data Frame. The table that will be checked against the specified rules in the validity table.
 #' @param validity_table Data Frame. A table that stores the rules by which the check table is compared to.
-check_column_exactinput <- function(check_table, validity_table) {
-
+#' @param simply Boolean. Changes the return value of the function to a single logical vector of length 1.
+#' @export
+check_column_exactinput <- function(check_table, validity_table, simply = FALSE) {
   xafty_syntax <- "##!!"
   possible_checks <- c("anyexact", "strictexact", "eachexact")
   xafty_data_types <- paste0(xafty_syntax, possible_checks)
@@ -12,16 +12,23 @@ check_column_exactinput <- function(check_table, validity_table) {
 
   if (any(is.na(columns_with_syntax))) {
     result <- FALSE
-    message <- paste0("Warning: Checked for exact input, but no entry with '", paste0(xafty_data_types, collapse = ", "),
-                      "' in validity table!")
+    message <- paste0(
+      "Warning: Checked for exact input, but no entry with '", paste0(xafty_data_types, collapse = ", "),
+      "' in validity table!"
+    )
     columns <- NA
-    return(data.frame("Check" = "Column Classes", "Check_Result" = result, "Message" = message, "columns" = columns))
+
+    if (simply) {
+      return(result)
+    } else {
+      return(data.frame("Check" = "Column Classes", "Check_Result" = result, "Message" = message, "columns" = columns))
+    }
+
   }
 
   list_result <- list()
 
   for (i in seq(length(columns_with_syntax))) {
-
     syntax <- columns_with_syntax[i]
 
     exact_values <- obtain_values_in_validity(validity_table, xafty_pair = syntax)
@@ -31,43 +38,42 @@ check_column_exactinput <- function(check_table, validity_table) {
     # Account for NA.
     check_table_na_removed <- check_table[[syntax]][!is.na(check_table[[syntax]])]
 
-    switch (names(syntax),
-            "##!!strictexact" = list_result[[syntax]] <-  sum(check_table_na_removed %in% exact_values) == length(check_table_na_removed),
-            "##!!anyexact" = list_result[[syntax]] <- any(check_table_na_removed %in% exact_values),
-            "##!!eachexact" = list_result[[syntax]] <- all(exact_values %in% check_table_na_removed)
+    switch(names(syntax),
+      "##!!strictexact" = list_result[[syntax]] <- sum(check_table_na_removed %in% exact_values) == length(check_table_na_removed),
+      "##!!anyexact" = list_result[[syntax]] <- any(check_table_na_removed %in% exact_values),
+      "##!!eachexact" = list_result[[syntax]] <- all(exact_values %in% check_table_na_removed)
     )
-
   }
 
   results_unlisted <- unlist(list_result)
 
   check_result <- all(results_unlisted)
 
   if (check_result) {
-
     result <- TRUE
     message <- paste0("ALL GOOD!")
     columns <- NA
+  } else {
+    result <- FALSE
+    wrong_columns <- names(results_unlisted)[!results_unlisted]
+    wrong_columns_collapsed <- paste0(wrong_columns, collapse = ", ")
+    columns <- wrong_columns_collapsed
+    message <- paste0("Rule Broken: Column Exact Input. Following column's input differ from specification: ")
+  }
 
-    } else {
-
-     result <- FALSE
-     wrong_columns <- names(results_unlisted)[!results_unlisted]
-     wrong_columns_collapsed <- paste0(wrong_columns, collapse = ", ")
-     columns <- wrong_columns_collapsed
-     message <- paste0("Rule Broken: Column Exact Input. Following column's input differ from specification: ")
-
+  if (simply) {
+    return(result)
   }
 
   data.frame("Check" = "Column Exact Input", "Check_Result" = result, "Message" = message, "columns" = columns)
-
 }
 
 #' @title Check a Table for Pattern Value Rules
 #' @param check_table Data Frame. The table that will be checked against the specified rules in the validity table.
 #' @param validity_table Data Frame. A table that stores the rules by which the check table is compared to.
-check_column_patterninput <- function(check_table, validity_table) {
-
+#' @param simply Boolean. Changes the return value of the function to a single logical vector of length 1.
+#' @export
+check_column_patterninput <- function(check_table, validity_table, simply = FALSE) {
   xafty_syntax <- "##!!"
   possible_checks <- c("strictpattern", "rowpattern", "anypattern", "eachpattern")
   xafty_data_types <- paste0(xafty_syntax, possible_checks)
@@ -77,13 +83,16 @@ check_column_patterninput <- function(check_table, validity_table) {
   if (any(is.na(columns_with_syntax))) {
     result <- FALSE
     message <- paste0("Warning: Checked for pattern, but no entry with 'pattern rule' in validity table!")
-    return(data.frame("Check" = "Column Classes", "Check_Result" = result, "Message" = message))
+    if(simply) {
+      return(result)
+    } else {
+      return(data.frame("Check" = "Column Classes", "Check_Result" = result, "Message" = message))
+    }
   }
 
   list_result <- list()
 
   for (i in seq(length(columns_with_syntax))) {
-
     syntax <- columns_with_syntax[i]
 
     pattern_values <- obtain_values_in_validity(validity_table = validity_table, xafty_pair = syntax)
@@ -97,22 +106,21 @@ check_column_patterninput <- function(check_table, validity_table) {
     check_table_na_removed <- check_table[[syntax]][!is.na(check_table[[syntax]])]
 
     df_presence <- as.data.frame(sapply(pattern_values, \(col_name){
-         sapply(check_table_na_removed, \(values) {
-                 data.frame(col_name = values)
-               })
-         }))
+      sapply(check_table_na_removed, \(values) {
+        data.frame(col_name = values)
+      })
+    }))
 
     presence_vector <- sapply(colnames(df_presence), \(pattern) {
-        grepl(pattern, df_presence[[pattern]], fixed = TRUE)
+      grepl(pattern, df_presence[[pattern]], fixed = TRUE)
     })
 
-    switch (names(syntax),
-           "##!!strictpattern" = list_result[[syntax]] <-  all(presence_vector),
-           "##!!rowpattern" = list_result[[syntax]] <- all(apply(presence_vector, 1, \(row) any(row))),
-           "##!!anypattern" = list_result[[syntax]] <-  any(presence_vector),
-           "##!!eachpattern" = list_result[[syntax]] <- all(apply(presence_vector, 2, \(col) any(col)))
+    switch(names(syntax),
+      "##!!strictpattern" = list_result[[syntax]] <- all(presence_vector),
+      "##!!rowpattern" = list_result[[syntax]] <- all(apply(presence_vector, 1, \(row) any(row))),
+      "##!!anypattern" = list_result[[syntax]] <- any(presence_vector),
+      "##!!eachpattern" = list_result[[syntax]] <- all(apply(presence_vector, 2, \(col) any(col)))
     )
-
   }
 
   results_unlisted <- unlist(list_result)
@@ -121,17 +129,17 @@ check_column_patterninput <- function(check_table, validity_table) {
     result <- TRUE
     message <- paste0("ALL GOOD!")
     columns <- NA
+  } else {
+    result <- FALSE
+    wrong_columns <- names(results_unlisted)[!results_unlisted]
+    wrong_columns_collapsed <- paste0(wrong_columns, collapse = ", ")
+    columns <- wrong_columns_collapsed
+    message <- paste0("Rule Broken: Column Pattern Input. Following column's values do not contain the specified pattern: ")
+  }
 
-    } else {
-
-      result <- FALSE
-      wrong_columns <- names(results_unlisted)[!results_unlisted]
-      wrong_columns_collapsed <- paste0(wrong_columns, collapse = ", ")
-      columns <- wrong_columns_collapsed
-      message <- paste0("Rule Broken: Column Pattern Input. Following column's values do not contain the specified pattern: ")
-
+  if(simply) {
+    return(result)
   }
 
   data.frame("Check" = "Column Pattern", "Check_Result" = result, "Message" = message, "columns" = columns)
-
 }

R/check_column_names.R

@@ -1,4 +1,3 @@
-
 #' @title Check for Column Names
 #'
 #' @description
@@ -16,44 +15,34 @@
 #' @return A data.frame if simply is FALSE and a Boolean of length 1 if simply is TRUE
 #' @export
 check_column_names <- function(check_table, validity_table, check_type = "presence", simply = FALSE) {
-
   colnames_check_table <- colnames(check_table)
   colnames_validity_table <- colnames(validity_table)
 
   logical_vector_no_order <- colnames_validity_table %in% colnames_check_table
 
   all_present <- all(logical_vector_no_order)
 
-  if(!all_present) {
-
+  if (!all_present) {
     if (simply) {
-
       return(FALSE)
-
     } else {
-
       missing_column_names <- colnames_validity_table[!logical_vector_no_order]
       missing_column_names <- paste(missing_column_names, collapse = ", ")
-      result <-  FALSE
+      result <- FALSE
       message <- paste("Rule Broken: Column names. Following columns are missing:")
       columns <- missing_column_names
 
       return(data.frame("Check" = "Column Names", "Check_Result" = result, "Message" = message, "Columns" = columns))
-
     }
   }
 
   if (check_type == "presence") {
-
-      result <-  TRUE
-      message <- paste("ALL GOOD!")
-      columns <- NA
-
-
+    result <- TRUE
+    message <- paste("ALL GOOD!")
+    columns <- NA
   }
 
-  if(check_type == "order") {
-
+  if (check_type == "order") {
     first_column <- colnames_validity_table[1]
     last_column <- colnames_validity_table[length(colnames_validity_table)]
 
@@ -65,31 +54,19 @@ check_column_names <- function(check_table, validity_table, check_type = "presen
     result_order <- all(suppressWarnings(colnames_validity_table == check_columns_between))
 
     if (result_order) {
-
-      result <-  TRUE
+      result <- TRUE
       message <- "ALL GOOD!"
       columns <- NA
-
     } else {
-
-      result <-  FALSE
+      result <- FALSE
       message <- "All columns are present but not in the specified order"
       columns <- NA
-
     }
-
   }
 
   if (simply) {
-
     return(result)
-
   } else {
-
     return(data.frame("Check" = "Column Names", "Check_Result" = result, "Message" = message, "Columns" = columns))
-
   }
-
-
-
 }