From 5b874d568c00961f2ba7e3b31233faa74d698fbb Mon Sep 17 00:00:00 2001 From: The Rational Optimist Date: Sun, 5 Nov 2023 13:58:17 +0100 Subject: [PATCH] Added simpliy parameter to every test and added tests for said parameter --- NAMESPACE | 2 + R/check_column_empty.R | 30 +-- R/check_column_input.R | 100 ++++---- R/check_column_names.R | 39 +-- R/check_column_number.R | 27 +- R/check_column_types.R | 54 ++-- R/check_special_rules.R | 3 - R/filter_column_empty.R | 5 +- R/filter_column_input.R | 45 ++-- R/filter_column_type.R | 15 +- R/main_check_validity.R | 28 +-- R/utils.R | 234 +++++++----------- R/xafty_rules.R | 126 +++++----- man/check_column_exactinput.Rd | 4 +- man/check_column_patterninput.Rd | 4 +- man/check_column_types.Rd | 4 +- tests/testthat/test-build_xafty_list.R | 18 +- tests/testthat/test-check_column_exactinput.R | 146 ++++++----- tests/testthat/test-check_column_names.R | 83 ++++--- tests/testthat/test-check_column_notempty.R | 26 +- tests/testthat/test-check_column_number.R | 48 ++-- .../testthat/test-check_column_patterninput.R | 117 +++++---- tests/testthat/test-check_column_types.R | 196 ++++++++++----- tests/testthat/test-check_date_conversions.R | 16 +- tests/testthat/test-check_validity.R | 22 +- .../testthat/test-filter_column_exactinput.R | 90 +++---- .../test-filter_column_patterninput.R | 100 ++++---- tests/testthat/test-filter_column_type.R | 165 ++++++------ .../test-obtain_columns_in_validity.R | 53 ++-- .../testthat/test-obtain_values_in_validity.R | 44 ++-- 30 files changed, 963 insertions(+), 881 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e96a36a..c3d70ed 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/check_column_empty.R b/R/check_column_empty.R index f073b6c..3d746cb 100644 --- a/R/check_column_empty.R +++ b/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,22 +14,17 @@ 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 @@ -39,27 +32,20 @@ check_column_notempty <- function(check_table, validity_table, simply = FALSE) { 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) } diff --git a/R/check_column_input.R b/R/check_column_input.R index 0642ea5..b47a47f 100644 --- a/R/check_column_input.R +++ b/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,12 +38,11 @@ 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) @@ -44,30 +50,30 @@ check_column_exactinput <- function(check_table, validity_table) { 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) - } diff --git a/R/check_column_names.R b/R/check_column_names.R index 6baa9e2..1539fe3 100644 --- a/R/check_column_names.R +++ b/R/check_column_names.R @@ -1,4 +1,3 @@ - #' @title Check for Column Names #' #' @description @@ -16,7 +15,6 @@ #' @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) @@ -24,36 +22,27 @@ check_column_names <- function(check_table, validity_table, check_type = "presen 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)) - } - - - } diff --git a/R/check_column_number.R b/R/check_column_number.R index 3e7024d..0a5c9d9 100644 --- a/R/check_column_number.R +++ b/R/check_column_number.R @@ -1,4 +1,3 @@ - #' @title Check for Correct Number of Columns #' @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. @@ -12,39 +11,29 @@ #' @return A data.frame if simply is FALSE and a Boolean of length 1 if simply is TRUE #' @export check_column_number <- function(check_table, validity_table, check_type = "equal", simply = FALSE) { - n_cols_check_table <- ncol(check_table) n_cols_validity_table <- ncol(validity_table) - if(check_type == "larger") { - + if (check_type == "larger") { result <- n_cols_check_table >= n_cols_validity_table message_appended <- "Table must have at least" - } else { - result <- n_cols_check_table == n_cols_validity_table message_appended <- "Table must have exactly" - } - if(simply) { - + if (simply) { return(result) - } else if (result) { - - message <- paste("ALL GOOD!") - + message <- paste("ALL GOOD!") } else { - - message <- paste("Rule Broken: Wrong number of columns!", message_appended, n_cols_validity_table, "column(s) but has", - n_cols_check_table, "columns.", sep = " ") - - } + message <- paste("Rule Broken: Wrong number of columns!", message_appended, n_cols_validity_table, "column(s) but has", + n_cols_check_table, "columns.", + sep = " " + ) + } data.frame("Check" = "Column Number", "Check_Result" = result, "Message" = message, "Columns" = NA) - } diff --git a/R/check_column_types.R b/R/check_column_types.R index f9fac1b..58cbf02 100644 --- a/R/check_column_types.R +++ b/R/check_column_types.R @@ -1,10 +1,10 @@ - #' @title Check Column Classes #' #' @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_types <- function(check_table, validity_table) { +check_column_types <- function(check_table, validity_table, simply = FALSE) { xafty_syntax <- "##!!" possible_classes <- c("text", "date", "number", "factor", "datetime") @@ -13,34 +13,27 @@ check_column_types <- function(check_table, validity_table) { list_result <- list() for (i in col_names_check_table) { - if (i %in% colnames(validity_table)) { - values_column <- validity_table[, i] - logical_data_type <- xafty_data_types %in% values_column + logical_data_type <- xafty_data_types %in% values_column xafty_data_type <- xafty_data_types[logical_data_type] - list_result[[i]] <- switch ( - xafty_data_type, + list_result[[i]] <- switch(xafty_data_type, "##!!text" = is.character(check_table[[i]]), "##!!date" = inherits(check_table[[i]], "Date"), "##!!number" = is.numeric(check_table[[i]]), "##!!factor" = is.factor(check_table[[i]]), "##!!datetime" = inherits(check_table[[i]], "POSIXct") - ) - + ) } - } result_unlisted <- unlist(list_result) if (all(result_unlisted)) { - result <- TRUE message <- paste0("ALL GOOD!") columns <- NA - } else { # TODO: Add expected data type result <- FALSE @@ -50,8 +43,11 @@ check_column_types <- function(check_table, validity_table) { message <- paste0("Rule Broken: Column Types. Following columns have the wrong data type: ") } - data.frame("Check" = "Column Types", "Check_Result" = result, "Message" = message, "Columns" = columns) + if (simply) { + return(result) + } + data.frame("Check" = "Column Types", "Check_Result" = result, "Message" = message, "Columns" = columns) } #' @title Align Column Classes with Validity Table @@ -67,39 +63,33 @@ check_column_types <- function(check_table, validity_table) { #' @param tz Timezone for the POSIXct values. Default is UTC #' @export align_column_types <- function(check_table, validity_table, - date_origin = "1899-12-30", - tryFormats = c("%d.%m.%Y", "%d/%m/%Y", "%Y-%m-%d", "%Y/%m/%d"), - tz = "") { - + date_origin = "1899-12-30", + tryFormats = c("%d.%m.%Y", "%d/%m/%Y", "%Y-%m-%d", "%Y/%m/%d"), + tz = "") { xafty_syntax <- "##!!" possible_classes <- c("text", "date", "number", "factor", "datetime") xafty_data_types <- paste0(xafty_syntax, possible_classes) for (i in colnames(check_table)) { - if (i %in% colnames(validity_table)) { - values_column <- validity_table[, i] - logical_data_type <- xafty_data_types %in% values_column + logical_data_type <- xafty_data_types %in% values_column - if (sum(logical_data_type, na.rm = TRUE) > 1) stop(paste0("Validity column '", i, "' has more than one data type")) + if (sum(logical_data_type, na.rm = TRUE) > 1) stop(paste0("Validity column '", i, "' has more than one data type")) xafty_data_type <- xafty_data_types[logical_data_type] - switch (xafty_data_type, - "##!!text" = check_table[, i] <- as.character(check_table[[i]]), - "##!!date" = check_table[, i] <- as.Date_xafty(check_table[[i]], - date_origin = date_origin, tryFormats = tryFormats), - "##!!number" = check_table[, i] <- as.numeric(check_table[[i]]), - "##!!factor" = check_table[, i] <- as.factor(check_table[[i]]), - "##!!datetime" = check_table[, i] <- as.POSIXct_xafty(check_table[[i]], tz = tz) + switch(xafty_data_type, + "##!!text" = check_table[, i] <- as.character(check_table[[i]]), + "##!!date" = check_table[, i] <- as.Date_xafty(check_table[[i]], + date_origin = date_origin, tryFormats = tryFormats + ), + "##!!number" = check_table[, i] <- as.numeric(check_table[[i]]), + "##!!factor" = check_table[, i] <- as.factor(check_table[[i]]), + "##!!datetime" = check_table[, i] <- as.POSIXct_xafty(check_table[[i]], tz = tz) ) - } - } check_table - } - diff --git a/R/check_special_rules.R b/R/check_special_rules.R index a52a52e..5518bdc 100644 --- a/R/check_special_rules.R +++ b/R/check_special_rules.R @@ -1,7 +1,5 @@ - # TODO: The values in a column with the unique rule should only have one representation each; like a primary key! check_columns_unique <- function(check_table, validity_table) { - xafty_syntax <- "##!!unique" columns <- obtain_columns_in_validity(validity_table, xafty_syntax = xafty_syntax) @@ -13,5 +11,4 @@ check_columns_unique <- function(check_table, validity_table) { } - } diff --git a/R/filter_column_empty.R b/R/filter_column_empty.R index 29b93c4..06c3c7a 100644 --- a/R/filter_column_empty.R +++ b/R/filter_column_empty.R @@ -1,4 +1,3 @@ - #' @title Filter Values in Column That are NA #' @param check_table Data Frame. The table that will be checked against the specified rules in the validity table. #' @param filter_column Character. The column which will be checked. The column must be present in both the check table @@ -6,15 +5,13 @@ #' @return A logical vector. #' @export filter_column_empty <- function(check_table, filter_column) { - stopifnot(length(filter_column) == 1 & is.character(filter_column)) - if(!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") + if (!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") xafty_data_types <- "##!!notempty" check_column <- check_table[, filter_column, drop = TRUE] is.na(check_column) - } diff --git a/R/filter_column_input.R b/R/filter_column_input.R index 162b7a4..f0dc423 100644 --- a/R/filter_column_input.R +++ b/R/filter_column_input.R @@ -1,4 +1,3 @@ - #' @title Filter Values in Column That Don't Break Pattern Input Rule #' @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. @@ -6,11 +5,10 @@ #' as well as the validity table #' @export filter_column_patterninput <- function(check_table, validity_table, filter_column) { - stopifnot(length(filter_column) == 1 & is.character(filter_column)) - if(!(filter_column %in% colnames(validity_table))) stop("Column is not present in validity table") - if(!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") + if (!(filter_column %in% colnames(validity_table))) stop("Column is not present in validity table") + if (!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") xafty_syntax <- "##!!" possible_checks <- c("strictpattern", "rowpattern", "anypattern", "eachpattern") @@ -18,7 +16,9 @@ filter_column_patterninput <- function(check_table, validity_table, filter_colum check_column <- as.character(check_table[, filter_column, drop = TRUE]) - if (all(is.na(check_column))) return(rep(FALSE, length(check_column))) + if (all(is.na(check_column))) { + return(rep(FALSE, length(check_column))) + } validity_column <- validity_table[, filter_column, drop = FALSE] @@ -27,16 +27,14 @@ filter_column_patterninput <- function(check_table, validity_table, filter_colum xafty_pairs <- obtain_columns_in_validity(validity_table = validity_column, xafty_syntax = xafty_data_types) # TODO: Sensible behavior with several rules in the same column needs to be implemented - if(length(xafty_pairs) > 1) stop("Several pattern rules in the same column are currently not supported") + if (length(xafty_pairs) > 1) stop("Several pattern rules in the same column are currently not supported") list_xafty_values <- list() for (i in seq(length(xafty_pairs))) { - xafty_pair <- xafty_pairs[i] list_xafty_values[[i]] <- obtain_values_in_validity(validity_table = validity_column, xafty_pair = xafty_pair) - } xafty_values <- do.call(c, list_xafty_values) @@ -55,22 +53,23 @@ filter_column_patterninput <- function(check_table, validity_table, filter_colum grepl(pattern, df_pattern_presence[[pattern]], fixed = TRUE) }) - switch (names(xafty_pair), - "##!!strictpattern" = position_broken_rule <- which((!apply(df_logical_presence, 1, \(row) all(row)))), - "##!!rowpattern" = position_broken_rule <- which(!(apply(df_logical_presence, 1, \(row) any(row)))), - "##!!anypattern" = position_broken_rule <- which(!(apply(df_logical_presence, 1, \(row) any(row)))), - "##!!eachpattern" = position_broken_rule <- which(!(apply(df_logical_presence, 1, \(row) any(row)))) + switch(names(xafty_pair), + "##!!strictpattern" = position_broken_rule <- which((!apply(df_logical_presence, 1, \(row) all(row)))), + "##!!rowpattern" = position_broken_rule <- which(!(apply(df_logical_presence, 1, \(row) any(row)))), + "##!!anypattern" = position_broken_rule <- which(!(apply(df_logical_presence, 1, \(row) any(row)))), + "##!!eachpattern" = position_broken_rule <- which(!(apply(df_logical_presence, 1, \(row) any(row)))) ) position_broken_rule <- setdiff(position_broken_rule, position_na) - if (length(position_broken_rule) <= 0) return(result_out) + if (length(position_broken_rule) <= 0) { + return(result_out) + } result_out[position_broken_rule] <- FALSE result_out - } #' @title Filter Values in Column That Don't Break Exact Input Rule @@ -80,18 +79,19 @@ filter_column_patterninput <- function(check_table, validity_table, filter_colum #' as well as the validity table #' @export filter_column_exactinput <- function(check_table, validity_table, filter_column) { - stopifnot(length(filter_column) == 1 & is.character(filter_column)) - if(!(filter_column %in% colnames(validity_table))) stop("Column is not present in validity table") - if(!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") + if (!(filter_column %in% colnames(validity_table))) stop("Column is not present in validity table") + if (!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") xafty_syntax <- "##!!" possible_checks <- c("anyexact", "strictexact", "eachexact") xafty_data_types <- paste0(xafty_syntax, possible_checks) check_column <- as.character(check_table[, filter_column, drop = TRUE]) - if (all(is.na(check_column))) return(rep(FALSE, length(check_column))) + if (all(is.na(check_column))) { + return(rep(FALSE, length(check_column))) + } validity_column <- validity_table[, filter_column, drop = FALSE] @@ -102,11 +102,9 @@ filter_column_exactinput <- function(check_table, validity_table, filter_column) list_xafty_values <- list() for (i in seq(length(xafty_pairs))) { - xafty_pair <- xafty_pairs[i] list_xafty_values[[i]] <- obtain_values_in_validity(validity_table = validity_column, xafty_pair = xafty_pair) - } xafty_values <- do.call(c, list_xafty_values) @@ -117,10 +115,11 @@ filter_column_exactinput <- function(check_table, validity_table, filter_column) position_broken_rule <- setdiff(position_broken_exact, position_na) - if (length(position_broken_rule) <= 0) return(result_out) + if (length(position_broken_rule) <= 0) { + return(result_out) + } result_out[position_broken_rule] <- FALSE result_out - } diff --git a/R/filter_column_type.R b/R/filter_column_type.R index 189bfd4..6e2bbb0 100644 --- a/R/filter_column_type.R +++ b/R/filter_column_type.R @@ -1,4 +1,3 @@ - #' @title Filter a Column by its Data Type given the Validity Table #' @param check_table Data Frame. The table that will be checked against the information in the validity table #' @param validity_table Data Frame. A table that stores the column names in the first row @@ -13,11 +12,10 @@ filter_column_type <- function(check_table, validity_table, filter_column, date_origin = "1899-12-30", tryFormats = c("%Y-%m-%d", "%d.%m.%Y", "%d/%m/%Y", "%Y/%m/%d"), tz = "") { - stopifnot(length(filter_column) == 1 & is.character(filter_column)) - if(!(filter_column %in% colnames(validity_table))) stop("Column is not present in validity table") - if(!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") + if (!(filter_column %in% colnames(validity_table))) stop("Column is not present in validity table") + if (!(filter_column %in% colnames(check_table))) stop("Column is not present in check table") xafty_syntax <- "##!!" possible_classes <- c("text", "date", "number", "factor", "datetime") @@ -28,15 +26,16 @@ filter_column_type <- function(check_table, validity_table, filter_column, xafty_data_type <- names(obtain_columns_in_validity(validity_table = validity_column, xafty_syntax = xafty_data_types)) - switch (xafty_data_type, + switch(xafty_data_type, "##!!factor" = xafty_column <- sapply(check_column, \(x) is.factor(x), USE.NAMES = FALSE), "##!!text" = xafty_column <- sapply(check_column, \(x) is.character(x), USE.NAMES = FALSE), - "##!!date" = xafty_column <- is.Date_xafty(check_column, date_origin = date_origin, - tryFormats = tryFormats), + "##!!date" = xafty_column <- is.Date_xafty(check_column, + date_origin = date_origin, + tryFormats = tryFormats + ), "##!!number" = xafty_column <- is.numeric_xafty(check_column), "##!!datetime" = xafty_column <- is.POSIXct_xafty(check_column, tz = tz) ) xafty_column - } diff --git a/R/main_check_validity.R b/R/main_check_validity.R index fd69b00..8c5efdc 100644 --- a/R/main_check_validity.R +++ b/R/main_check_validity.R @@ -1,4 +1,3 @@ - #' @title Main Function to Check a Table for its Validity #' #' @description @@ -41,40 +40,39 @@ check_validity <- function(check_table, validity_table, column_number = "equal", column_names = "presence", - column_types = TRUE, + column_types = TRUE, values_notempty = TRUE, - values_exact = TRUE, - values_pattern = TRUE) { - + values_exact = TRUE, + values_pattern = TRUE) { df_result_out <- create_result_table() - if(!isFALSE(column_number)) { + if (!isFALSE(column_number)) { df_result_out[df_result_out$Check == "Column Number", ] <- check_column_number(check_table, validity_table, - check_type = column_number) + check_type = column_number + ) } - if(!isFALSE(column_names)) { + if (!isFALSE(column_names)) { df_result_out[df_result_out$Check == "Column Names", ] <- check_column_names(check_table, validity_table, - check_type = column_names) + check_type = column_names + ) } - if(column_types) { + if (column_types) { df_result_out[df_result_out$Check == "Column Types", ] <- check_column_types(check_table, validity_table) } - if(values_notempty) { + if (values_notempty) { df_result_out[df_result_out$Check == "Values Notempty", ] <- check_column_notempty(check_table, validity_table) } - if(values_exact) { + if (values_exact) { df_result_out[df_result_out$Check == "Values Exact", ] <- check_column_exactinput(check_table, validity_table) } - if(values_pattern) { + if (values_pattern) { df_result_out[df_result_out$Check == "Values Pattern", ] <- check_column_patterninput(check_table, validity_table) - } df_result_out - } diff --git a/R/utils.R b/R/utils.R index 126cf96..3b8caf7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,4 +1,3 @@ - #' @title Reads in Example Data for Test Purposes #' #' @param path_check Path to the table that will be checked @@ -8,41 +7,36 @@ #' @importFrom readxl read_xlsx #' @importFrom utils read.csv read.csv2 read_example_data <- function(path_check = "inst/extdata/example_data.xlsx", - path_validity = "inst/extdata/example_validity.csv", file_ending = "xlsx") { - + path_validity = "inst/extdata/example_validity.csv", file_ending = "xlsx") { validity_table <- utils::read.csv(path_validity, na.strings = "") check_table <- switch(file_ending, - "xlsx" = readxl::read_xlsx(path_check, col_types = "text"), - "csv_comma" = read.csv(path_check, colClasses = "character"), - "csv_semicolon" = read.csv2(path_check, colClasses = "character") + "xlsx" = readxl::read_xlsx(path_check, col_types = "text"), + "csv_comma" = read.csv(path_check, colClasses = "character"), + "csv_semicolon" = read.csv2(path_check, colClasses = "character") ) list( validity_table = validity_table, check_table = check_table ) - } #' @title Test Core Function of check_validity() test_main_functions <- function() { - data <- read_example_data() data_check_aligned <- align_column_types(data$check_table, data$validity_table) check_validity(data_check_aligned, data$validity_table) - } #' @title Template of Result Data Frame for check_validity() create_result_table <- function() { - arg_names <- names(formals(check_validity))[!(names(formals(check_validity)) %in% c("check_table", "validity_table"))] list_out <- list() - for(arg_name in arg_names) { + for (arg_name in arg_names) { # Create the result variable name result_var_name <- paste0("result_", arg_name) @@ -58,7 +52,6 @@ create_result_table <- function() { rownames(df_result_out) <- NULL df_result_out - } @@ -79,7 +72,6 @@ create_result_row <- function(check_name, default_result = TRUE, default_message #' @return Returns a named vector that has the column name as value and the rule as the name. This named vector is also #' referred to as "xafty pair". obtain_columns_in_validity <- function(validity_table, xafty_syntax) { - # If the number of rows of validity table are exactly 1 the behavior of the function is incorrect since sapply # creates a logical vector instead of a logical matrix if the validity table has only one row # Hope this doesn't introduce unforeseen consequences! :) @@ -90,68 +82,62 @@ obtain_columns_in_validity <- function(validity_table, xafty_syntax) { }, simplify = FALSE) presence_list <- lapply(presence_list, \(item){ - presence_table <- as.data.frame(item) - sapply(presence_table, any) + presence_table <- as.data.frame(item) + sapply(presence_table, any) }) list_out <- list() for (i in seq(length(xafty_syntax))) { - syntax <- xafty_syntax[i] presence_vector <- presence_list[[syntax]] presence_columns <- names(presence_vector)[presence_vector] list_out[[i]] <- stats::setNames(object = presence_columns, rep(syntax, length(presence_columns))) - } - result <- do.call(c, list_out) - - result <- result[!is.na(result)] + result <- do.call(c, list_out) - if(length(result) <= 0) { + result <- result[!is.na(result)] - result <- NA - warning("No matching xafty_syntax in validity table. Returning NA") - - } - - result + if (length(result) <= 0) { + result <- NA + warning("No matching xafty_syntax in validity table. Returning NA") + } + result } #' @title Get Corresponding Values for Xafty Rules #' @param validity_table A validity table that will be checked for xafty rules #' @param xafty_pair A named vector of length 1 that is named with the xafty rule and has the value of a column name obtain_values_in_validity <- function(validity_table, xafty_pair) { + xafty_rule <- names(xafty_pair) + values_column <- validity_table[, xafty_pair] + rule_position <- which(values_column == xafty_rule) - xafty_rule <- names(xafty_pair) - values_column <- validity_table[, xafty_pair] - rule_position <- which(values_column == xafty_rule) - - values_below_rule <- values_column[seq(rule_position + 1, length(values_column))] - - if(any(grepl("##!!", values_below_rule))) { - - first_xafty_syntax <- min(which(grepl("##!!", values_below_rule))) - position_minus <- first_xafty_syntax - 1 + values_below_rule <- values_column[seq(rule_position + 1, length(values_column))] - if (position_minus <= 0) return(character(0)) + if (any(grepl("##!!", values_below_rule))) { + first_xafty_syntax <- min(which(grepl("##!!", values_below_rule))) + position_minus <- first_xafty_syntax - 1 - values_between <- values_below_rule[seq(position_minus)] - values_return <- values_between[!is.na(values_between)] - - if(length(values_return) <= 0) return(character(0)) - - } else { + if (position_minus <= 0) { + return(character(0)) + } - values_return <- values_below_rule[!is.na(values_below_rule)] + values_between <- values_below_rule[seq(position_minus)] + values_return <- values_between[!is.na(values_between)] + if (length(values_return) <= 0) { + return(character(0)) } + } else { + values_return <- values_below_rule[!is.na(values_below_rule)] + } - values_return + values_return } @@ -159,9 +145,7 @@ obtain_values_in_validity <- function(validity_table, xafty_pair) { #' @param column_string Column names as a single string that have been separated by ", " #' @return The column names in a vector obtain_invalid_columns <- function(column_string) { - strsplit(column_string, split = ", ")[[1]] - } #' @title Check if Passed Values can be Parsed as Date @@ -170,30 +154,28 @@ obtain_invalid_columns <- function(column_string) { #' @param tryFormats Character vector. Date formats that should be use to try to convert to date #' @return An equally length boolean vector whether the value can be parsed as a Date given the specified formats and origin is.Date_xafty <- function(dates, date_origin = "1899-12-30", tryFormats = c("%Y-%m-%d", "%d.%m.%Y", "%d/%m/%Y", "%Y/%m/%d")) { - - xafty_column <- sapply(dates, \(date) { - - tryCatch({ + xafty_column <- sapply(dates, \(date) { + tryCatch( + { as.Date(date, tryFormats = tryFormats) TRUE - }, - error = function(e) { + }, + error = function(e) { + numeric_date <- suppressWarnings(as.numeric(date)) + if (is.na(numeric_date)) { + return(FALSE) + } + as.Date(numeric_date, origin = date_origin) - numeric_date <- suppressWarnings(as.numeric(date)) - if(is.na(numeric_date)) return(FALSE) - as.Date(numeric_date, origin = date_origin) - - TRUE - } - ) - } - ) - - names(xafty_column) <- NULL + TRUE + } + ) + }) - xafty_column + names(xafty_column) <- NULL + xafty_column } #' @title Convert Values to Date Types @@ -202,37 +184,31 @@ is.Date_xafty <- function(dates, date_origin = "1899-12-30", tryFormats = c("%Y- #' @param tryFormats Character vector. Date formats that should be use to try to convert to date #' @return An equally length date vector, \code{NA} when the value could not be converted to date as.Date_xafty <- function(dates, date_origin = "1899-12-30", tryFormats = c("%Y-%m-%d", "%d.%m.%Y", "%d/%m/%Y", "%Y/%m/%d")) { - - xafty_column <- sapply(dates, \(date) { - - tryCatch({ - - as.Date(date, tryFormats = tryFormats) - - }, - error = function(e) { - - numeric_date <- suppressWarnings(as.numeric(date)) - if(is.na(numeric_date)) return(NA) - - as.Date(numeric_date, origin = date_origin) - + xafty_column <- sapply(dates, \(date) { + tryCatch( + { + as.Date(date, tryFormats = tryFormats) + }, + error = function(e) { + numeric_date <- suppressWarnings(as.numeric(date)) + if (is.na(numeric_date)) { + return(NA) + } + + as.Date(numeric_date, origin = date_origin) } ) - } - ) + }) names(xafty_column) <- NULL as.Date(xafty_column) - } #' @title Check if Passed Values can be Parsed as Numeric #' @param numbers Character vector of Numbers to be Parsed #' @return An equally length Boolean vector whether the values can be parsed as numbers is.numeric_xafty <- function(numbers) { - xafty_column <- rep(TRUE, length(numbers)) position_na <- which(is.na(numbers)) @@ -243,7 +219,6 @@ is.numeric_xafty <- function(numbers) { xafty_column[position_not_numbers] <- FALSE xafty_column - } #' @title Check if Passed Values can be Parsed as POSIXct @@ -251,55 +226,45 @@ is.numeric_xafty <- function(numbers) { #' @param tz Timezone for the POSIXct values. Default is UTC #' @return An equally length Boolean vector whether the values can be parsed as POSIXct is.POSIXct_xafty <- function(datetimes, tz = "") { - xafty_column <- sapply(datetimes, \(datetime) { + tryCatch( + { + as.POSIXct(datetime, tz = tz) - tryCatch({ - as.POSIXct(datetime, tz = tz) - - TRUE - - }, error = function(e){ - - FALSE - - }) - } - ) + TRUE + }, + error = function(e) { + FALSE + } + ) + }) names(xafty_column) <- NULL xafty_column - } #' @title Convert Passed Values to POSIXct #' @param datetimes Character vector of date time values to be parsed #' @param tz Timezone for the POSIXct values. Default is UTC as.POSIXct_xafty <- function(datetimes, tz = "") { - xafty_column <- sapply(datetimes, \(datetime) { - - tryCatch({ - - as.POSIXct(datetime, tz = tz) - - }, error = function(e){ - - NA - - }) - } - ) + tryCatch( + { + as.POSIXct(datetime, tz = tz) + }, + error = function(e) { + NA + } + ) + }) names(xafty_column) <- NULL as.POSIXct(xafty_column) - } build_xafty_list <- function(check_table, validity_table, xafty_rules_table) { - colnames_validity <- colnames(validity_table) n_col <- length(colnames_validity) @@ -310,9 +275,8 @@ build_xafty_list <- function(check_table, validity_table, xafty_rules_table) { base_column_list <- list() for (col in colnames_validity) { - # TODO: What should happens when a column in the validity table is not present in the check table? - if(!(col %in% colnames(check_table))) { + if (!(col %in% colnames(check_table))) { warning(paste(col, "is not present in check_table")) next } @@ -326,7 +290,6 @@ build_xafty_list <- function(check_table, validity_table, xafty_rules_table) { single_col_validity_table <- validity_table[, col, drop = FALSE] for (i in seq(n_xafty_rules_col)) { - single_rule <- xafty_rules_col[i] single_xafty_pair <- xafty_pairs[names(xafty_pairs) == single_rule & xafty_pairs == col] @@ -336,38 +299,35 @@ build_xafty_list <- function(check_table, validity_table, xafty_rules_table) { xafty_values <- NULL if (xafty_type == "value") { - xafty_values <- obtain_values_in_validity(validity_table = validity_table, - xafty_pair = single_xafty_pair) + xafty_values <- obtain_values_in_validity( + validity_table = validity_table, + xafty_pair = single_xafty_pair + ) } test_result <- xafty_check_function[[1]](check_table = single_col_check_table, - validity_table = single_col_validity_table)$Check_Result + validity_table = single_col_validity_table)$Check_Result base_column_list[[col]][[single_rule]] <- list( - rule = single_rule, - values = xafty_values, - test_result = test_result, - check_function = xafty_check_function, - filter_function = NULL) - + rule = single_rule, + values = xafty_values, + test_result = test_result, + check_function = xafty_check_function, + filter_function = NULL + ) } - } base_column_list - - } build_xafty_test_table <- function(xafty_list) { - colnames <- names(xafty_list) n_colnames <- length(colnames) list_tmp <- list() for (i in seq(n_colnames)) { - col <- colnames[i] n_xafty_rules <- length(xafty_list[[col]]) @@ -375,15 +335,14 @@ build_xafty_test_table <- function(xafty_list) { array_tmp <- array(dim = c(n_xafty_rules, 2), dimnames = list(NULL, c("rule", "test_result"))) for (j in seq(n_xafty_rules)) { - array_tmp[j, "rule"] <- xafty_list[[col]][[j]]$rule array_tmp[j, "test_result"] <- xafty_list[[col]][[j]]$test_result - } - list_tmp[[i]] <- data.frame("column" = rep(col, n_xafty_rules), "rule" = array_tmp[, "rule"], - "test_result" = as.logical(array_tmp[, "test_result"])) - + list_tmp[[i]] <- data.frame( + "column" = rep(col, n_xafty_rules), "rule" = array_tmp[, "rule"], + "test_result" = as.logical(array_tmp[, "test_result"]) + ) } df <- do.call(rbind, list_tmp) @@ -391,5 +350,4 @@ build_xafty_test_table <- function(xafty_list) { row.names(df) <- NULL df - } diff --git a/R/xafty_rules.R b/R/xafty_rules.R index c734140..1e2b8e4 100644 --- a/R/xafty_rules.R +++ b/R/xafty_rules.R @@ -1,4 +1,3 @@ - #' Table of All Xafty Rules #' #' A simple table containing the xafty rules, their type and a description (soon) @@ -13,65 +12,68 @@ #' #' @source The data is curated by xafty developers and grows as new rules are added. xafty_rules_table <- data.frame( - - "syntax" = c("##!!notempty", - "##!!anyexact", - "##!!strictexact", - "##!!eachexact", - "##!!text", - "##!!date", - "##!!number", - "##!!factor", - "##!!datetime", - "##!!strictpattern", - "##!!rowpattern", - "##!!anypattern", - "##!!eachpattern", - "##!!unique"), - - "type" = c("value", - "value", - "value", - "value", - "data_type", - "data_type", - "data_type", - "data_type", - "data_type", - "value", - "value", - "value", - "value", - "special"), - - "description" = c("The column cannot have empty values.", - "At least one value in the check table must match any of the provided values in the validity table", - "All values in the check table must match the provided values in the validity table", - "All provided values in the validity table must be matched at least once in the check table", - "Column must be of data type character", - "Column must be of data type Date", - "Column must be of data type numeric", - "Column must be of data type factor", - "Column must be of data type POSIXct", - "All values in the column must match to every pattern provided in the validity table", - "All values of the column must match at least to one pattern in the validity table", - "At least one value in the column must match to any pattern provided in the validity table", - "Every pattern provided in the validity table must match at least once to any value in the check table", - "No value in the column should be present more than once"), - - "check_function" = I(list(check_column_notempty, - check_column_exactinput, - check_column_exactinput, - check_column_exactinput, - check_column_types, - check_column_types, - check_column_types, - check_column_types, - check_column_types, - check_column_patterninput, - check_column_patterninput, - check_column_patterninput, - check_column_patterninput, - check_columns_unique)) - + "syntax" = c( + "##!!notempty", + "##!!anyexact", + "##!!strictexact", + "##!!eachexact", + "##!!text", + "##!!date", + "##!!number", + "##!!factor", + "##!!datetime", + "##!!strictpattern", + "##!!rowpattern", + "##!!anypattern", + "##!!eachpattern", + "##!!unique" + ), + "type" = c( + "value", + "value", + "value", + "value", + "data_type", + "data_type", + "data_type", + "data_type", + "data_type", + "value", + "value", + "value", + "value", + "special" + ), + "description" = c( + "The column cannot have empty values.", + "At least one value in the check table must match any of the provided values in the validity table", + "All values in the check table must match the provided values in the validity table", + "All provided values in the validity table must be matched at least once in the check table", + "Column must be of data type character", + "Column must be of data type Date", + "Column must be of data type numeric", + "Column must be of data type factor", + "Column must be of data type POSIXct", + "All values in the column must match to every pattern provided in the validity table", + "All values of the column must match at least to one pattern in the validity table", + "At least one value in the column must match to any pattern provided in the validity table", + "Every pattern provided in the validity table must match at least once to any value in the check table", + "No value in the column should be present more than once" + ), + "check_function" = I(list( + check_column_notempty, + check_column_exactinput, + check_column_exactinput, + check_column_exactinput, + check_column_types, + check_column_types, + check_column_types, + check_column_types, + check_column_types, + check_column_patterninput, + check_column_patterninput, + check_column_patterninput, + check_column_patterninput, + check_columns_unique + )) ) diff --git a/man/check_column_exactinput.Rd b/man/check_column_exactinput.Rd index 040b6fa..36f3d3f 100644 --- a/man/check_column_exactinput.Rd +++ b/man/check_column_exactinput.Rd @@ -4,12 +4,14 @@ \alias{check_column_exactinput} \title{Check a Table for Exact Value Rules} \usage{ -check_column_exactinput(check_table, validity_table) +check_column_exactinput(check_table, validity_table, simply = FALSE) } \arguments{ \item{check_table}{Data Frame. The table that will be checked against the specified rules in the validity table.} \item{validity_table}{Data Frame. A table that stores the rules by which the check table is compared to.} + +\item{simply}{Boolean. Changes the return value of the function to a single logical vector of length 1.} } \description{ Check a Table for Exact Value Rules diff --git a/man/check_column_patterninput.Rd b/man/check_column_patterninput.Rd index 6f3c25f..287c1e8 100644 --- a/man/check_column_patterninput.Rd +++ b/man/check_column_patterninput.Rd @@ -4,12 +4,14 @@ \alias{check_column_patterninput} \title{Check a Table for Pattern Value Rules} \usage{ -check_column_patterninput(check_table, validity_table) +check_column_patterninput(check_table, validity_table, simply = FALSE) } \arguments{ \item{check_table}{Data Frame. The table that will be checked against the specified rules in the validity table.} \item{validity_table}{Data Frame. A table that stores the rules by which the check table is compared to.} + +\item{simply}{Boolean. Changes the return value of the function to a single logical vector of length 1.} } \description{ Check a Table for Pattern Value Rules diff --git a/man/check_column_types.Rd b/man/check_column_types.Rd index 6ae6bf3..ee10ee4 100644 --- a/man/check_column_types.Rd +++ b/man/check_column_types.Rd @@ -4,12 +4,14 @@ \alias{check_column_types} \title{Check Column Classes} \usage{ -check_column_types(check_table, validity_table) +check_column_types(check_table, validity_table, simply = FALSE) } \arguments{ \item{check_table}{Data Frame. The table that will be checked against the specified rules in the validity table.} \item{validity_table}{Data Frame. A table that stores the rules by which the check table is compared to.} + +\item{simply}{Boolean. Changes the return value of the function to a single logical vector of length 1.} } \description{ Check Column Classes diff --git a/tests/testthat/test-build_xafty_list.R b/tests/testthat/test-build_xafty_list.R index a7390b8..3cd53b6 100644 --- a/tests/testthat/test-build_xafty_list.R +++ b/tests/testthat/test-build_xafty_list.R @@ -1,5 +1,4 @@ test_that("Xafty List shows all rules as true if all rules are fullfilled", { - check_table <- data.frame( "Product_Name" = c("Apple", "Banana", "Apple"), "Product_Weight" = c(2.1, 0.5, 1.0), @@ -25,11 +24,14 @@ test_that("Xafty List shows all rules as true if all rules are fullfilled", { summary_test_table <- build_xafty_test_table(xafty_list = xafty_list) expect_true(all(summary_test_table$test_result)) - expect_equal(summary_test_table$column, c("Product_Name", "Product_Name", "Product_Name", "Product_Weight", - "Expiration_Date", "Expiration_Date", "Delivery_Time", "Is_Delivered_By", - "Is_Delivered_By", "Is_Delivered_By", "Mail_Customer", "Mail_Customer")) - expect_equal(summary_test_table$rule, c("##!!notempty", "##!!eachexact", "##!!text", "##!!number", "##!!eachexact", - "##!!date", "##!!datetime", "##!!notempty", "##!!factor", "##!!rowpattern", - "##!!text", "##!!strictpattern")) - + expect_equal(summary_test_table$column, c( + "Product_Name", "Product_Name", "Product_Name", "Product_Weight", + "Expiration_Date", "Expiration_Date", "Delivery_Time", "Is_Delivered_By", + "Is_Delivered_By", "Is_Delivered_By", "Mail_Customer", "Mail_Customer" + )) + expect_equal(summary_test_table$rule, c( + "##!!notempty", "##!!eachexact", "##!!text", "##!!number", "##!!eachexact", + "##!!date", "##!!datetime", "##!!notempty", "##!!factor", "##!!rowpattern", + "##!!text", "##!!strictpattern" + )) }) diff --git a/tests/testthat/test-check_column_exactinput.R b/tests/testthat/test-check_column_exactinput.R index e0bb413..f0c5594 100644 --- a/tests/testthat/test-check_column_exactinput.R +++ b/tests/testthat/test-check_column_exactinput.R @@ -1,146 +1,176 @@ test_that("That 'strict exact' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "maybe")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "maybe") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) + check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table, simply = TRUE) + + expect_true(check_result) + }) test_that("That 'strict exact' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Has_Birthday") + check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table, simply = TRUE) + + expect_false(check_result) + }) test_that("That 'any exact' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!anyexact", "David", "Diana", "Thomas"), - "Has_Birthday" = c("##!!factor")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!anyexact", "David", "Diana", "Thomas"), + "Has_Birthday" = c("##!!factor") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) test_that("That 'any exact' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!anyexact", "Martin", "Dav"), - "Has_Birthday" = c("##!!factor")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!anyexact", "Martin", "Dav"), + "Has_Birthday" = c("##!!factor") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Name") - }) test_that("That 'each exact' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel", "Thomas")), + "Has_Birthday" = factor(c("no", "yes", "no", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel", "Thomas")), - "Has_Birthday" = factor(c("no", "yes", "no", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!eachexact", "David", "Diana"), - "Has_Birthday" = c("##!!factor")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!eachexact", "David", "Diana"), + "Has_Birthday" = c("##!!factor") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) test_that("That 'each exact' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel", "Thomas")), + "Has_Birthday" = factor(c("no", "yes", "no", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel", "Thomas")), - "Has_Birthday" = factor(c("no", "yes", "no", "no"))) - - validity_table <- data.frame("Name" = c("##!!text"), - "Has_Birthday" = c("##!!factor", "##!!eachexact", "yes", "no", "maybe")) + validity_table <- data.frame( + "Name" = c("##!!text"), + "Has_Birthday" = c("##!!factor", "##!!eachexact", "yes", "no", "maybe") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Has_Birthday") - }) test_that("A combination of strict input rules works", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel", "Thomas")), + "Has_Birthday" = factor(c("no", "yes", "no", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel", "Thomas")), - "Has_Birthday" = factor(c("no", "yes", "no", "no"))) - - validity_table <- data.frame("Name" = c("##!!text"), - "Has_Birthday" = c("##!!factor", "##!!eachexact", "yes", "##!!strictexact", "yes", "no", "maybe")) + validity_table <- data.frame( + "Name" = c("##!!text"), + "Has_Birthday" = c("##!!factor", "##!!eachexact", "yes", "##!!strictexact", "yes", "no", "maybe") + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) test_that("Function returns an error when no values for exact rules are found", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!anyexact"), - "Has_Birthday" = c("##!!factor", "##!!strictexact")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!anyexact"), + "Has_Birthday" = c("##!!factor", "##!!strictexact") + ) check_results <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_false(check_results$Check_Result) - }) test_that("Function returns a warning when no corresponding rules are found", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text"), - "Has_Birthday" = c("##!!factor")) + validity_table <- data.frame( + "Name" = c("##!!text"), + "Has_Birthday" = c("##!!factor") + ) expect_warning(check_column_exactinput(check_table = check_table, validity_table = validity_table)) - }) test_that("That 'strict exact' functions the same with NA values inbetween", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text"), - "Has_Birthday" = c("##!!factor", "##!!strictexact", NA, NA, "no", NA, NA, "yes", NA, NA)) + validity_table <- data.frame( + "Name" = c("##!!text"), + "Has_Birthday" = c("##!!factor", "##!!strictexact", NA, NA, "no", NA, NA, "yes", NA, NA) + ) check_result <- check_column_exactinput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) diff --git a/tests/testthat/test-check_column_names.R b/tests/testthat/test-check_column_names.R index fedd577..bcb9bbe 100644 --- a/tests/testthat/test-check_column_names.R +++ b/tests/testthat/test-check_column_names.R @@ -1,7 +1,8 @@ test_that("Presence of all column names is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number") checK_result <- check_column_names(check_table = check_table, validity_table = validity_table, check_type = "presence") @@ -9,16 +10,17 @@ test_that("Presence of all column names is correctly detected", { expect_true(checK_result$Check_Result) expect_equal(checK_result$Columns, NA) - expect_true(check_column_names(check_table = check_table, validity_table = validity_table, - check_type = "presence", simply = TRUE)) - - + expect_true(check_column_names( + check_table = check_table, validity_table = validity_table, + check_type = "presence", simply = TRUE + )) }) test_that("Non presence of a column is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", "Birthday" = "##!!date") checK_result <- check_column_names(check_table = check_table, validity_table = validity_table, check_type = "presence") @@ -26,13 +28,13 @@ test_that("Non presence of a column is correctly detected", { expect_false(checK_result$Check_Result) expect_equal("Birthday", checK_result$Columns) - expect_false(check_column_names(check_table = check_table, validity_table = validity_table, - check_type = "presence", simply = TRUE)) - + expect_false(check_column_names( + check_table = check_table, validity_table = validity_table, + check_type = "presence", simply = TRUE + )) }) test_that("Non presence of several columns is correctly detected", { - check_table <- data.frame("Name" = c("David", "Diana", "Marcel")) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", "Birthday" = "##!!date") @@ -41,17 +43,19 @@ test_that("Non presence of several columns is correctly detected", { expect_false(checK_result$Check_Result) expect_equal("Age, Birthday", checK_result$Columns) - expect_false(check_column_names(check_table = check_table, validity_table = validity_table, - check_type = "presence", simply = TRUE)) - + expect_false(check_column_names( + check_table = check_table, validity_table = validity_table, + check_type = "presence", simply = TRUE + )) }) test_that("Correct order of columns is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25), - "Birthday" = c("2000-12-12", "1999-02-02", "1989-02-28")) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25), + "Birthday" = c("2000-12-12", "1999-02-02", "1989-02-28") + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", "Birthday" = "##!!date") checK_result <- check_column_names(check_table = check_table, validity_table = validity_table, check_type = "order") @@ -59,32 +63,34 @@ test_that("Correct order of columns is correctly detected", { expect_true(checK_result$Check_Result) expect_equal(checK_result$Columns, NA) - expect_true(check_column_names(check_table = check_table, validity_table = validity_table, - check_type = "order", simply = TRUE)) - + expect_true(check_column_names( + check_table = check_table, validity_table = validity_table, + check_type = "order", simply = TRUE + )) }) test_that("Correct order of columns is correctly detected irrespective of position", { - - check_table <- data.frame("ID" = c(3544, 5623, 5234), - "Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25), - "Birthday" = c("2000-12-12", "1999-02-02", "1989-02-28")) + check_table <- data.frame( + "ID" = c(3544, 5623, 5234), + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25), + "Birthday" = c("2000-12-12", "1999-02-02", "1989-02-28") + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", "Birthday" = "##!!date") checK_result <- check_column_names(check_table = check_table, validity_table = validity_table, check_type = "order") expect_true(checK_result$Check_Result) expect_equal(checK_result$Columns, NA) - }) test_that("Incorrect order of columns is correctly detected", { - - check_table <- data.frame("ID" = c(3544, 5623, 5234), - "Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25), - "Birthday" = c("2000-12-12", "1999-02-02", "1989-02-28")) + check_table <- data.frame( + "ID" = c(3544, 5623, 5234), + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25), + "Birthday" = c("2000-12-12", "1999-02-02", "1989-02-28") + ) validity_table <- data.frame("Name" = "##!!text", "Birthday" = "##!!date", "Age" = "##!!number") checK_result <- check_column_names(check_table = check_table, validity_table = validity_table, check_type = "order") @@ -92,7 +98,8 @@ test_that("Incorrect order of columns is correctly detected", { expect_false(checK_result$Check_Result) expect_equal(checK_result$Message, "All columns are present but not in the specified order") - expect_false(check_column_names(check_table = check_table, validity_table = validity_table, - check_type = "order", simply = TRUE)) - + expect_false(check_column_names( + check_table = check_table, validity_table = validity_table, + check_type = "order", simply = TRUE + )) }) diff --git a/tests/testthat/test-check_column_notempty.R b/tests/testthat/test-check_column_notempty.R index 208fc93..53497e7 100644 --- a/tests/testthat/test-check_column_notempty.R +++ b/tests/testthat/test-check_column_notempty.R @@ -1,7 +1,8 @@ test_that("Function returns true when no empty values are found", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, NA)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, NA) + ) validity_table <- data.frame("Name" = c("##!!text", "##!!notempty"), "Age" = c("##!!number", NA)) @@ -13,13 +14,13 @@ test_that("Function returns true when no empty values are found", { check_result <- check_column_notempty(check_table = check_table, validity_table = validity_table, simply = TRUE) expect_true(check_result) - }) test_that("Function correctly detects empty values for one column", { - - check_table <- data.frame("Name" = c("David", "Diana", NA), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", NA), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = c("##!!text", "##!!notempty"), "Age" = c("##!!number", NA)) @@ -31,14 +32,14 @@ test_that("Function correctly detects empty values for one column", { check_result <- check_column_notempty(check_table = check_table, validity_table = validity_table, simply = TRUE) expect_false(check_result) - }) test_that("Function correctly detects empty values for two column", { - - check_table <- data.frame("Name" = c("David", "Diana", NA), - "Age" = c(22, 18, NA), - "Error" = c("", "", "")) + check_table <- data.frame( + "Name" = c("David", "Diana", NA), + "Age" = c(22, 18, NA), + "Error" = c("", "", "") + ) validity_table <- data.frame("Name" = c("##!!text", "##!!notempty"), "Age" = c("##!!number", "##!!notempty")) @@ -50,5 +51,4 @@ test_that("Function correctly detects empty values for two column", { check_result <- check_column_notempty(check_table = check_table, validity_table = validity_table, simply = TRUE) expect_false(check_result) - }) diff --git a/tests/testthat/test-check_column_number.R b/tests/testthat/test-check_column_number.R index 5215ded..6402557 100644 --- a/tests/testthat/test-check_column_number.R +++ b/tests/testthat/test-check_column_number.R @@ -1,58 +1,59 @@ test_that("Correct number of columns is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number") checK_result <- check_column_number(check_table = check_table, validity_table = validity_table) expect_true(checK_result$Check_Result) expect_equal(checK_result$Columns, NA) - }) test_that("Incorrect number of columns is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = "##!!text") checK_result <- check_column_number(check_table = check_table, validity_table = validity_table) expect_false(checK_result$Check_Result) expect_equal(checK_result$Columns, NA) - }) test_that("Correct number of columns is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number") checK_result <- check_column_number(check_table = check_table, validity_table = validity_table, simply = TRUE) expect_true(checK_result) - }) test_that("Incorrect number of columns is correctly detected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25)) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25) + ) validity_table <- data.frame("Name" = "##!!text") checK_result <- check_column_number(check_table = check_table, validity_table = validity_table, simply = TRUE) expect_false(checK_result) - }) test_that("Parameter 'larger' works as expected", { - - check_table <- data.frame("Name" = c("David", "Diana", "Marcel"), - "Age" = c(22, 18, 25), - "Nickname" = c("Davy", "Bogini", "Marcello")) + check_table <- data.frame( + "Name" = c("David", "Diana", "Marcel"), + "Age" = c(22, 18, 25), + "Nickname" = c("Davy", "Bogini", "Marcello") + ) validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number") checK_result <- check_column_number(check_table = check_table, validity_table = validity_table, check_type = "larger") @@ -60,7 +61,8 @@ test_that("Parameter 'larger' works as expected", { expect_true(checK_result$Check_Result) expect_equal(checK_result$Columns, NA) - expect_true(check_column_number(check_table = check_table, validity_table = validity_table, - check_type = "larger", simply = TRUE)) - + expect_true(check_column_number( + check_table = check_table, validity_table = validity_table, + check_type = "larger", simply = TRUE + )) }) diff --git a/tests/testthat/test-check_column_patterninput.R b/tests/testthat/test-check_column_patterninput.R index c0ae2bc..d4cec82 100644 --- a/tests/testthat/test-check_column_patterninput.R +++ b/tests/testthat/test-check_column_patterninput.R @@ -1,120 +1,145 @@ test_that("That 'strict pattern' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) + check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table, simply = TRUE) + + expect_true(check_result) + }) test_that("That 'strict pattern' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "i", NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "i", NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Name") + check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table, simply = TRUE) + + expect_false(check_result) }) test_that("That 'row pattern' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!rowpattern", "n", "y", "t")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!rowpattern", "n", "y", "t") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) test_that("That 'row pattern' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!rowpattern", "n", "o")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!rowpattern", "n", "o") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Has_Birthday") - }) test_that("That 'any pattern' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!anypattern", "n", "o")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!anypattern", "n", "o") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) test_that("That 'any pattern' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA), - "Has_Birthday" = c("##!!factor", "##!!anypattern", "x")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA), + "Has_Birthday" = c("##!!factor", "##!!anypattern", "x") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Has_Birthday") - }) test_that("That 'each pattern' is correctly flagged when fulfilled", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel", "Thomas", "Claire")), + "Has_Birthday" = factor(c("no", "yes", "no", "maybe", "never")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel", "Thomas", "Claire")), - "Has_Birthday" = factor(c("no", "yes", "no", "maybe", "never"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!eachpattern", "n", "o", "m", "e")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!eachpattern", "n", "o", "m", "e") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$columns, NA) - }) test_that("That 'any pattern' is correctly flagged when broken", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel", "Thomas", "Claire")), + "Has_Birthday" = factor(c("no", "yes", "no", "maybe", "never")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel", "Thomas", "Claire")), - "Has_Birthday" = factor(c("no", "yes", "no", "maybe", "never"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!eachpattern", "n", "o", "m", "t")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!eachpattern", "n", "o", "m", "t") + ) check_result <- check_column_patterninput(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$columns, "Has_Birthday") - }) diff --git a/tests/testthat/test-check_column_types.R b/tests/testthat/test-check_column_types.R index c9aa056..b6b6a9a 100644 --- a/tests/testthat/test-check_column_types.R +++ b/tests/testthat/test-check_column_types.R @@ -1,138 +1,198 @@ test_that("Correct data type of check table returns true", { - - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Age" = as.double(c(22, 18, 25)), - "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = factor(c("no", "yes", "no")), - "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) - ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = factor(c("no", "yes", "no")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + ) + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_true(check_result$Check_Result) expect_equal(check_result$Columns, NA) + check_result <- check_column_types(check_table = check_table, validity_table = validity_table, simply = TRUE) + + expect_true(check_result) + }) test_that("'Expected date but wasn't found' returns false", { - - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Age" = as.double(c(22, 18, 25)), - "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = factor(c("no", "yes", "no")), - "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = factor(c("no", "yes", "no")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$Columns, "Birthday") + check_result <- check_column_types(check_table = check_table, validity_table = validity_table, simply = TRUE) + + expect_false(check_result) + }) test_that("'Expected datetime but wasn't found' returns false", { - - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Age" = as.double(c(22, 18, 25)), - "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = factor(c("no", "yes", "no")), - "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = factor(c("no", "yes", "no")), + "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$Columns, "Arrival_Time") - }) test_that("'Expected character column type but wasn't found' returns false", { - - check_table <- data.frame("Name" = as.factor(c("David", "Diana", "Marcel")), - "Age" = as.double(c(22, 18, 25)), - "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = factor(c("no", "yes", "no")), - "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.factor(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = factor(c("no", "yes", "no")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$Columns, "Name") - }) test_that("'Expected double but wasn't found' returns false", { - - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Age" = as.character(c(22, 18, 25)), - "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = factor(c("no", "yes", "no")), - "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.character(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = factor(c("no", "yes", "no")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$Columns, "Age") - }) test_that("'Expected factor but wasn't found' returns false", { - - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Age" = as.double(c(22, 18, 25)), - "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = as.character(c("no", "yes", "no")), - "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = as.character(c("no", "yes", "no")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$Columns, "Has_Birthday") - }) test_that("Every columns with unexpected data type are detected", { - - check_table <- data.frame("Name" = as.factor(c("David", "Diana", "Marcel")), - "Age" = as.character(c(22, 18, 25)), - "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = as.character(c("no", "yes", "no")), - "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.factor(c("David", "Diana", "Marcel")), + "Age" = as.character(c(22, 18, 25)), + "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = as.character(c("no", "yes", "no")), + "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!text", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) check_result <- check_column_types(check_table = check_table, validity_table = validity_table) expect_false(check_result$Check_Result) expect_equal(check_result$Columns, "Name, Age, Birthday, Has_Birthday, Arrival_Time") +}) + +test_that("Missing column type in validity does not pose a problem", { + + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = factor(c("no", "yes", "no")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + ) + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", + "Arrival_Time" = "##!!datetime" + ) + + check_result <- check_column_types(check_table = check_table, validity_table = validity_table) + + expect_true(check_result$Check_Result) + expect_equal(check_result$Columns, NA) + +}) + +test_that("Missing column in check table does not raise an error", { + + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Age" = as.double(c(22, 18, 25)), + "Birthday" = as.Date(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Arrival_Time" = as.POSIXct(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + ) + validity_table <- data.frame( + "Name" = "##!!text", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) + + check_result <- check_column_types(check_table = check_table, validity_table = validity_table) + + expect_true(check_result$Check_Result) + expect_equal(check_result$Columns, NA) }) diff --git a/tests/testthat/test-check_date_conversions.R b/tests/testthat/test-check_date_conversions.R index 24375f7..55badf7 100644 --- a/tests/testthat/test-check_date_conversions.R +++ b/tests/testthat/test-check_date_conversions.R @@ -1,6 +1,5 @@ test_that("as.Date_xafty can work with different date formats in a column", { - - dates <- c("2023-01-01", "01.01.2023", "01/01/2023", "2023/01/01", "01.01.2023") + dates <- c("2023-01-01", "01.01.2023", "01/01/2023", "2023/01/01", "01.01.2023") try_Format <- c("%Y-%m-%d", "%d.%m.%Y", "%d/%m/%Y", "%Y/%m/%d") @@ -10,13 +9,10 @@ test_that("as.Date_xafty can work with different date formats in a column", { expect_equal(length(dates_converted), length(dates)) expect_equal(dates_converted, dates_expectation) - - }) test_that("as.Date_xafty can work with small y Formats", { - - dates <- c("01.01.23") + dates <- c("01.01.23") try_Format <- c("%d.%m.%y") @@ -26,15 +22,12 @@ test_that("as.Date_xafty can work with small y Formats", { expect_equal(length(dates_converted), length(dates)) expect_equal(dates_converted, dates_expectation) - - }) test_that("tryFormats Parameter allows for additional formats", { + dates <- c("2023-01-01", "01.01.2023", "01x01x2023", "01/01/2023", "2023/01/01", "01.01.2023") - dates <- c("2023-01-01", "01.01.2023", "01x01x2023","01/01/2023", "2023/01/01", "01.01.2023") - - try_Format <- c("%dx%mx%Y","%Y-%m-%d", "%d.%m.%Y", "%d/%m/%Y", "%Y/%m/%d") + try_Format <- c("%dx%mx%Y", "%Y-%m-%d", "%d.%m.%Y", "%d/%m/%Y", "%Y/%m/%d") dates_converted <- as.Date_xafty(dates = dates, tryFormats = try_Format) @@ -42,5 +35,4 @@ test_that("tryFormats Parameter allows for additional formats", { expect_equal(length(dates_converted), length(dates)) expect_equal(dates_converted, dates_expectation) - }) diff --git a/tests/testthat/test-check_validity.R b/tests/testthat/test-check_validity.R index 22cfee5..b32b05b 100644 --- a/tests/testthat/test-check_validity.R +++ b/tests/testthat/test-check_validity.R @@ -1,5 +1,4 @@ test_that("Main functionality works as expected when all rules are fullfilled", { - check_table <- data.frame( "Product_ID" = c("345", "341", "441"), "Product_Name" = c("Apple", "Banana", "Pencil"), @@ -8,7 +7,7 @@ test_that("Main functionality works as expected when all rules are fullfilled", "Delivery_Time" = as.POSIXct(c("2023-09-12 22:12:01", "2023-09-17 22:12:01", "2023-09-12 01:12:01")), "Is_Delivered_By" = factor(c("zzz__Train", "Train no Rails", "Truck")), "Mail_Customer" = c("applelover@yahoo.com", "banana_digester@bananas.uk", "grrm@asoiaf.com") - ) + ) validity_table <- data.frame( "Product_ID" = c("##!!text"), @@ -20,18 +19,18 @@ test_that("Main functionality works as expected when all rules are fullfilled", "Mail_Customer" = c("##!!text", "##!!strictpattern", "@", ".", "##!!notempty") ) - check_result <- check_validity(check_table = check_table, validity_table = validity_table, - column_number = TRUE, column_names = "presence", column_types = TRUE, - values_notempty = TRUE, values_exact = TRUE, values_pattern = TRUE) + check_result <- check_validity( + check_table = check_table, validity_table = validity_table, + column_number = TRUE, column_names = "presence", column_types = TRUE, + values_notempty = TRUE, values_exact = TRUE, values_pattern = TRUE + ) expect_true(all(check_result$Check_Result)) expect_true(all(is.na(check_result$Columns))) - }) test_that("Main functionality works as expected when all rules are broken", { - check_table <- data.frame( "Product_Name" = c("Apple", "Banana", NA), "Product_Weight" = c(2.1, 0.5, 1.0), @@ -51,9 +50,11 @@ test_that("Main functionality works as expected when all rules are broken", { "Mail_Customer" = c("##!!text", "##!!strictpattern", "@", ".", "xx") ) - check_result <- check_validity(check_table = check_table, validity_table = validity_table, - column_number = TRUE, column_names = "presence", column_types = TRUE, - values_notempty = TRUE, values_exact = TRUE, values_pattern = TRUE) + check_result <- check_validity( + check_table = check_table, validity_table = validity_table, + column_number = TRUE, column_names = "presence", column_types = TRUE, + values_notempty = TRUE, values_exact = TRUE, values_pattern = TRUE + ) expect_false(any(check_result$Check_Result)) expect_equal(check_result$Columns[1], as.character(NA)) @@ -62,5 +63,4 @@ test_that("Main functionality works as expected when all rules are broken", { expect_equal(check_result$Columns[4], "Product_Name") expect_equal(check_result$Columns[5], c("Product_Weight, Product_Name, Expiration_Date")) expect_equal(check_result$Columns[6], c("Mail_Customer, Is_Delivered_By")) - }) diff --git a/tests/testthat/test-filter_column_exactinput.R b/tests/testthat/test-filter_column_exactinput.R index 4225597..0b95e6f 100644 --- a/tests/testthat/test-filter_column_exactinput.R +++ b/tests/testthat/test-filter_column_exactinput.R @@ -1,95 +1,101 @@ test_that("Filter for values are correctly identified", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "maybe")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "maybe") + ) filter_result <- filter_column_exactinput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(filter_result, c(TRUE, TRUE, TRUE)) expect_equal(length(filter_result), 3) - - }) test_that("Filter for values are correctly identified with NA", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", NA)) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", NA))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "NA")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "NA") + ) filter_result <- filter_column_exactinput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(filter_result, c(TRUE, TRUE, TRUE)) expect_equal(length(filter_result), 3) - - }) test_that("Filter for values are correctly identified with broken value", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "maybe")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "maybe"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "NA")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!strictexact", "no", "yes", "NA") + ) filter_result <- filter_column_exactinput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(filter_result, c(TRUE, TRUE, FALSE)) expect_equal(length(filter_result), 3) - - }) test_that("Filter for values are correctly identified with two rules in one column", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "maybe")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "maybe"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!anyexact", "no", "##!eachexact", "yes")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!anyexact", "no", "##!eachexact", "yes") + ) filter_result <- filter_column_exactinput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(filter_result, c(TRUE, TRUE, FALSE)) expect_equal(length(filter_result), 3) - - }) test_that("Filter with all broken values work", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("maybe", "maybe", "maybe")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("maybe", "maybe", "maybe"))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!anyexact", "no", "##!eachexact", "yes")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!anyexact", "no", "##!eachexact", "yes") + ) filter_result <- filter_column_exactinput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(filter_result, c(FALSE, FALSE, FALSE)) expect_equal(length(filter_result), 3) - - }) test_that("All values NA returns FALSE", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c(NA, NA, NA)) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c(NA, NA, NA))) - - validity_table <- data.frame("Name" = c("##!!text", NA, NA, NA), - "Has_Birthday" = c("##!!factor", "##!!anyexact", "no", "yes")) + validity_table <- data.frame( + "Name" = c("##!!text", NA, NA, NA), + "Has_Birthday" = c("##!!factor", "##!!anyexact", "no", "yes") + ) filter_result <- filter_column_exactinput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(filter_result, c(FALSE, FALSE, FALSE)) expect_equal(length(filter_result), 3) - - }) diff --git a/tests/testthat/test-filter_column_patterninput.R b/tests/testthat/test-filter_column_patterninput.R index 6120bf9..8a9209f 100644 --- a/tests/testthat/test-filter_column_patterninput.R +++ b/tests/testthat/test-filter_column_patterninput.R @@ -1,88 +1,104 @@ test_that("Filter for values are correctly identified", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "yes", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "yes", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", NA), - "Has_Birthday" = c("##!!factor", "##!!rowpattern", "n", "y")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", NA), + "Has_Birthday" = c("##!!factor", "##!!rowpattern", "n", "y") + ) check_result <- filter_column_patterninput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(check_result, c(TRUE, TRUE, TRUE)) expect_equal(length(check_result), 3) - }) test_that("Filter for values are correctly identified", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "maybe", "no")) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "maybe", "no"))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", "i"), - "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "o")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", "i"), + "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "o") + ) check_result <- filter_column_patterninput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(check_result, c(TRUE, FALSE, TRUE)) expect_equal(length(check_result), 3) - }) test_that("Filter for values are correctly identified for NA Values", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", "maybe", NA)) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", "maybe", NA))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", NA), - "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "o")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", NA), + "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "o") + ) check_result <- filter_column_patterninput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(check_result, c(TRUE, FALSE, TRUE)) expect_equal(length(check_result), 3) - }) test_that("Filter for values are correctly identified for NA Values", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", NA, NA)) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", NA, NA))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", NA), - "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "o")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", NA), + "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "o") + ) check_result <- filter_column_patterninput(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(check_result, c(TRUE, TRUE, TRUE)) expect_equal(length(check_result), 3) - }) test_that("Several rules in one column throws an error", { - - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c("no", NA, NA))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", NA), - "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "##!!eachpattern")) - - expect_error(filter_column_patterninput(check_table = check_table, validity_table = validity_table, - filter_column = "Has_Birthday")) - + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c("no", NA, NA)) + ) + + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", NA), + "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "##!!eachpattern") + ) + + expect_error(filter_column_patterninput( + check_table = check_table, validity_table = validity_table, + filter_column = "Has_Birthday" + )) }) test_that("All values NA returns FALSE", { + check_table <- data.frame( + "Name" = as.character(c("David", "Diana", "Marcel")), + "Has_Birthday" = factor(c(NA, NA, NA)) + ) - check_table <- data.frame("Name" = as.character(c("David", "Diana", "Marcel")), - "Has_Birthday" = factor(c(NA, NA, NA))) - - validity_table <- data.frame("Name" = c("##!!text", "##!!strictpattern", "a", NA), - "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "##!!eachpattern")) + validity_table <- data.frame( + "Name" = c("##!!text", "##!!strictpattern", "a", NA), + "Has_Birthday" = c("##!!factor", "##!!strictpattern", "n", "##!!eachpattern") + ) - check_result <- filter_column_patterninput(check_table = check_table, validity_table = validity_table, - filter_column = "Has_Birthday") + check_result <- filter_column_patterninput( + check_table = check_table, validity_table = validity_table, + filter_column = "Has_Birthday" + ) expect_equal(check_result, c(FALSE, FALSE, FALSE)) expect_equal(length(check_result), 3) - }) diff --git a/tests/testthat/test-filter_column_type.R b/tests/testthat/test-filter_column_type.R index 7728e2a..b031245 100644 --- a/tests/testthat/test-filter_column_type.R +++ b/tests/testthat/test-filter_column_type.R @@ -1,60 +1,70 @@ test_that("Filter for type 'factor' works", { - - check_table <- data.frame("Name" = as.factor(c("David", "Diana", "Marcel")), - "Age" = as.character(c(22, 18, 25)), - "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = as.character(c("no", "yes", "no")), - "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.factor(c("David", "Diana", "Marcel")), + "Age" = as.character(c(22, 18, 25)), + "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = as.character(c("no", "yes", "no")), + "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!factor", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!factor", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!factor", + "Arrival_Time" = "##!!datetime" + ) xafty_column_true <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Name") xafty_column_false <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") expect_equal(xafty_column_true, rep(TRUE, 3)) expect_equal(xafty_column_false, rep(FALSE, 3)) - }) test_that("Filter for type 'character' works", { - - check_table <- data.frame("Name" = as.factor(c("David", "Diana", "Marcel")), - "Age" = as.numeric(c(22, 18, 25)), - "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = as.character(c("no", "yes", "no")), - "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) + check_table <- data.frame( + "Name" = as.factor(c("David", "Diana", "Marcel")), + "Age" = as.numeric(c(22, 18, 25)), + "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = as.character(c("no", "yes", "no")), + "Arrival_Time" = as.character(c("2021-09-06 12:34:56", "2021-09-06 11:34:56", "2021-09-06 12:10:01")) ) - validity_table <- data.frame("Name" = "##!!factor", "Age" = "##!!text", - "Birthday" = "##!!date", "Has_Birthday" = "##!!text", - "Arrival_Time" = "##!!datetime") + validity_table <- data.frame( + "Name" = "##!!factor", "Age" = "##!!text", + "Birthday" = "##!!date", "Has_Birthday" = "##!!text", + "Arrival_Time" = "##!!datetime" + ) xafty_column_true <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") xafty_column_false <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Age") expect_equal(xafty_column_true, rep(TRUE, 3)) expect_equal(xafty_column_false, rep(FALSE, 3)) - }) test_that("Filter for type 'date' works", { - - check_table <- data.frame("Birthday" = as.character(c("2000-12-24", "1993-09-06", - "2022-01-01", "01.02.2023", - "12/01/1993", "2000/12/01")), - "Birthday_m" = as.character(c("2000-412-24", "1993/09-06", - "2022-xx01-01", "01..02.2023", - "12/01//1993", "20000/12/01")), - "Arrival_Date" = as.character(c("2003/12/24", "Christmas", "50404", - "20.12.12", NA, "Tesla")) + check_table <- data.frame( + "Birthday" = as.character(c( + "2000-12-24", "1993-09-06", + "2022-01-01", "01.02.2023", + "12/01/1993", "2000/12/01" + )), + "Birthday_m" = as.character(c( + "2000-412-24", "1993/09-06", + "2022-xx01-01", "01..02.2023", + "12/01//1993", "20000/12/01" + )), + "Arrival_Date" = as.character(c( + "2003/12/24", "Christmas", "50404", + "20.12.12", NA, "Tesla" + )) ) - validity_table <- data.frame("Birthday_m" = "##!!date", "Age" = "##!!text", - "Birthday" = "##!!date", "Has_Birthday" = "##!!text", - "Arrival_Date" = "##!!date") + validity_table <- data.frame( + "Birthday_m" = "##!!date", "Age" = "##!!text", + "Birthday" = "##!!date", "Has_Birthday" = "##!!text", + "Arrival_Date" = "##!!date" + ) xafty_column_true <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Birthday") xafty_column_false <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Birthday_m") @@ -64,21 +74,22 @@ test_that("Filter for type 'date' works", { expect_equal(xafty_column_true, rep(TRUE, 6)) expect_equal(xafty_column_false, rep(FALSE, 6)) expect_equal(xafty_column_mix, c(TRUE, FALSE, TRUE, TRUE, TRUE, FALSE)) - }) test_that("Filter for type 'numeric' works", { - - check_table <- data.frame("Name" = as.factor(c("David", "Diana", "Marcel")), - "Age" = as.numeric(c(22, 18, 25)), - "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = as.character(c("no", "yes", "no")), - "Arrival_Time" = as.character(c(NA, "20", "Afternoon")) + check_table <- data.frame( + "Name" = as.factor(c("David", "Diana", "Marcel")), + "Age" = as.numeric(c(22, 18, 25)), + "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = as.character(c("no", "yes", "no")), + "Arrival_Time" = as.character(c(NA, "20", "Afternoon")) ) - validity_table <- data.frame("Name" = "##!!factor", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!number", - "Arrival_Time" = "##!!number") + validity_table <- data.frame( + "Name" = "##!!factor", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!number", + "Arrival_Time" = "##!!number" + ) xafty_column_true <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Age") xafty_column_false <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Has_Birthday") @@ -88,53 +99,65 @@ test_that("Filter for type 'numeric' works", { expect_equal(xafty_column_true, rep(TRUE, 3)) expect_equal(xafty_column_false, rep(FALSE, 3)) expect_equal(xafty_column_mix, c(TRUE, TRUE, FALSE)) - }) test_that("Filter for type 'datetime' works", { - - check_table <- data.frame("Birthday" = as.character(c("2000-12-24 22:10", "1993-09-06 0:12", - "2022-01-01 10:10:10", "2012-09-12 12:31:59", - "12/01/1993 10:10:10", "2000/12/01 10:10:10")), - "Birthday_m" = as.character(c("2000-412-24 21:33", "1993/09//06 100:2:asd1", - "2022-xx01-01 21:33", "01..02.2023 21x:x33", - "12/01//1993 21:33:22", "20000/12/01 21:33:12")) + check_table <- data.frame( + "Birthday" = as.character(c( + "2000-12-24 22:10", "1993-09-06 0:12", + "2022-01-01 10:10:10", "2012-09-12 12:31:59", + "12/01/1993 10:10:10", "2000/12/01 10:10:10" + )), + "Birthday_m" = as.character(c( + "2000-412-24 21:33", "1993/09//06 100:2:asd1", + "2022-xx01-01 21:33", "01..02.2023 21x:x33", + "12/01//1993 21:33:22", "20000/12/01 21:33:12" + )) ) - validity_table <- data.frame("Birthday_m" = "##!!datetime", "Age" = "##!!text", - "Birthday" = "##!!datetime", "Has_Birthday" = "##!!text", - "Arrival_Date" = "##!!date") + validity_table <- data.frame( + "Birthday_m" = "##!!datetime", "Age" = "##!!text", + "Birthday" = "##!!datetime", "Has_Birthday" = "##!!text", + "Arrival_Date" = "##!!date" + ) xafty_column_true <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Birthday") xafty_column_false <- filter_column_type(check_table = check_table, validity_table = validity_table, filter_column = "Birthday_m") - xafty_column_false <- filter_column_type(check_table = check_table, validity_table = validity_table, - filter_column = "Birthday_m", ) + xafty_column_false <- filter_column_type( + check_table = check_table, validity_table = validity_table, + filter_column = "Birthday_m", + ) expect_equal(xafty_column_true, rep(TRUE, 6)) expect_equal(xafty_column_false, rep(FALSE, 6)) - }) test_that("Function correctly retunrs error when arguments are incorrectly passed", { - - check_table <- data.frame("Name" = as.factor(c("David", "Diana", "Marcel")), - "Age" = as.numeric(c(22, 18, 25)), - "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), - "Has_Birthday" = as.character(c("no", "yes", "no")) + check_table <- data.frame( + "Name" = as.factor(c("David", "Diana", "Marcel")), + "Age" = as.numeric(c(22, 18, 25)), + "Birthday" = as.character(c("2000-12-24", "1993-09-06", "2022-01-01")), + "Has_Birthday" = as.character(c("no", "yes", "no")) ) - validity_table <- data.frame("Name" = "##!!factor", "Age" = "##!!number", - "Birthday" = "##!!date", "Has_Birthday" = "##!!number", - "Arrival_Time" = "##!!datetime" + validity_table <- data.frame( + "Name" = "##!!factor", "Age" = "##!!number", + "Birthday" = "##!!date", "Has_Birthday" = "##!!number", + "Arrival_Time" = "##!!datetime" ) - expect_error(filter_column_type(check_table = check_table, validity_table = validity_table, - filter_column = c("Arrival_Date", "Birthday"))) - expect_error(filter_column_type(check_table = check_table, validity_table = validity_table, - filter_column = "Loudness")) - expect_error(filter_column_type(check_table = check_table, validity_table = validity_table, - filter_column = "Arrival_Time")) - + expect_error(filter_column_type( + check_table = check_table, validity_table = validity_table, + filter_column = c("Arrival_Date", "Birthday") + )) + expect_error(filter_column_type( + check_table = check_table, validity_table = validity_table, + filter_column = "Loudness" + )) + expect_error(filter_column_type( + check_table = check_table, validity_table = validity_table, + filter_column = "Arrival_Time" + )) }) diff --git a/tests/testthat/test-obtain_columns_in_validity.R b/tests/testthat/test-obtain_columns_in_validity.R index de008a2..7594d67 100644 --- a/tests/testthat/test-obtain_columns_in_validity.R +++ b/tests/testthat/test-obtain_columns_in_validity.R @@ -1,70 +1,69 @@ test_that("Function retrieves columns with xafty syntax correctly", { - xafty_syntax <- c("##!!text", "##!!eachpattern", "##number") - validity_table <- data.frame( - "Plant_Name" = c("##!!text"), - "Color" = c("##!!text", "##!!eachpattern"), - "Petal.Size" = c("##number", "#!eachexact") - ) + validity_table <- data.frame( + "Plant_Name" = c("##!!text"), + "Color" = c("##!!text", "##!!eachpattern"), + "Petal.Size" = c("##number", "#!eachexact") + ) columns_xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = xafty_syntax) - expect_equal(columns_xafty_pair, c("##!!text" = "Plant_Name", "##!!text" = "Color", "##!!eachpattern" = "Color", - "##number" = "Petal.Size")) - + expect_equal(columns_xafty_pair, c( + "##!!text" = "Plant_Name", "##!!text" = "Color", "##!!eachpattern" = "Color", + "##number" = "Petal.Size" + )) }) test_that("Returns correct value with minimal validity", { - xafty_syntax <- "##!!datetime" - validity_table <- data.frame("Birthday_m" = "##!!datetime", - "Birthday" = "##!!datetime") + validity_table <- data.frame( + "Birthday_m" = "##!!datetime", + "Birthday" = "##!!datetime" + ) column_xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = xafty_syntax) expect_equal(column_xafty_pair, c("##!!datetime" = "Birthday_m", "##!!datetime" = "Birthday")) - }) test_that("Returns correct value with possible validity", { - xafty_syntax <- c("##!!datetime", "##!!patterninput") - validity_table <- data.frame("Birthday_m" = "##!!datetime", - "Birthday" = "##!!patterninput", "yes") + validity_table <- data.frame( + "Birthday_m" = "##!!datetime", + "Birthday" = "##!!patterninput", "yes" + ) column_xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = xafty_syntax) expect_equal(column_xafty_pair, c("##!!datetime" = "Birthday_m", "##!!patterninput" = "Birthday")) - }) test_that("Returns correct value with possible validity", { - xafty_syntax <- c("##!!datetime", "##!!patterninput") - validity_table <- data.frame("Birthday_m" = "##!!datetime", - "Birthday" = c("##!!datetime", "##!!date")) + validity_table <- data.frame( + "Birthday_m" = "##!!datetime", + "Birthday" = c("##!!datetime", "##!!date") + ) column_xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = xafty_syntax) expect_equal(column_xafty_pair, c("##!!datetime" = "Birthday_m", "##!!datetime" = "Birthday")) - }) test_that("NA Values do not pose a problem", { - xafty_syntax <- c("##!!datetime", "##!!patterninput") - validity_table <- data.frame("Birthday_m" = c(NA, "##!!datetime"), - "Birthday" = c("##!!datetime", "##!!date", NA, NA), - "Arrival" = c(rep(NA, 4))) + validity_table <- data.frame( + "Birthday_m" = c(NA, "##!!datetime"), + "Birthday" = c("##!!datetime", "##!!date", NA, NA), + "Arrival" = c(rep(NA, 4)) + ) column_xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = xafty_syntax) expect_equal(column_xafty_pair, c("##!!datetime" = "Birthday_m", "##!!datetime" = "Birthday")) - }) - diff --git a/tests/testthat/test-obtain_values_in_validity.R b/tests/testthat/test-obtain_values_in_validity.R index 617e663..e397344 100644 --- a/tests/testthat/test-obtain_values_in_validity.R +++ b/tests/testthat/test-obtain_values_in_validity.R @@ -1,5 +1,4 @@ test_that("Can obtain all values under a specified rule", { - check_table <- data.frame( "Product_Name" = c("Apple", "Banana", "Apple"), "Product_Weight" = c(2.1, 0.5, 1.0), @@ -20,32 +19,45 @@ test_that("Can obtain all values under a specified rule", { xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = "##!!eachexact") - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[1]), - c("Apple", "Banana")) - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[2]), - c("2022-02-01")) + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[1]), + c("Apple", "Banana") + ) + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[2]), + c("2022-02-01") + ) xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = "##!!rowpattern") - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair), - c("Train", "Truck")) + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair), + c("Train", "Truck") + ) xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = "##!!strictpattern") - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair), - c("@", ".")) + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair), + c("@", ".") + ) xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = "##!!notempty") - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[1]), - character(0)) - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[2]), - character(0)) + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[1]), + character(0) + ) + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair[2]), + character(0) + ) xafty_pair <- obtain_columns_in_validity(validity_table = validity_table, xafty_syntax = "##!!factor") - expect_equal(obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair), - character(0)) - + expect_equal( + obtain_values_in_validity(validity_table = validity_table, xafty_pair = xafty_pair), + character(0) + ) })