tests/testthat/test-903-validateImport_methods.R

# validate_import_checkbox ------------------------------------------

test_that(
  "0, 1, Unchecked, Checked, '', NA all pass",
  {
    test_checkbox <- c("0", "1",
                       "Unchecked", "UNCHECKED", "UnChEcKeD", "unchecked",
                       "Checked", "CHECKED", "ChEcKeD", "checked",
                       "", NA_character_)
    check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
    expect_equal(
      validate_import_checkbox(test_checkbox,
                               field_name = "checkbox___check1",
                               field_choice = check_define,
                               logfile = ""),
      c("0", "1",
        "0", "0", "0", "0",
        "1", "1", "1", "1",
        "0", NA_character_)
    )
  }
)

test_that(
  "0, 1, NA all pass (numeric)",
  {
    test_checkbox <- c(0, 1, NA_real_)
    check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
    expect_equal(
      validate_import_checkbox(test_checkbox,
                               field_name = "checkbox___check1",
                               field_choice = check_define,
                               logfile = ""),
      c("0", "1", NA_character_)
    )
  }
)

test_that(
  "codes and labels pass",
  {
    test_checkbox <- c("check1", "Guitar")
    check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
    expect_equal(
      validate_import_checkbox(test_checkbox,
                               field_name = "checkbox___check1",
                               field_choice = check_define,
                               logfile = ""),
      c("1", "1")

    )
  }
)
# Tests for validate_import_form_complete ---------------------------

test_that(
  "Acceptable values are properly mapped and returned.",
  {
    input_value <- c("Incomplete", "Unverified", "Complete",
                     "0",          "1",          "2",
                     NA)
    expect_equal(
      validate_import_form_complete(input_value,
                                    field_name = "form_complete",
                                    logfile = ""),
      c("0", "1", "2",
        "0", "1", "2",
        NA)
    )
  }
)

test_that(
  "codes and labels pass (second option)",
  {
    test_checkbox <- c("check2", "Lute")
    check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
    expect_equal(
      validate_import_checkbox(test_checkbox,
                               field_name = "checkbox___check2",
                               field_choice = check_define,
                               logfile = ""),
      c("1", "1")
    )
  }
)


test_that(
  "0 code or 0 label returns 0",
  {
    test_checkbox <- c("0")
    check_define <- "0, 0 | 1, 1"
    expect_equal(
      validate_import_checkbox(test_checkbox,
                               field_name = "checkbox___0",
                               field_choice = check_define,
                               logfile = ""),
      c("0")
    )
  }
)


test_that(
  "unmapped values produce a message",
  {
    local_reproducible_output(width = 200)
    test_checkbox <- c("check_lute")
    check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
    expect_message(
      validate_import_checkbox(test_checkbox,
                               field_name = "checkbox___check2",
                               field_choice = check_define,
                               logfile = ""),
      "must be one of '0', '1', 'Checked', 'Unchecked', 'check2', 'Lute', ''"
    )
  }
)

test_that(
  "Unacceptable values return a message",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_form_complete("Invalid",
                                    field_name = "form_complete",
                                    logfile = ""),
      "Values[(]s[)] must be one of: 0, 1, 2, Incomplete, Unverified, or Complete."
    )
  }
)


# validate_import_date ----------------------------------------------

test_that(
  "Date values are converted to YYYY-mm-dd format",
  {
    date_test <- Sys.Date()
    expect_equal(
      validate_import_date(date_test,
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      format(date_test, "%Y-%m-%d")
    )
  }
)

test_that(
  "POSIXct values are converted to YYYY-mm-dd format",
  {
    datetime_test <- Sys.time()
    expect_equal(
      validate_import_date(datetime_test,
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      format(datetime_test, "%Y-%m-%d")
    )
  }
)

test_that(
  "ymd, ymd HMS map to YYYY-mm-dd format",
  {
    test_strings <- c("2023-01-01", "2023-01-02 03:04:05")

    compare_string <- seq(from = as.Date("2023-01-01"),
                          to = as.Date("2023-01-02"),
                          by = "1 day")
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d")
    expect_equal(
      validate_import_date(test_strings,
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      compare_string
    )
  }
)

test_that(
  "mdy, mdy HMS YYYY-mm-dd format",
  {
    test_strings <- c("01-01-2023", "01-02-2023 03:04:05")

    compare_string <- as.Date(c("2023-01-01", "2023-01-02"))
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d")
    expect_equal(
      validate_import_date(test_strings,
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      compare_string
    )
  }
)

test_that(
  "dmy, dmy HMS YYYY-mm-dd format",
  {
    test_strings <- c("13-01-2023", "01-01-2023 03:04:05")

    compare_string <- as.Date(c("2023-01-13", "2023-01-01"))
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d")
    expect_equal(
      validate_import_date(test_strings,
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      compare_string
    )
  }
)

test_that(
  "NA passes without a message",
  {
    expect_equal(
      validate_import_date(c("2023-01-01", NA),
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      c("2023-01-01", NA)
    )
  }
)

test_that(
  "Unmappable values return a message",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_date(c("2023-01-33", "not a date"),
                           field_name = "date",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      "must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format"
    )
  }
)

test_that(
  "When a date is less than field_min, a message is returned",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_date(as.Date(c("2023-01-01", "2023-03-01")),
                           field_name = "date",
                           field_min = as.Date("2023-02-01"),
                           field_max = NA,
                           logfile = ""),
      "before the stated minimum date"
    )
  }
)

test_that(
  "When a date is greater than field_max, a message is returned",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_date(as.Date(c("2023-01-01", "2023-03-01")),
                           field_name = "date",
                           field_min = NA,
                           field_max = as.Date("2023-02-01"),
                           logfile = ""),
      "after the stated maximum date"
    )
  }
)

# validate_import_datetime ------------------------------------------
test_that(
  "Date values are converted to YYYY-mm-dd format",
  {
    date_test <- Sys.Date()
    expect_equal(
      validate_import_datetime(date_test,
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      format(date_test, "%Y-%m-%d %H:%M")
    )
  }
)

test_that(
  "POSIXct values are converted to YYYY-mm-dd format",
  {
    datetime_test <- Sys.time()
    expect_equal(
      validate_import_datetime(datetime_test,
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      format(datetime_test, "%Y-%m-%d %H:%M")
    )
  }
)

test_that(
  "ymd, ymd HMS map to YYYY-mm-dd format",
  {
    test_strings <- c("2023-01-01", "2023-01-02 03:04:05")

    compare_string <- as.POSIXct(c("2023-01-01 00:00:00",
                                   "2023-01-02 03:04:05"),
                                 tz = "UTC")
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d %H:%M")
    expect_equal(
      validate_import_datetime(test_strings,
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      compare_string
    )
  }
)

test_that(
  "mdy, mdy HMS YYYY-mm-dd format",
  {
    test_strings <- c("01-01-2023", "01-02-2023 03:04:05")

    compare_string <- as.POSIXct(c("2023-01-01 00:00:00", "2023-01-02 03:04:05"))
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d %H:%M")
    expect_equal(
      validate_import_datetime(test_strings,
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      compare_string
    )
  }
)

test_that(
  "dmy, dmy HMS YYYY-mm-dd format",
  {
    test_strings <- c("13-01-2023", "01-01-2023 03:04:05")

    compare_string <- as.POSIXct(c("2023-01-13 00:00:00",
                                   "2023-01-01 03:04:05"),
                                 tz = "UTC")
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d %H:%M")
    expect_equal(
      validate_import_datetime(test_strings,
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      compare_string
    )
  }
)

test_that(
  "NA passes without a message",
  {
    expect_equal(
      validate_import_datetime(c("2023-01-01", NA),
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      c("2023-01-01 00:00", NA)
    )
  }
)

test_that(
  "Unmappable values return a message",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_datetime(c("2023-01-33", "not a date"),
                               field_name = "datetime",
                               field_min = NA,
                               field_max = NA,
                               logfile = ""),
      "must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format"
    )
  }
)

test_that(
  "When a date is less than field_min, a message is returned",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_datetime(as.POSIXct(c("2023-01-01", "2023-03-01")),
                               field_name = "date",
                               field_min = as.POSIXct("2023-02-01 00:00:00"),
                               field_max = NA,
                               logfile = ""),
      "before the stated minimum date"
    )
  }
)

test_that(
  "When a date is greater than field_max, a message is returned",
  {
    local_reproducible_output(width = 200)
    expect_message(
      validate_import_datetime(as.Date(c("2023-01-01", "2023-03-01")),
                               field_name = "date",
                               field_min = NA,
                               field_max = as.POSIXct("2023-02-01"),
                               logfile = ""),
      "after the stated maximum date"
    )
  }
)

# validate_import_datetime seconds ----------------------------------
test_that(
  "Date values are converted to YYYY-mm-dd format",
  {
    date_test <- Sys.Date()
    expect_equal(
      validate_import_datetime_seconds(date_test,
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      format(date_test, "%Y-%m-%d %H:%M:%S")
    )
  }
)

test_that(
  "POSIXct values are converted to YYYY-mm-dd format",
  {
    datetime_test <- Sys.time()
    expect_equal(
      validate_import_datetime_seconds(datetime_test,
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      format(datetime_test, "%Y-%m-%d %H:%M:%S")
    )
  }
)

test_that(
  "ymd, ymd HMS map to YYYY-mm-dd format",
  {
    test_strings <- c("2023-01-01", "2023-01-02 03:04:05")

    compare_string <- as.POSIXct(c("2023-01-01 00:00:00",
                                   "2023-01-02 03:04:05"),
                                 tz = "UTC")
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d %H:%M:%S")
    expect_equal(
      validate_import_datetime_seconds(test_strings,
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      compare_string
    )
  }
)

test_that(
  "mdy, mdy HMS YYYY-mm-dd format",
  {
    test_strings <- c("01-01-2023", "01-02-2023 03:04:05")

    compare_string <- as.POSIXct(c("2023-01-01 00:00:00", "2023-01-02 03:04:05"))
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d %H:%M:%S")
    expect_equal(
      validate_import_datetime_seconds(test_strings,
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      compare_string
    )
  }
)

test_that(
  "dmy, dmy HMS YYYY-mm-dd format",
  {
    test_strings <- c("13-01-2023", "01-01-2023 03:04:05")

    compare_string <- as.POSIXct(c("2023-01-13 00:00:00",
                                   "2023-01-01 03:04:05"),
                                 tz = "UTC")
    compare_string <- format(compare_string,
                             format = "%Y-%m-%d %H:%M:%S")
    expect_equal(
      validate_import_datetime_seconds(test_strings,
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      compare_string
    )
  }
)

test_that(
  "NA passes without a message",
  {
    expect_equal(
      validate_import_datetime_seconds(c("2023-01-01", NA),
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      c("2023-01-01 00:00:00", NA)
    )
  }
)

test_that(
  "Unmappable values return a message",
  {
    expect_message(
      validate_import_datetime_seconds(c("2023-01-33", "not a date"),
                                       field_name = "datetime",
                                       field_min = NA,
                                       field_max = NA,
                                       logfile = ""),
      "must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format"
    )
  }
)

test_that(
  "When a date is less than field_min, a message is returned",
  {
    expect_message(
      validate_import_datetime_seconds(as.POSIXct(c("2023-01-01", "2023-03-01")),
                                       field_name = "date",
                                       field_min = as.POSIXct("2023-02-01 00:00:00"),
                                       field_max = NA,
                                       logfile = ""),
      "before the stated minimum date"
    )
  }
)

test_that(
  "When a date is greater than field_max, a message is returned",
  {
    expect_message(
      validate_import_datetime_seconds(as.Date(c("2023-01-01", "2023-03-01")),
                                       field_name = "date",
                                       field_min = NA,
                                       field_max = as.POSIXct("2023-02-01"),
                                       logfile = ""),
      "after the stated maximum date"
    )
  }
)

# validate_import_time ----------------------------------------------

test_that(
  "Character forms of HH:MM and HH:MM:SS pass",
  {
    time_test <- c("06:15", "06:15:00")
    expect_equal(
      validate_import_time(time_test,
                           field_name = "time",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      rep("06:15", 2)
    )
  }
)

test_that(
  "objects of class time pass. Also, NA",
  {
    time_test <- chron::as.times(c("06:15:00", NA))
    expect_equal(
      validate_import_time(time_test,
                           field_name = "time",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      c("06:15", NA)
    )
  }
)

test_that(
  "Times before field_min produce a message",
  {
    time_test <- c("06:00", "07:00", "08:00", "09:00")
    expect_message(
      validate_import_time(time_test,
                           field_name = "time",
                           field_min = "07:30",
                           field_max = NA,
                           logfile = ""),
      "are before the stated minimum time"
    )
  }
)

test_that(
  "Times after field_max produce a message",
  {
    time_test <- c("06:00", "07:00", "08:00", "09:00")
    expect_message(
      validate_import_time(time_test,
                           field_name = "time",
                           field_min = NA,
                           field_max = "07:30",
                           logfile = ""),
      "are after the stated maximum time"
    )
  }
)

# validate_import_time_mm_ss ----------------------------------------

test_that(
  "Character forms of HH:MM and HH:MM:SS pass",
  {
    time_test <- c("06:15", "00:06:15")
    expect_equal(
      validate_import_time_mm_ss(time_test,
                           field_name = "time",
                           field_min = NA,
                           field_max = NA,
                           logfile = ""),
      rep("06:15", 2)
    )
  }
)

test_that(
  "objects of class time pass. Also, NA",
  {
    time_test <- chron::as.times(c("00:06:15", NA))
    expect_equal(
      validate_import_time_mm_ss(time_test,
                                 field_name = "time",
                                 field_min = NA,
                                 field_max = NA,
                                 logfile = ""),
      c("06:15", NA)
    )
  }
)

test_that(
  "Times before field_min produce a message",
  {
    local_reproducible_output(width = 200)
    time_test <- c("06:00", "07:00", "08:00", "09:00")
    expect_message(
      validate_import_time_mm_ss(time_test,
                                 field_name = "time",
                                 field_min = "07:30",
                                 field_max = NA,
                                 logfile = ""),
      "are before the stated minimum time"
    )
  }
)

test_that(
  "Times after field_max produce a message",
  {
    local_reproducible_output(width = 200)
    time_test <- c("06:00", "07:00", "08:00", "09:00")
    expect_message(
      validate_import_time_mm_ss(time_test,
                                 field_name = "time",
                                 field_min = NA,
                                 field_max = "07:30",
                                 logfile = ""),
      "are after the stated maximum time"
    )
  }
)
# validate_import_numeric -------------------------------------------

test_that(
  "Values that can be coerced to numeric pass (including NA)",
  {
    test_numeric <- c("1.2", pi, NA_character_)
    expect_equal(
      validate_import_numeric(test_numeric,
                              field_name = "numeric",
                              field_min = NA,
                              field_max = NA,
                              logfile = ""),
      c(1.2, pi, NA_real_)
    )
  }
)

test_that(
  "Values that cannot be coerced to numeric produce a message",
  {
    local_reproducible_output(width = 200)
    test_numeric <- c("a", "b", pi)
    expect_message(
      validate_import_numeric(test_numeric,
                              field_name = "numeric",
                              field_min = NA,
                              field_max = NA,
                              logfile = ""),
      "must be numeric or coercible to numeric"
    )
  }
)

test_that(
  "Values less than field_min produce a message",
  {
    local_reproducible_output(width = 200)
    test_numeric <- 1:5
    expect_message(
      validate_import_numeric(test_numeric,
                              field_name = "numeric",
                              field_min = 3,
                              field_max = NA,
                              logfile = ""),
      "are less than the stated minimum"
    )
  }
)

test_that(
  "Values less than field_min produce a message",
  {
    local_reproducible_output(width = 200)
    test_numeric <- 1:5
    expect_message(
      validate_import_numeric(test_numeric,
                              field_name = "numeric",
                              field_min = NA,
                              field_max = 3,
                              logfile = ""),
      "are greater than the stated maximum"
    )
  }
)

# validate_import_zipcode -------------------------------------------

test_that(
  "values in 12345, format or NA pass (from numeric)",
  {
    test_zip <- c(48169, NA_real_)
    expect_equal(
      validate_import_zipcode(test_zip,
                              field_name = "zip",
                              logfile = ""),
      c("48169", NA_character_)
    )
  }
)

test_that(
  "values in 12345, 12345-1234 format or NA pass (from character)",
  {
    test_zip <- c("48169", "48169-0133", NA_real_)
    expect_equal(
      validate_import_zipcode(test_zip,
                              field_name = "zip",
                              logfile = ""),
      c("48169", "48169-0133", NA_real_)
    )
  }
)

test_that(
  "values not in 12345 or 12345-1234 format are converted to NA (so they won't write)",
  {
    test_zip <- c("8169", "48169-01", "48169-abc", "zipcode")
    expect_equal(
      validate_import_zipcode(test_zip,
                              field_name = "zip",
                              logfile = ""),
      rep(NA_character_, length(test_zip))
    )
  }
)

test_that(
  "values not in 12345 or 12345-1234 format produce a message",
  {
    test_zip <- c("8169", "48169-01", "48169-abc", "zipcode")
    expect_message(
      validate_import_zipcode(test_zip,
                              field_name = "zip",
                              logfile = ""),
      "must be in the format `12345` or `12345-1234`"
    )
  }
)
# validate_import_yesno ---------------------------------------------

test_that(
  "yes, no, 0, 1, and NA are accepted (character)",
  {
    test_yes_no <- c("no", "yes", "0", "1", "No", "Yes", "NO", "YEs", "YES", NA_character_)
    expect_equal(
      validate_import_yesno(test_yes_no,
                            field_name = "yesno",
                            logfile = ""),
      as.character(c(0, 1, 0, 1, 0, 1, 0, 1, 1, NA_real_))
    )
  }
)

test_that(
  "0, 1, and NA are accepted (numeric)",
  {
    test_yes_no <- c(0, 1, NA_real_)
    expect_equal(
      validate_import_yesno(test_yes_no,
                            field_name = "yesno",
                            logfile = ""),
      as.character(c(0, 1, NA_real_))
    )
  }
)

test_that(
  "Unacceptable values are converted to NA to prevent writing (character)",
  {
    expect_equal(
      validate_import_yesno(c("negative", "affirmative"),
                            field_name = "yesno",
                            logfile = ""),
      rep(NA_character_, 2)
    )
  }
)

test_that(
  "unacceptable values produce a message (character)",
  {
    expect_message(
      validate_import_yesno(c("negative", "affirmative"),
                            field_name = "yesno",
                            logfile = ""),
      "must be one of `0`, `1`, `No`, or `Yes`"
    )
  }
)

test_that(
  "Unacceptable values are converted to NA to prevent writing (numeric)",
  {
    expect_equal(
      validate_import_yesno(c(-1, pi, 12),
                            field_name = "yesno",
                            logfile = ""),
      rep(NA_character_, 3)
    )
  }
)

test_that(
  "unacceptable values produce a message (numeric)",
  {
    expect_message(
      validate_import_yesno(c(-1, pi, 12),
                            field_name = "yesno",
                            logfile = ""),
      "must be one of `0`, `1`, `No`, or `Yes`"
    )
  }
)

# validate_import_truefalse -----------------------------------------

test_that(
  "true, false, yes, no, 0, 1, and NA are accepted (character)",
  {
    test_true_false <- c("true", "True", "TRUE", "truE",
                         "false", "False", "FALSE", "falsE",
                         "yes", "Yes", "YES", "yeS",
                         "no", "No", "NO", "nO",
                         "0", "1", NA_character_)
    expect_equal(
      validate_import_truefalse(test_true_false,
                                field_name = "truefalse",
                                logfile = ""),
      as.character(c(1, 1, 1, 1,
                     0, 0, 0, 0,
                     1, 1, 1, 1,
                     0, 0, 0, 0,
                     0, 1, NA_real_))
    )
  }
)

test_that(
  "0, 1, and NA are accepted (numeric)",
  {
    test_true_false <- c(0, 1, NA_real_)
    expect_equal(
      validate_import_truefalse(test_true_false,
                                field_name = "truefalse",
                                logfile = ""),
      as.character(c(0, 1, NA_real_))
    )
  }
)

test_that(
  "TRUE, FALSE, and NA are accepted (logical)",
  {
    test_true_false <- c(TRUE, FALSE, NA)
    expect_equal(
      validate_import_truefalse(test_true_false,
                                field_name = "truefalse",
                                logfile = ""),
      as.character(c(1, 0, NA_real_))
    )
  }
)

test_that(
  "Unacceptable values are converted to NA to prevent writing (character)",
  {
    expect_equal(
      validate_import_truefalse(c("negative", "affirmative"),
                                field_name = "truefalse",
                                logfile = ""),
      rep(NA_character_, 2)
    )
  }
)

test_that(
  "unacceptable values produce a message (character)",
  {
    expect_message(
      validate_import_truefalse(c("negative", "affirmative"),
                                field_name = "truefalse",
                                logfile = ""),
      "must be one of logical or one of `0`, `1`, `No`, `Yes`, `False`, or `True`"
    )
  }
)

test_that(
  "Unacceptable values are converted to NA to prevent writing (numeric)",
  {
    expect_equal(
      validate_import_truefalse(c(-1, pi, 12),
                                field_name = "truefalse",
                                logfile = ""),
      rep(NA_character_, 3)
    )
  }
)

test_that(
  "unacceptable values produce a message (numeric)",
  {
    expect_message(
      validate_import_truefalse(c(-1, pi, 12),
                            field_name = "truefalse",
                            logfile = ""),
      "must be one of logical or one of `0`, `1`, `No`, `Yes`, `False`, or `True`"
    )
  }
)


# validate_import_select_dropdown_radio -----------------------------

test_that(
  "mapped pairings with numeric and character codes pass (also NA)",
  {
    test_select <- c("-1", "0", "1", "a", "abc",
                     "negative one", "zero", "one", "A", "ABC",
                     NA_character_)
    mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
    expect_equal(
      validate_import_select_dropdown_radio(test_select,
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      c("-1", "0", "1", "a", "abc",
        "-1", "0", "1", "a", "abc",
        NA_character_)
    )
  }
)

test_that(
  "mapped pairings with overlap convert properly",
  {
    test_select <- c("Less than 1", as.character(c(1:4)))
    mapping <- "1, Less than 1 | 2, 1 | 3, 2 | 4, 3 | 5, 4"
    expect_equal(
      validate_import_select_dropdown_radio(test_select,
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      as.character(1:5)
    )
  }
)

test_that(
  "mapped pairings with numeric and character codes pass (also NA)",
  {
    test_select <- c(-1, 0, 1, NA_real_)
    mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
    expect_equal(
      validate_import_select_dropdown_radio(test_select,
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      c("-1", "0", "1",NA_character_)
    )
  }
)

test_that(
  "unmapped values are converted to NA (character)",
  {
    mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
    expect_equal(
      validate_import_select_dropdown_radio(c("XYZ", "15"),
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      c(NA_character_, NA_character_)
    )
  }
)

test_that(
  "unmapped values are converted to NA (numeric)",
  {
    mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
    expect_equal(
      validate_import_select_dropdown_radio(c(pi, 10),
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      c(NA_character_, NA_character_)
    )
  }
)

test_that(
  "unmapped values produce a message (character)",
  {
    local_reproducible_output(width = 200)
    mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
    expect_message(
      validate_import_select_dropdown_radio(c("XYZ", "15"),
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      "must be one of '-1', '0', '1', 'a', 'abc', 'negative one', 'zero', 'one', 'A', 'ABC'"
    )
  }
)

test_that(
  "unmapped values produce a message (numeric)",
  {
    local_reproducible_output(width = 200)
    mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
    expect_message(
      validate_import_select_dropdown_radio(c(pi, 10),
                                            field_name = "select",
                                            field_choice = mapping,
                                            logfile = ""),
      "must be one of '-1', '0', '1', 'a', 'abc', 'negative one', 'zero', 'one', 'A', 'ABC'"
    )
  }
)

# validate_import_email ---------------------------------------------

test_that(
  "common email addresses pass",
  {
    email <- c("somebody@domain.net",
               "some.body1@domain.org",
               "345somebody789@domain.net",
               "somebody-else@domain.com",
               "salesperson@dash-company.biz",
               "percy_jackson@camp-half-blood.edu",
               "someone+spam@domain.widget",
               "high%shooting@sports.ball",
               NA_character_)
    expect_equal(
      validate_import_email(email,
                            field_name = "email",
                            logfile = ""),
      email
    )
  }
)

test_that(
  "Invalid e-mails are changed to NA",
  {
    email <- c("Im@work@nowhere.net",
               "no-suffix@junkmail",
               "one-length-suffix@email.g",
               "long-suffix@email.sunburst")
    expect_equal(
      validate_import_email(email,
                            field_name = "email",
                            logfile = ""),
      rep(NA_character_, length(email))
    )
  }
)

test_that(
  "Invalid e-mails are changed to NA",
  {
    email <- c("Im@work@nowhere.net",
               "no-suffix@junkmail",
               "one-length-suffix@email.g",
               "long-suffix@email.sunburst")
    expect_message(
      validate_import_email(email,
                            field_name = "email",
                            logfile = ""),
      "are not valid e-mail addresses"
    )
  }
)

# validate_import_phone ---------------------------------------------

test_that(
  "valid phone numbers pass (including NA)",
  {
    phone_punct <- c("(207) 555-1234",
                     "207.555.1234",
                     "207-555-1234",
                     "207 555 1234")
    # to test all valid phone numbers would be overly tedious.
    # we'll just a sample. Change n_size to match your desired rigor
    n_size <- 10
    phone_random <- sprintf("%s%s%s %s%s%s %s%s%s%s",
                            sample(2:9, n_size, replace = TRUE),
                            sample(0:8, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE),
                            sample(2:9, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE),
                            sample(0:9, n_size, replace = TRUE))
    test_phone <- c(phone_punct, phone_random, NA_character_)

    expect_equal(
      validate_import_phone(test_phone,
                            field_name = "phone",
                            logfile = ""),
      gsub("[[:punct:][:space:]]", "", test_phone)
    )
  }
)

test_that(
  "phone numbers of more than 10 digits become NA",
  {
    expect_equal(
      validate_import_phone(c("555-555-5555-5",
                              "555-555-5555-5555"),
                            field_name = "phone",
                            logfile = ""),
      c(NA_character_, NA_character_)
    )
  }
)

test_that(
  "phone numbers of more than ten digits produce a message",
  {
    expect_message(
      validate_import_phone(c("555-555-5555-5",
                              "555-555-5555-5555"),
                            field_name = "phone",
                            logfile = ""),
      "are not ten digit phone numbers"
    )
  }
)

test_that(
  "phone numbers with invalid format become NA",
  {
    # The fives are valid digits. The non-five digits
    # are placed where those values are not allowed
    expect_equal(
      validate_import_phone(c("055-555-5555",
                              "155-555-5555",
                              "595-555-5555",
                              "555-155-5555"),
                            field_name = "phone",
                            logfile = ""),
      c(NA_character_, NA_character_, NA_character_, NA_character_)
    )
  }
)

test_that(
  "phone numbers with invalid format produce a message",
  {
    expect_message(
      validate_import_phone(c("055-555-5555",
                              "155-555-5555",
                              "595-555-5555",
                              "555-155-5555"),
                            field_name = "phone",
                            logfile = ""),
      "are not valid North American phone numbers"
    )
  }
)

test_that(
  "Validate number with fixed decimal places (number_1dp, etc)",
  {
    # number_1dp
    expect_equal(validate_import_ndp(c(23, pi),
                                     field_name = "number_1dp",
                                     field_min = 0,
                                     field_max = 100,
                                     logfile = "",
                                     ndp = 1,
                                     comma = FALSE),
                 c("23.0", "3.1"))

    # number_2dp
    expect_equal(validate_import_ndp(c(23, pi),
                                     field_name = "number_1dp",
                                     field_min = 0,
                                     field_max = 100,
                                     logfile = "",
                                     ndp = 2,
                                     comma = FALSE),
                 c("23.00", "3.14"))

    # number_1dp_comma
    expect_equal(validate_import_ndp(c(23, pi),
                                     field_name = "number_1dp",
                                     field_min = 0,
                                     field_max = 100,
                                     logfile = "",
                                     ndp = 1,
                                     comma = TRUE),
                 c("23,0", "3,1"))

    # number_2dp_comma
    expect_equal(validate_import_ndp(c(23, pi),
                                     field_name = "number_1dp",
                                     field_min = 0,
                                     field_max = 100,
                                     logfile = "",
                                     ndp = 2,
                                     comma = TRUE),
                 c("23,00", "3,14"))
  }
)

Try the redcapAPI package in your browser

Any scripts or data that you put into this service are public.

redcapAPI documentation built on Dec. 9, 2025, 5:07 p.m.