# load(file = "tests/testthat/helper_data.rda") load(file = "helper_data.rda") # dfSAV <- import_spss(file = "tests/testthat/helper_spss_missings.sav") dfSAV <- import_spss(file = "helper_spss_missings.sav") ### Meta changes changes_var <- getChangeMeta(dfSAV) changes_val <- getChangeMeta(dfSAV, level = "value") var_changes_list <- getChangeMeta(expected_bigList, level = "variable") val_changes_list <- getChangeMeta(expected_bigList, level = "value") test_that("Changes to GADSdat on variable level", { # varName changes_var[1, "varName_new"] <- "new1" g1 <- applyChangeMeta(changes_var, dfSAV) expect_equal(g1$labels[, -1], dfSAV$labels[, -1]) expect_equal(g1$labels$varName, c(rep("new1", 3), rep("VAR2", 2), rep("VAR3", 2))) expect_equal(names(g1$dat), c("new1", "VAR2", "VAR3")) # others changes_var[2, "varLabel_new"] <- "new1" g2 <- applyChangeMeta(changes_var, dfSAV) expect_equal(g2$labels$varLabel, c(rep("Variable 1", 3), rep("new1", 2), rep("Variable 3", 2))) }) test_that("Changes to GADSdat on value level", { changes_val3 <- changes_val2 <- changes_val changes_val2[1, "valLabel_new"] <- "new_miss" changes_val2[2, "valLabel_new"] <- "new_miss2" g2 <- applyChangeMeta(changes_val2, dfSAV) expect_equal(g2$labels[, -7], dfSAV$labels[, -7]) expect_equal(g2$labels$valLabel, c("new_miss", "new_miss2", "One", "missing", NA, "missing", NA)) expect_equal(names(g2$dat), names(dfSAV$dat)) changes_val3[3, "missings_new"] <- "miss" g3 <- applyChangeMeta(changes_val3, dfSAV) expect_equal(g3$labels[, -8], dfSAV$labels[, -8]) expect_equal(g3$labels$missings[1:3], rep("miss", 3)) }) test_that("Changes to GADSdat: recoding", { changes_val[3, "value_new"] <- 10 g1 <- applyChangeMeta(changes_val, dfSAV) expect_equal(g1$labels$value[3], 10) expect_equal(g1$dat[1, 1], 10) changes_val[4, "value_new"] <- "test" expect_error(applyChangeMeta(changes_val, dfSAV)) }) test_that("recoding if potential danger of overwriting old values!", { df_rec <- data.frame(v1 = c("x", "y", "z"), b = c("b", "a", "d"), stringsAsFactors = TRUE) df_rec <- import_DF(df_rec) chang <- getChangeMeta(df_rec, level = "value") chang2 <- chang chang2[, "value_new"] <- c(3, 4, 1, NA, NA, NA) out <- applyChangeMeta(chang2, df_rec) expect_equal(out$labels$value, c(1, 3, 4, 1, 2, 3)) expect_equal(out$labels$valLabel, c("z", "x", "y", "a", "b", "d")) expect_equal(out$dat$v1, c(3, 4, 1)) ## partial recoding, multiple variables chang[, "value_new"] <- c(3, NA, 1, 2, 1, 5) out <- applyChangeMeta(chang, df_rec) expect_equal(out$labels$value, c(1, 2, 3, 1, 2, 5)) expect_equal(out$labels$valLabel, c("z", "y", "x", "b", "a", "d")) expect_equal(out$dat$v1, 3:1) expect_equal(out$dat$b, c(1, 2, 5)) changes_val2 <- changes_val changes_val2[1:2, "value_new"] <- c(-96, -95) out3 <- applyChangeMeta(changes_val2, dfSAV) expect_equal(out3$labels$value[1:3], c(-96, -95, 1)) }) test_that("Recoding with value meta data conflicts", { changes_val2 <- changes_val changes_val2[1, "value_new"] <- 1 expect_error(recode_labels(dfSAV$labels, changes_val2, existingMeta = "stop"), "Values in 'value_new' with existing meta data in variable VAR1: 1") out <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "value") comp1 <- dfSAV$labels[-3, ] comp1[1, "value"] <- 1 comp1 <- comp1[c(2, 1, 3:6),] rownames(comp1) <- NULL expect_equal(comp1, out) out2 <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "value_new") comp2 <- dfSAV$labels[-3, ] comp2[1, "value"] <- 1 comp2[1, "valLabel"] <- "One" comp2[1, "missings"] <- "valid" comp2 <- comp2[c(2, 1, 3:6),] rownames(comp2) <- NULL expect_equal(comp2, out2) }) test_that("Recoding multiple value into the same value (without meta data conflicts)", { changes_val2 <- changes_val changes_val2[1:3, "value_new"] <- 10 changes_val3 <- changes_val2 changes_val3[1:3, "value_new"] <- c(1, 1, NA) expect_error(recode_labels(dfSAV$labels, changes_val2, existingMeta = "stop"), "Duplicated values in 'value_new' causing conflicting meta data in variable VAR1: 10. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recode_labels(dfSAV$labels, changes_val2, existingMeta = "value"), "Duplicated values in 'value_new' causing conflicting meta data in variable VAR1: 10. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recode_labels(dfSAV$labels, changes_val2, existingMeta = "value_new"), "Duplicated values in 'value_new' causing conflicting meta data in variable VAR1: 10. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") out2 <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "drop") expect_equal(out2[1, "value"], 10) expect_equal(out2[1, "valLabel"], NA_character_) expect_equal(out2[1, "missings"], "valid") expect_equal(out2[2, "varName"], "VAR2") out3 <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "ignore") expect_equal(extractMeta(out3, "VAR1"), extractMeta(dfSAV, "VAR1")) out4 <- recode_labels(dfSAV$labels, changes_val3, existingMeta = "ignore") expect_equal(extractMeta(out4, "VAR1"), extractMeta(dfSAV, "VAR1")) }) test_that("Recoding multiple value into the same value (with meta data conflicts)", { changes_val2 <- changes_val changes_val2[1:2, "value_new"] <- 1 expect_error(recode_labels(dfSAV$labels, changes_val2, existingMeta = "stop"), "Values in 'value_new' with existing meta data in variable VAR1: 1") expect_error(recode_labels(dfSAV$labels, changes_val2, existingMeta = "value"), "Multiple values are recoded into 1 for variable VAR1. Value meta data can thus not be used from 'value'. Set existingMeta = 'value_new'.") out2 <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "value_new") comp2 <- dfSAV$labels[-(2:3), ] comp2[1, "value"] <- 1 comp2[1, "valLabel"] <- "One" comp2[1, "missings"] <- "valid" rownames(comp2) <- NULL expect_equal(comp2, out2) out2b <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "drop") expect_equal(out2b[1, "value"], 1) expect_equal(out2b[1, "valLabel"], NA_character_) expect_equal(out2b[1, "missings"], "valid") out3 <- applyChangeMeta(changes_val2, GADSdat = dfSAV, existingMeta = "value_new") expect_equal(out3$dat$VAR1, c(1, 1, 1, 2)) expect_equal(comp2, out3$labels) }) test_that("Recoding multiple value into the same value (with and without meta data conflicts)", { dfSAVb <- changeValLabels(dfSAV, "VAR1", value = 2, valLabel = "two") changes_valb <- getChangeMeta(dfSAVb, level = "value") changes_valb[1:2, "value_new"] <- 1 changes_valb[3:4, "value_new"] <- 10 expect_error(recode_labels(dfSAVb$labels, changes_valb, existingMeta = "stop"), "Duplicated values in 'value_new' causing conflicting meta data in variable VAR1: 1, 10. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recode_labels(dfSAVb$labels, changes_valb, existingMeta = "value"), "Duplicated values in 'value_new' causing conflicting meta data in variable VAR1: 1, 10. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recode_labels(dfSAVb$labels, changes_valb, existingMeta = "value_new"), "Duplicated values in 'value_new' causing conflicting meta data in variable VAR1: 1, 10. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") out2 <- recode_labels(dfSAVb$labels, changes_valb, existingMeta = "drop") expect_equal(out2[1, "value"], 1) expect_equal(out2[2, "value"], 10) expect_equal(out2[1, "valLabel"], NA_character_) expect_equal(out2[2, "valLabel"], NA_character_) expect_equal(out2[1, "missings"], "valid") expect_equal(out2[2, "missings"], "valid") expect_equal(out2[3, "varName"], "VAR2") }) changes_val2 <- rbind(changes_val, data.frame(varName = "VAR1", value = NA, valLabel = NA, missings = NA, value_new = 2, valLabel_new = "Two", missings_new = "valid", stringsAsFactors = FALSE)) changes_val3 <- rbind(changes_val2, data.frame(varName = "VAR1", value = NA, valLabel = NA, missings = NA, value_new = 3, valLabel_new = "Three", missings_new = "valid", stringsAsFactors = FALSE)) test_that("Expand labels", { out <- expand_labels(df1$labels, new_varName_vec = c("ID1", "ID1", "V1")) expect_equal(out$varName, c("ID1", "ID1", "V1")) expect_equal(out$labeled, rep("no", 3)) out2 <- expand_labels(df2$labels, new_varName_vec = c("ID1", "V2", "V2")) expect_equal(out2$varName, c("ID1", "V2", "V2")) expect_equal(out2$labeled, c("no", "yes", "yes")) expect_equal(out2$varLabel, c(NA, "Variable 2", "Variable 2")) expect_equal(out2$value, c(NA, 99, NA)) out3 <- expand_labels(dfSAV$labels, changes_val2$varName) expect_equal(out3[1:4, "value"], c(-99, -96, 1, NA)) expect_equal(out3[1:4, "varName"], rep("VAR1", 4)) }) test_that("Adding value labels for values without labels", { out <- recode_labels(dfSAV$labels, changes_val2, existingMeta = "stop") expect_equal(out$value[1:4], c(-99, -96, 1, 2)) expect_equal(dim(out), c(8, 8)) df1_changes <- getChangeMeta(df1, level = "value") df1_changes[2, "value_new"] <- 99 df1_changes[2, "valLabel_new"] <- "test" out2 <- recode_labels(df1$labels, df1_changes, existingMeta = "stop") expect_equal(out2$value, c(NA, 99)) expect_equal(dim(out2), c(2, 8)) expect_equal(out2$labeled, c("no", "yes")) expect_equal(out2$missings, c(NA, "valid")) # multiple new value labels out3 <- applyChangeMeta(changes_val3, dfSAV) expect_equal(dim(out3$labels), c(9, 8)) expect_equal(out3$labels$value[3:5], 1:3) expect_equal(out3$labels$valLabel[3:5], c("One", "Two", "Three")) }) test_that("update labeled helper", { g <- import_DF(mtcars) g$labels[1, "value"] <- 1 out <- update_labeled_col(g$labels) expect_equal(out[1, "labeled"], "yes") expect_equal(out[2, "labeled"], "no") }) test_that("update of labeled column", { dfSAV2 <- removeValLabels(dfSAV, "VAR3", value = c(-99, -98)) dfSAV2$labels[3, "value"] <- NA expect_silent(check_GADSdat(dfSAV2)) changeTab <- getChangeMeta(dfSAV2, "value") changeTab[6, "value_new"] <- -99 changeTab[6, "valLabel_new"] <- "a label" out <- applyChangeMeta(changeTab, dfSAV2) }) test_that("Adding value labels to an unlabeled variable", { iris2 <- as.data.frame(iris, stringsAsFactors = TRUE) suppressMessages(g <- import_DF(iris2)) changer <- getChangeMeta(g, level = "value") changer[1, "value_new"] <- 99 changer[1, "valLabel_new"] <- "some label" changer[1, "missings_new"] <- "valid" out <- applyChangeMeta(changer, g) expect_equal(out[[2]][1, ][6:8], data.frame(value = 99, valLabel = "some label", missings = "valid", stringsAsFactors = FALSE)) expect_equal(out[[2]][1, ][5], data.frame(labeled = "yes", stringsAsFactors = FALSE)) }) test_that("Changes to all_GADSdat on variable level", { var_changes_list2 <- var_changes_list var_changes_list2$df1[1, "varName_new"] <- "test1" var_changes_list2$df2[2, "varName_new"] <- "test2" g1 <- applyChangeMeta(var_changes_list2, expected_bigList) expect_equal(g1$allLabels$varName, c("test1", "V1", "ID1", "test2")) expect_equal(names(g1$datList$df1), c("test1", "V1")) var_changes_list$df1[1, "varLabel_new"] <- "test1" var_changes_list$df2[2, "varLabel_new"] <- "test2" g1 <- applyChangeMeta(var_changes_list, expected_bigList) expect_equal(g1$allLabels$varLabel, c("test1", NA, NA, "test2")) }) test_that("Changes to all_GADSdat on value level", { val_changes_list2 <- val_changes_list val_changes_list2$df2[2, "valLabel_new"] <- "test1" g1 <- applyChangeMeta(val_changes_list2, expected_bigList) expect_equal(g1$allLabels$valLabel, c(NA, NA, NA, "test1")) # values val_changes_list$df2[2, "value_new"] <- -99 g1 <- applyChangeMeta(val_changes_list, expected_bigList) expect_equal(g1$allLabels$value, c(NA, NA, NA, -99)) # values that don't have a label val_changes_list$df2[2, "value_new"] <- -99 }) test_that("Changes to GADSdat if tibble or data.frame, varNames", { # varName changes_var_tbl <- changes_var changes_var_tbl[1, "varName_new"] <- "new1" changes_var_tbl <- tibble::as_tibble(changes_var_tbl) g1 <- applyChangeMeta(changes_var_tbl, dfSAV) expect_equal(g1$labels[, -1], dfSAV$labels[, -1]) expect_equal(g1$labels$varName, c(rep("new1", 3), rep("VAR2", 2), rep("VAR3", 2))) expect_equal(names(g1$dat), c("new1", "VAR2", "VAR3")) changes_var_df <- as.data.frame(changes_var_tbl) g3 <- applyChangeMeta(changes_var_df, dfSAV) expect_equal(g3$labels[, -1], dfSAV$labels[, -1]) }) test_that("Changes to GADSdat if tibble or data.frame, value labels", { changes_val_tbl <- changes_val changes_val_tbl[1, "valLabel_new"] <- "new_miss" changes_val_tbl[2, "valLabel_new"] <- "new_miss2" changes_val_tbl <- tibble::as_tibble(changes_val_tbl) g2 <- applyChangeMeta(changes_val_tbl, dfSAV) expect_equal(g2$labels[, -7], dfSAV$labels[, -7]) expect_equal(g2$labels$valLabel, c("new_miss", "new_miss2", "One", "missing", NA, "missing", NA)) expect_equal(names(g2$dat), names(dfSAV$dat)) changes_val_df <- as.data.frame(changes_val_tbl) g4 <- applyChangeMeta(changes_val_df, dfSAV) expect_equal(g4$labels[, -7], dfSAV$labels[, -7]) }) test_that("sort value labels", { unsorted <- dfSAV$labels[c(3:1), ] out <- sort_value_labels(unsorted) expect_equal(out, dfSAV$labels[1:3,]) }) test_that("Multiple meta data conflicts during value recoding", { dat <- data.frame(v1 = factor(c("a", "b", "c", "d", "e"))) gads <- import_DF(dat) expect_error(recodeGADS(gads, "v1", oldValues = c(1, 2), newValues = c(6, 6), existingMeta = "value_new"), "Duplicated values in 'value_new' causing conflicting meta data in variable v1: 6. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recodeGADS(gads, "v1", oldValues = c(1, 2, 4), newValues = c(6, 6, 5), existingMeta = "value_new"), "Duplicated values in 'value_new' causing conflicting meta data in variable v1: 6. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recodeGADS(gads, "v1", oldValues = c(1, 2), newValues = c(6, 6), existingMeta = "value"), "Duplicated values in 'value_new' causing conflicting meta data in variable v1: 6. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") expect_error(recodeGADS(gads, "v1", oldValues = c(1, 2, 4), newValues = c(6, 6, 5), existingMeta = "value"), "Duplicated values in 'value_new' causing conflicting meta data in variable v1: 6. Use existingMeta = 'drop' or 'ignore' to drop all related meta data.") out <- recodeGADS(gads, "v1", oldValues = c(1, 2), newValues = c(6, 6), existingMeta = "drop") out2 <- recodeGADS(gads, "v1", oldValues = c(1, 2, 4), newValues = c(6, 6, 5), existingMeta = "drop") expect_equal(sum(out2$labels$value == 6), 1) out3 <- recodeGADS(gads, "v1", oldValues = c(1, 2), newValues = c(6, 6), existingMeta = "ignore") out4 <- recodeGADS(gads, "v1", oldValues = c(1, 2, 4), newValues = c(6, 6, 5), existingMeta = "ignore") expect_equal(out3$labels, out4$labels) })