Error in `puncts_to_pattern(names(sep_analysis$counts$statement_sep))`: object 'multis_pattern' not found

## survey_data combines raw data (`dat`) with a metadata dictionary (`dpdict`), and many operations depend
## on that pairing staying aligned. The tests in this file check dpdict/dat updates, validation error
## messages, and metadata propagation behaviours.
##### Data/dpdict update functions #####
# Checks functions that apply dpdict changes back onto data (names, labels, value labels) and preserve survey_data.
temp_dpdict$variable_labels[1] <- "New Var1 Label"
temp_dpdict$value_labels[[2]] <- c("A"=1, "B"=2, "C"=3) # Add value labels to second var
expect_equal(names(updated_dat)[2], names(temp_dat)[2]) # Unchanged name
expect_equal(attr(updated_dat[[1]], "label"), "New Var1 Label")
expect_equal(attr(updated_dat[[2]], "label"), attr(temp_dat[[2]], "label")) # Unchanged label
expect_null(attr(updated_dat[[1]], "labels")) # Original had no value labels
expect_equal(attr(updated_dat[[2]], "labels"), c("A"=1, "B"=2, "C"=3))
expect_equal(attr(updated_survey_obj$dat[[2]], "labels"), c("A"=1, "B"=2, "C"=3))
expect_error(update_dat_from_dpdict(temp_dat, mismatched_dpdict), "Some data columns don't match either variable_names or old_variable_names in dpdict")
##### Alias and question dictionary updates #####
# Checks alias updates and how those changes propagate through dpdict (including survey_data wrappers).
original_description <- temp_dpdict$question_description[temp_dpdict$question_alias == original_alias][1]
original_alias_with_suffix <- temp_dpdict$alias_with_suffix[temp_dpdict$question_alias == original_alias][1]
# Description should update the prefix part
expect_false(grepl(sub("_.*", "", original_alias), updated_dpdict$question_description[temp_dpdict$question_group == questions_dict$question_group[1]][1]))
invalid_questions_dict <- questions_dict[, "question_group", drop=FALSE]
##### Validation error-message contracts #####
# Checks that dpdict/dat validation returns detailed, user-actionable errors for common mismatch scenarios.
test_that("validate_dat_dpdict_alignment provides detailed error messages", {
variable_labels = c("Variable A", "Variable B")
"DIMENSION_MISMATCH.*Expected: dpdict should have one row per dat column \\(3 rows\\).*Actual: dpdict has 2 rows",
var_names = c("a", "b", "c"),  # Wrong column name
"MISSING_REQUIRED_COLUMNS.*Expected: dpdict must contain columns: variable_names, variable_labels.*Missing columns: variable_names, variable_labels",
# Test 3: Variable names mismatch with detailed positioning
variable_names = c("x", "b", "z"),  # 'a' and 'c' don't match
variable_labels = c("Variable X", "Variable B", "Variable Z")
"VARIABLE_NAMES_MISMATCH.*Variables in dat but not in dpdict\\$variable_names.*\\[1\\] 'a'.*\\[3\\] 'c'.*Variables in dpdict\\$variable_names but not in dat.*\\[1\\] 'x'.*\\[3\\] 'z'",
# Test 4: Variable names found in old_variable_names with helpful suggestions
variable_names = c("new_a", "new_b", "new_c"),
variable_labels = c("Variable A", "Variable B", "Variable C"),
old_variable_names = c("a", "b", "c")  # Original names match dat
"VARIABLE_NAMES_MISMATCH.*Variables found in dpdict\\$old_variable_names.*'a' -> should be 'new_a' \\(dpdict row 1\\).*Consider running update_dat_from_dpdict\\(\\) first",
# Test 5: Variable labels mismatch (using labeled data)
attr(test_dat_labeled$a, "label") <- "Label A"
attr(test_dat_labeled$b, "label") <- "Label B"
attr(test_dat_labeled$c, "label") <- "Label C"
variable_labels = c("Different Label A", "Label B", "Different Label C")
"VARIABLE_LABELS_MISMATCH.*Labels in dat but not in dpdict\\$variable_labels.*'Label A'.*'Label C'",
# Test enhanced validate_no_dpdict_duplicates() function
test_that("validate_no_dpdict_duplicates provides detailed error messages", {
# Test 1: Duplicate variable names with positioning details
variable_names = c("q1", "q2", "q1", "q3", "q2"),  # q1 and q2 are duplicated
variable_labels = c("Question 1", "Question 2", "Question 1 Again", "Question 3", "Question 2 Again")
validate_no_dpdict_duplicates(test_dpdict_dup_names, check_variable_labels = FALSE, check_alias_with_suffix = FALSE),
"DUPLICATE_VARIABLE_NAMES.*Variable name: 'q1'.*Appears at dpdict rows: 1, 3.*Associated labels:.*\\[1\\]: 'Question 1'.*\\[3\\]: 'Question 1 Again'.*Variable name: 'q2'.*Appears at dpdict rows: 2, 5",
# Test 2: Duplicate variable labels with positioning details
variable_labels = c("Same Label", "Different Label", "Same Label", "Another Label")
validate_no_dpdict_duplicates(test_dpdict_dup_labels, check_variable_names = FALSE, check_alias_with_suffix = FALSE),
"DUPLICATE_VARIABLE_LABELS.*Variable label: 'Same Label'.*Appears at dpdict rows: 1, 3.*Associated variable names:.*\\[1\\]: 'q1'.*\\[3\\]: 'q3'",
# Test 3: Duplicate alias_with_suffix with context
variable_labels = c("Scale 1 Item 1", "Scale 1 Item 2", "Scale 2 Item 1", "Scale 2 Item 2"),
alias_with_suffix = c("scale_1", "scale_2", "scale_1", "scale_4")  # scale_1 duplicated
validate_no_dpdict_duplicates(test_dpdict_dup_alias, check_variable_names = FALSE, check_variable_labels = FALSE),
"DUPLICATE_ALIAS_WITH_SUFFIX.*Alias with suffix: 'scale_1'.*Appears at dpdict rows: 1, 3.*Associated variables:.*\\[1\\]: 'sc1_1' \\('Scale 1 Item 1'\\).*\\[3\\]: 'sc2_1' \\('Scale 2 Item 1'\\)",
# Test 4: Multiple types of duplicates in one validation
variable_names = c("q1", "q1", "q3"),  # duplicate names
variable_labels = c("Label A", "Label B", "Label A"),  # duplicate labels
alias_with_suffix = c("alias1", "alias2", "alias1")  # duplicate aliases
# Test 5: Proper handling of NA values (should not be flagged as duplicates)
variable_labels = c("Label 1", NA, NA),  # NAs should not be considered duplicates
# Test enhanced validate_variable_names() function
test_that("validate_variable_names provides detailed error explanations", {
"Variable name validation failed.*\\[1\\] '1q'.*starts with number \\(must start with letter\\).*\\[2\\] '2var'.*starts with number \\(must start with letter\\)",
"contains invalid character\\(s\\): '\\.'.*contains invalid character\\(s\\): '-'.*contains invalid character\\(s\\): '@'",
# Test 3: Names starting with special characters
"\\[1\\] '_var'.*starts with underscore \\(must start with letter\\).*\\[2\\] '\\.name'.*starts with special character \\(must start with letter\\).*\\[3\\] '#question'.*starts with special character \\(must start with letter\\)",
"\\[1\\] 'q_a'.*underscore not followed by number.*\\[2\\] 'var_'.*ends with underscore.*\\[3\\] 'q__1'.*contains consecutive underscores.*\\[4\\] 'sc_x2'.*underscore not followed by number",
# Test 5: Multiple violations in single name
"\\[1\\] '1q\\.a_b'.*starts with number.*contains invalid character\\(s\\): '\\.'.*underscore not followed by number",
# Test 6: Valid names should pass without error
expect_true(validate_variable_names(c("q1", "Q1", "SC1_1", "satisfaction_1", "SC1a_1", "SC1_1oe")))
# Test 7: Check that the examples in error message are actually valid
valid_examples <- c("q1", "Q1", "SC1_1", "satisfaction_1", "SC1a_1", "SC1_1oe")
# Test warning behavior (warn_only = TRUE)
test_that("validation functions provide same detailed messages for warnings", {
# Test that warning messages contain the same detail as error messages
test_dat <- data.frame(a = 1:2, b = 3:4)
variable_names = c("x", "y"),  # Names don't match
variable_labels = c("Variable X", "Variable Y")
result <- validate_dat_dpdict_alignment(test_dat, test_dpdict, warn_only = TRUE),
"VARIABLE_NAMES_MISMATCH.*Variables in dat but not in dpdict\\$variable_names.*\\[1\\] 'a'.*\\[2\\] 'b'"
variable_labels = c("Label 1", "Label 2")
result <- validate_no_dpdict_duplicates(test_dpdict_dups, warn_only = TRUE),
"DUPLICATE_VARIABLE_NAMES.*Variable name: 'q1'.*Appears at dpdict rows: 1, 2"
# Test warning for invalid variable names
result <- validate_variable_names(c("1invalid"), warn_only = TRUE),
"\\[1\\] '1invalid'.*starts with number \\(must start with letter\\)"
# Test successful validation (should return TRUE invisibly)
test_that("validation functions return TRUE for valid inputs", {
test_dat <- data.frame(a = 1:3, b = 4:6)
attr(test_dat$a, "label") <- "Variable A"
attr(test_dat$b, "label") <- "Variable B"
variable_labels = c("Question 1", "Question 2", "Question 3"),
alias_with_suffix = c("alias1", "alias2", "alias3")
test_that("validation functions handle edge cases appropriately", {
validate_dat_dpdict_alignment(data.frame(), data.frame(variable_names = character(), variable_labels = character())),
NA  # Should not error for empty but aligned data
single_dat <- data.frame(single_var = 1:5)
attr(single_dat$single_var, "label") <- "Single Variable"
# Check validation with missing alias_with_suffix column (should not error)
variable_labels = c("Label A", "Label B")
dpdict_prefill <- create_dict(temp_dat, prefill = TRUE)
dpdict_no_prefill <- create_dict(temp_dat, prefill = FALSE)
expect_named(dpdict_prefill, c("old_variable_names", "old_variable_labels", "old_value_labels", "variable_names", "variable_labels", "value_labels"))
expect_error(create_dict(empty_dat), "temp_dat must be a dataframe with more than zero columns")
dat_no_labels <- data.frame(a = 1:3, b = letters[1:3])
# tests for correct definition of multiresponse questiontype:
temp_dat <- data.frame("Q1_1" = haven::labelled(c(0, 0, 1, NA_real_), label = "Q1_1: Select all that apply - Statement 1", labels = c("Not selected" = 0, "Selected" = 1)),
"Q1_2" = haven::labelled(c(0, 0, 0, 0), label = "Q1_2: Select all that apply - Statement 2", labels = c("Not selected" = 0, "Selected" = 1)),
"Q1_3" = haven::labelled(c(0, 1, 0, 0), label = "Q1_3: Select all that apply - Statement 3", labels = c("Not selected" = 0, "Selected" = 1)),
"Q1_4" = haven::labelled(c(0, 0, NA, 0), label = "Q1_4: Select all that apply - Statement 4", labels = c("Not selected" = 0, "Selected" = 1)))
# Single-variable group - even with non-zero values, shouldn't be multiresponse
"Q1_1" = haven::labelled(c(1, 0, 1, NA_real_),
label = "Q1_1: Single variable question",
labels = c("Not selected" = 0, "Selected" = 1)),
# Multi-variable group - should be detected as multiresponse
"Q2_1" = haven::labelled(c(0, 1, 0, NA_real_),
label = "Q2_1: Multi variable question - Statement 1",
label = "Q2_2: Multi variable question - Statement 2",
labels = c("Not selected" = 0, "Selected" = 1))
# Create dpdict and run update_dict_with_metadata
temp_dpdict <- create_dict(temp_dat, prefill = TRUE)
updated_dpdict <- update_dict_with_metadata(NULL, temp_dat, temp_dpdict)
# Check question groups are assigned correctly
q1_group <- updated_dpdict$question_group[updated_dpdict$variable_names == "Q1_1"]
q2_group_1 <- updated_dpdict$question_group[updated_dpdict$variable_names == "Q2_1"]
q2_group_2 <- updated_dpdict$question_group[updated_dpdict$variable_names == "Q2_2"]
# First verify the grouping is as expected
expect_false(q1_group %in% c(q2_group_1, q2_group_2)) # Q1 should be in a different group
expect_equal(q2_group_1, q2_group_2) # Q2 variables should be in the same group
# Would benefit from more tests here, including for ill-formed dats
# expect warnings due to most variables initialising with NA
expect_warning(updated_partial_dpdict <- update_dict_with_metadata(NULL, temp_dat, temp_dpdict, variables_to_update = variables_to_update))
# Check if metadata is updated only for the first two variables
# Test error handling for misaligned inputs
# Test 1: Basic dataset with consistent separators
attr(basic_dat$Q1_1, "label") <- "Q1: First question - Statement 1"
attr(basic_dat$Q1_2, "label") <- "Q1: First question - Statement 2"
attr(basic_dat$Q2_1, "label") <- "Q2: Second question - Statement 1"
# Test 2: Dataset with inconsistent varname separators
attr(inconsistent_dat$Q1_1, "label") <- "Q1: First question - Statement 1"
attr(inconsistent_dat$Q1.2, "label") <- "Q1: First question - Statement 2"
attr(inconsistent_dat$Q2_1, "label") <- "Q2: Second question - Statement 1"
# Test 3: Dataset with inconsistent prefix separators
attr(inconsistent_dat$Q1_2, "label") <- "Q1. First question - Statement 2"
# Test 4: Dataset with inconsistent statement separators
attr(inconsistent_dat$Q1_2, "label") <- "Q1: First question : Statement 2"
expect_error(check_seps(c(1, 2, 3)), "Input must be a data frame")
attr(no_sep_dat$Q1, "label") <- "First question"
attr(no_sep_dat$Q2, "label") <- "Second question"
test_string <- "Q1: Main question text - Statement 1 - Sub statement A"
suffix_df <- get_affix_df(test_string, affix_type = "suffix", seps_priority = seps)
expect_named(suffix_df, c("sep_type", "location_found", "sep_count_from_end", "affix_found", "starts_with_cap"))
expect_in(c("Statement 1 - Sub statement A", "Sub statement A", "Main question text - Statement 1 - Sub statement A"), suffix_df$affix_found)
expect_equal(suffix_df$sep_count_from_end[suffix_df$affix_found == "Statement 1 - Sub statement A"], 2)
expect_equal(suffix_df$sep_count_from_end[suffix_df$affix_found == "Sub statement A"], 1)
expect_equal(suffix_df$sep_count_from_end[suffix_df$affix_found == "Main question text - Statement 1 - Sub statement A"], 1)
expect_equal(suffix_df$sep_type[suffix_df$affix_found == "Statement 1 - Sub statement A"], " - ")
expect_equal(suffix_df$sep_type[suffix_df$affix_found == "Sub statement A"], " - ")
expect_equal(suffix_df$sep_type[suffix_df$affix_found == "Main question text - Statement 1 - Sub statement A"], ": ")
prefix_df <- get_affix_df(test_string, affix_type = "prefix", seps_priority = seps)
expect_named(prefix_df, c("sep_type", "location_found", "sep_count_from_start", "affix_found", "starts_with_cap"))
expect_in(c("Q1: Main question text", "Q1", "Q1: Main question text - Statement 1"), prefix_df$affix_found)
expect_equal(prefix_df$sep_count_from_start[prefix_df$affix_found == "Q1: Main question text"], 1)
expect_equal(prefix_df$sep_count_from_start[prefix_df$affix_found == "Q1: Main question text - Statement 1"], 2)
expect_equal(prefix_df$sep_type[prefix_df$affix_found == "Q1: Main question text"], " - ")
expect_equal(prefix_df$sep_type[prefix_df$affix_found == "Q1"], ": ")
expect_equal(prefix_df$sep_type[prefix_df$affix_found == "Q1: Main question text - Statement 1"], " - ")
expect_true(is.na(get_affix_df("NoSeps", affix_type = "suffix", seps_priority = seps)))
expect_error(get_affix_df("", affix_type = "suffix", seps_priority = seps))
test_string_trailing_sep <- "Text with sep - "
suffix_df_unfiltered <- get_affix_df(test_string_trailing_sep, affix_type = "suffix", seps_priority = c(" - "), filter_results = FALSE)
expect_equal(suffix_df_unfiltered$affix_found, "") # Empty suffix
suffix_df_filtered <- get_affix_df(test_string_trailing_sep, affix_type = "suffix", seps_priority = c(" - "), filter_results = TRUE)
expect_true(is.na(suffix_df_filtered)) # Should be removed by filter
inconsistent_dat <- data.frame(Q1_1 = 1, Q1.2 = 2, Q3_1 = 3)
attr(inconsistent_dat$Q1_1, "label") <- "Q1: Question A - Statement 1"
attr(inconsistent_dat$Q1.2, "label") <- "Q1. Question A - Statement 2" # Inconsistent prefix sep
attr(inconsistent_dat$Q3_1, "label") <- "Q3: Question B : Statement X" # Inconsistent statement sep
# Expected analysis: var_name inconsistent (_ vs .), prefix inconsistent (: vs .), statement inconsistent (- vs :)
# Test updating to most common (should pick "_" for varname, ": " for prefix, " - " for statement if Q1_1 label is more common)
# Let's assume "_" , ": ", " - " are most common based on analysis (adjust if check_seps logic differs)
seps_to_use_common <- list(var_name_sep = "_", prefix_sep = ": ", statement_sep = " - ") # Manually set expected most common
updated_seps_common <- get_updated_seps(inconsistent_dat, sep_analysis, seps_to_use = seps_to_use_common)
expect_equal(updated_seps_common$new_variable_names, c("Q1_1", "Q1_2", "Q3_1")) # Q1.2 corrected
expect_equal(updated_seps_common$new_variable_labels, c("Q1: Question A - Statement 1", "Q1: Question A - Statement 2", "Q3: Question B - Statement X")) # Prefix and statement seps corrected
seps_to_use_specific <- list(var_name_sep = ".", prefix_sep = ". ", statement_sep = " : ")
updated_seps_specific <- get_updated_seps(inconsistent_dat, sep_analysis, seps_to_use = seps_to_use_specific)
expect_equal(updated_seps_specific$new_variable_labels, c("Q1. Question A : Statement 1", "Q1. Question A : Statement 2", "Q3. Question B : Statement X"))
no_sep_dat <- data.frame(Q1 = 1, Q2 = 2)
attr(no_sep_dat$Q1, "label") <- "Question 1"
attr(no_sep_dat$Q2, "label") <- "Question 2"
expect_equal(no_sep_updated$new_variable_names, names(no_sep_dat)) # Should be unchanged
expect_equal(no_sep_updated$new_variable_labels, c("Question 1", "Question 2")) # Should be unchanged
test_that("get_updated_seps correctly handles separator position indexing", {
# This test specifically addresses the bug where matched_sep (position in sep_portion)
# was incorrectly used as an index into the full string
# Test case 1: Variable names with different lengths before separator
# This ensures the fix correctly converts sep_portion indices to full string indices
A_1 = 1,           # Short prefix before sep
ABC_2 = 2,         # Medium prefix before sep
ABCDEF_3 = 3,      # Long prefix before sep
Q1.test = 4        # Different sep to be updated
attr(test_dat1$A_1, "label") <- "A: Label 1 - Statement 1"
attr(test_dat1$ABC_2, "label") <- "ABC: Label 2 - Statement 2"
attr(test_dat1$ABCDEF_3, "label") <- "ABCDEF: Label 3 - Statement 3"
attr(test_dat1$Q1.test, "label") <- "Q1. Label 4 - Statement 4"
seps_to_use1 <- list(var_name_sep = "_", prefix_sep = ": ", statement_sep = " - ")
result1 <- get_updated_seps(test_dat1, sep_analysis1, seps_to_use = seps_to_use1)
# All variable names should have consistent "_" separator
expect_equal(result1$new_variable_names, c("A_1", "ABC_2", "ABCDEF_3", "Q1_test"))
# All labels should have consistent separators
# Verify the separator was found at the correct position for each variable
expect_equal(result1$var_name_seps_found, c("_", "_", "_", "."))
# Test case 2: Mix of separators at different positions
attr(test_dat2$X.A, "label") <- "X. Prefix A - Stat"
attr(test_dat2$YY_B, "label") <- "YY: Prefix B - Stat"
attr(test_dat2$ZZZ.C, "label") <- "ZZZ. Prefix C - Stat"
seps_to_use2 <- list(var_name_sep = ".", prefix_sep = ". ", statement_sep = " - ")
result2 <- get_updated_seps(test_dat2, sep_analysis2, seps_to_use = seps_to_use2)
# Should correctly update separators regardless of prefix length
# Test case 3: Verify actual character replacement happens at correct position
# Create a case where the bug would manifest if not fixed
test_dat3 <- data.frame(LONG_VAR_NAME_test = 1)
attr(test_dat3$LONG_VAR_NAME_test, "label") <- "LONG_VAR_NAME. Something"
seps_to_use3 <- list(var_name_sep = "_", prefix_sep = ": ", statement_sep = " - ")
result3 <- get_updated_seps(test_dat3, sep_analysis3, seps_to_use = seps_to_use3)
# The separator before "test" should be correctly identified and replaced
# Ensure the prefix separator is also correctly updated
seps_to_use <- list( variable_name_sep = "_", prefix_sep = ": ", statement_sep = " - ")
temp_dat <- data.frame("Q1_1" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_1: Select all that apply - Statement 1"),
"Q1_2" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_2: Select all that apply - Statement 2"),
"Q1_3" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_3: Select all that apply - Statement 3"),
"Q1_4" = haven::labelled(sample(c("0", "1", NA_character_), n, replace = TRUE), label = "Q1_4: Select all that apply - Statement 5"))
temp_dict <- create_dict(temp_dat, prefill = TRUE)
temp_dict <- temp_dict[, !(names(temp_dict) %in% c("old_variable_names", "old_variable_labels", "old_value_labels"))]
test_result <- split_into_question_groups(temp_dict, temp_dat, variables_to_process = NULL, seps_to_use = seps_to_use, ignorelabelbeforeprefix = TRUE, config = config1)
expected_test_result <- c("Q1_a", "Q1_a", "Q1_a", "Q1_b")
temp_dat <- data.frame("Q1_1" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_1: Select all that apply - Statement 1", labels = c("Not selected" = 0, "Selected" = 1)),
"Q1_2" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_2: Select all that apply - Statement 2", labels = c("Not selected" = 0, "Selected" = 1)),
"Q1_3" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_3: Select all that apply - Statement 3", labels = c("Not selected" = 0, "Selected" = 1)),
"Q1_4" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_4: Select all that apply - Statement 4"))
test_result <- split_into_question_groups(temp_dict, temp_dat, variables_to_process = NULL, seps_to_use = seps_to_use, ignorelabelbeforeprefix = TRUE, config = config2)
"Q2_1" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q2_1: Select all that apply - Statement 1"),
"Q1_3" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_3: Select all that apply - Statement 3"))
test_result <- split_into_question_groups(temp_dict, temp_dat, variables_to_process = NULL, seps_to_use = seps_to_use, ignorelabelbeforeprefix = TRUE, config = config3)
expected_test_result <- c("Q1_a", "Q1_a", "Q2_a", "Q1_b")
# test 4 - split by commonlabel, no findlongest, no ignoreprefix
"Q1_4" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_4: Click one of these - Statement 4"))
test_result <- split_into_question_groups(temp_dict, temp_dat, variables_to_process = NULL, seps_to_use = seps_to_use, ignorelabelbeforeprefix = FALSE, config = config4)
expected_test_result <- c("Q1_a", "Q1_b", "Q1_c", "Q1_d")
# test 5 - split by commonlabel, no findlongest, do ignoreprefix
test_result <- split_into_question_groups(temp_dict, temp_dat, variables_to_process = NULL, seps_to_use = seps_to_use, ignorelabelbeforeprefix = TRUE, config = config5)
# test 6 - split by commonlabel, do findlongest
temp_dat <- data.frame("Q1_1" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_1: Select all that apply Statement 1"),
"Q1_2" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_2: Select all that apply Statement 2"),
"Q1_3" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_3: Select all that apply Statement 3"),
"Q1_4" = haven::labelled(sample(c(0, 1, NA_real_), n, replace = TRUE), label = "Q1_4: Click one of these Statement 4"))
test_result <- split_into_question_groups(temp_dict, temp_dat, variables_to_process = NULL, seps_to_use = seps_to_use, ignorelabelbeforeprefix = TRUE, config = config6)
expect_equal(attr(get_longest_common_substring("boat", "boar", fromstart=TRUE), "lcs_distance"), 3)
expect_equal(attr(get_longest_common_substring("banana", "cabana", fromstart=FALSE), "lcs_distance"), 4)
expect_equal(get_unique_suffixes(create_dict_with_metadata(get_big_test_dat())), c(NA, NA, "a single 'word' of random characters", NA, NA, NA, NA,
"statement 1", "statement 2", "statement 1", "statement 2",
"statement 1 - attribute 1", "statement 1 - attribute 2",
"statement 2 - attribute 1", "statement 2 - attribute 2",
NA, NA, NA, NA, "statement 1", "statement 2",
questions_dict <- create_questions_dict(NULL, temp_dpdict, editfirst = FALSE)
expect_named(questions_dict, c("question_group", "question_lcs", "question_alias", "question_description", "question_folder"))
expect_equal(questions_dict$question_alias, questions_dict$question_group) # Default behaviour
expect_error(create_questions_dict(NULL, temp_dpdict[, "variable_names", drop = FALSE]), "dpdict must include columns 'question_group'")
# Test behaviour when question_lcs is not present initially (should calculate it)
temp_dpdict_no_lcs <- temp_dpdict[, !(names(temp_dpdict) %in% "question_lcs")]
questions_dict_no_lcs <- create_questions_dict(NULL, temp_dpdict_no_lcs, editfirst = FALSE)
expect_false(any(is.na(questions_dict_no_lcs$question_lcs))) # Should have calculated LCS
expect_true(all(c("question_group", "questiontype", "question_alias", "question_description") %in% names(questions_dict)))
expect_error(get_questions_dict(data.frame(a=1)), "dpdict must at a minimum have a question group variable")
alias_to_split <- "labelledmultiresponsegrid_a" # From the example dataset structure
example_stem <- "statement 1" # Stem to move
count_before_repeat <- 2 # Number of attributes per statement
# Find the original alias and suffix for a specific variable in the grid
original_alias <- temp_dpdict$question_alias[temp_dpdict$question_alias == alias_to_split][1]
original_suffix <- temp_dpdict$question_suffix[temp_dpdict$question_alias == alias_to_split][1] # e.g., "statement 1 - attribute 1"
updated_dpdict <- split_grid_labels(temp_dpdict, alias_to_split, example_stem, count_before_repeat)
# Check the first variable that was part of the split group
updated_var_row <- updated_dpdict[temp_dpdict$question_alias == alias_to_split, ][1, ]
expect_equal(updated_var_row$question_alias, paste0(original_alias, " - ", example_stem))
# New suffix should be what was after the stem
expect_equal(updated_var_row$question_suffix, gsub(paste0(example_stem, " - "), "", original_suffix))
# Check another variable in the same original grid
original_suffix_next <- temp_dpdict$question_suffix[temp_dpdict$question_alias == alias_to_split][count_before_repeat + 1] # e.g., "statement 2 - attribute 1"
next_stem <- gsub(" - .*", "", original_suffix_next) # "statement 2"
updated_var_row_next <- updated_dpdict[temp_dpdict$question_alias == alias_to_split, ][count_before_repeat + 1, ]
expect_equal(updated_var_row_next$question_alias, paste0(original_alias, " - ", next_stem))
expect_equal(updated_var_row_next$question_suffix, gsub(paste0(next_stem, " - "), "", original_suffix_next))
expect_error(split_grid_labels(temp_dpdict, "nonexistent_alias", example_stem, count_before_repeat), "`alias_to_split` .* not found")
expect_warning(split_grid_labels(temp_dpdict, alias_to_split, example_stem, 100), "`count_before_repeat` is greater than the number of variables")
# Test survey data object creation and validation
# Create with automatic dpdict generation
expect_equal(nrow(survey_obj2$dpdict), ncol(dat)) # dpdict created
expect_error(create_survey_data(as.matrix(dat)), "'dat' must be a data frame")
expect_error(create_survey_data(dat, as.list(dpdict)), "'dpdict' must be a data frame")
expect_error(validate_survey_data(bad_obj1), "Both 'dat' and 'dpdict' must be data frames")
bad_obj2$dpdict <- bad_obj2$dpdict[-1, ] # Misalign dpdict
expect_warning(expect_error(validate_survey_data(bad_obj2), "Misalignment between dat and dpdict"))
names(bad_obj3$dat)[2] <- names(bad_obj3$dat)[1] # Duplicate names
bad_obj3$dpdict$variable_names[2] <- bad_obj3$dpdict$variable_names[1] # Duplicate names
expect_invisible(print(survey_obj)) # Should return object invisibly
expect_equal(nrow(sub_row$dpdict), ncol(survey_obj$dat)) # dpdict rows shouldn't change
sub_col_name <- survey_obj[, c(original_names[1], original_names[3])]
sub_both <- survey_obj[1, 1, drop = FALSE] # Ensure drop=FALSE keeps structure
expect_error(survey_obj[, 1000], "Column subscript out of bounds")
expect_error(survey_obj[, "nonexistent_col"], "Unknown column names")
expect_error(survey_obj[[100]], "Column subscript out of bounds")
survey_obj <- create_survey_data(get_minimal_labelled_test_dat()) # Assumes 'uid' column exists
filtered_obj <- filter(survey_obj, uid > 1)
expect_equal(filtered_obj$dpdict, survey_obj$dpdict) # dpdict should be unchanged
selected_obj <- select(survey_obj, uid, csat)
renamed_obj <- select(survey_obj, user_id = uid, csat)
# Check that the row corresponding to 'uid' in the original dpdict now has name 'user_id'
survey_obj <- create_survey_data(get_minimal_labelled_test_dat()) # Has 'uid' column
mutated_obj_custom_label <- mutate(survey_obj, new_col = realiselabelled_vec(uid * 10, variable_label = custom_label))
# Check if custom label was applied to the variable
# Check if custom label was recorded in dpdict
new_row_dpdict <- mutated_obj_custom_label$dpdict[mutated_obj_custom_label$dpdict$variable_names == "new_col", ]
# Modify an existing column with a new label
mutated_obj_relabel <- mutate(survey_obj, uid = realiselabelled_vec(uid + 1, variable_label = new_uid_label))
# Corrected test - compare values after removing labels
# Check if the new label was applied to the modified variable
# Check if the new label was recorded in dpdict
modified_row_dpdict <- mutated_obj_relabel$dpdict[mutated_obj_relabel$dpdict$variable_names == "uid", ]
# Test multiple operations in one mutate call
# Only run if get_minimal_labelled_test_dat() has at least one column of each type
skip_if_not(all(c("uid", "csat", "nps_response") %in% names(survey_obj$dat)),
"Test data doesn't have required columns")
uid = realiselabelled_vec(uid + 1, variable_label = "New UID Label"),
new_var1 = realiselabelled_vec(csat * 2, variable_label = "Double CSAT"),
new_var2 = nps_response * 3)  # No custom label
expect_true(all(c("uid", "new_var1", "new_var2") %in% names(multi_obj$dat)))
expect_equal(sjlabelled::get_label(multi_obj$dat$new_var2), "NPS response (1)")  # Default label
# Test: Value labels preserved with !!!-spliced variables
test_that("mutate preserves value labels from spliced variables", {
attr(original_dat$existing_var, "label") <- "Existing Variable"
attr(original_dat$existing_var, "labels") <- c("No" = 1, "Yes" = 2)
# Create a named list with value labels (like a1a_wide)
attr(new_vars_list$new_var1, "label") <- "New Variable 1"
attr(new_vars_list$new_var1, "labels") <- c("Low" = 1, "High" = 2)
attr(new_vars_list$new_var2, "label") <- "New Variable 2"
attr(new_vars_list$new_var2, "labels") <- c("Bad" = 1, "Good" = 2)
expect_equal(attr(result$dat$new_var1, "labels"), c("Low" = 1, "High" = 2))
expect_equal(attr(result$dat$new_var2, "labels"), c("Bad" = 1, "Good" = 2))
# Check that variable labels are preserved
expect_equal(attr(result$dat$new_var1, "label"), "New Variable 1")
expect_equal(attr(result$dat$new_var2, "label"), "New Variable 2")
# Check that original variable labels are still intact
expect_equal(attr(result$dat$existing_var, "labels"), c("No" = 1, "Yes" = 2))
# Check that dpdict is updated correctly
expect_equal(result$dpdict$variable_labels[result$dpdict$variable_names == "new_var1"], "New Variable 1")
expect_equal(result$dpdict$variable_labels[result$dpdict$variable_names == "new_var2"], "New Variable 2")
test_that("mutate updates dpdict when transforming existing labeled variables", {
# Create initial survey data with labeled variables
# Verify original csat has value labels in both data and dpdict
original_csat_labels <- sjlabelled::get_labels(survey_obj$dat$csat, attr.only = TRUE, values = "as.name")
csat_idx <- which(survey_obj$dpdict$variable_names == "csat")
# Use mutate to create a copy of csat (simple assignment that should preserve labels)
dplyr::mutate(csat_copy = csat))  # Simple assignment should preserve labels
# Check that value labels are preserved in the data
copy_labels_in_data <- sjlabelled::get_labels(survey_obj$dat$csat_copy, attr.only = TRUE, values = "as.name")
# Check that value labels are captured in dpdict
copy_idx <- which(survey_obj$dpdict$variable_names == "csat_copy")
test_that("left_join works for survey_data objects", {
# Test 1: Join with another survey_data object
attr(survey2_dat$new_var, "label") <- "New Variable"
result1 <- left_join(survey1, survey2, by = "uid")
result2 <- left_join(survey1, df2, by = "uid")
csat = 5:1  # Conflicts with existing csat
attr(survey3_dat$csat, "label") <- "Customer Satisfaction (New)"
result3 <- left_join(survey1, survey3, by = "uid"),
# Check that the suffixed versions have appropriate labels