base_path <- "c:/packages/procs/tests/testthat" data_dir <- base_path base_path <- tempdir() data_dir <- "." dat <- read.table(header = TRUE, text = ' Region Eyes Hair Count 1 blue fair 23 1 blue dark 11 1 green medium 18 1 brown red 5 1 brown black 3 2 blue medium 44 2 green fair 50 2 green dark 23 2 brown medium 53 1 blue red 7 1 green fair 19 1 green dark 14 1 brown medium 41 2 blue fair 46 2 blue dark 40 2 green red 31 2 brown fair 56 2 brown dark 54 1 blue medium 24 1 green red 7 1 brown fair 34 1 brown dark 40 2 blue red 21 2 blue black 6 2 green medium 37 2 brown red 42 2 brown black 13 ') prt <- read.table(header = TRUE, text = ' sex internship enrollment count 1 boys yes yes 35 2 boys no yes 14 3 girls yes yes 32 4 girls no yes 53 5 boys yes no 29 6 boys no no 27 7 girls yes no 10 8 girls no no 23') prt2 <- read.table(header = TRUE, text = ' sex internship enrollment count group 1 boys yes yes 35 1 2 boys no yes 14 1 3 girls yes yes 32 1 4 girls no yes 53 1 5 boys yes no 29 2 6 boys no no 27 2 7 girls yes no 10 2 8 girls no no 23 2') adsl <- read.table(header = TRUE, text = ' SUBJID ARM SEX RACE AGE "001" "ARM A" "F" "WHITE" 19 "002" "ARM B" "F" "WHITE" 21 "003" "ARM C" "F" "WHITE" 23 "004" "ARM D" "F" "BLACK" 28 "005" "ARM A" "M" "WHITE" 37 "006" "ARM B" "M" "WHITE" 34 "007" "ARM C" "M" "WHITE" 36 "008" "ARM D" "M" "WHITE" 30 "009" "ARM A" "F" "WHITE" 39 "010" "ARM B" "F" "WHITE" 31 "011" "ARM C" "F" "BLACK" 33 "012" "ARM D" "F" "WHITE" 38 "013" "ARM A" "M" "BLACK" 37 "014" "ARM B" "M" "WHITE" 34 "015" "ARM C" "M" "WHITE" 36 "016" "ARM A" "M" "WHITE" 40') options("logr.output" = FALSE) options("procs.print" = FALSE) #options("procs.print" = NULL) test_that("freq1: Simple proc_freq no output works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes"), output = "none", titles = "My first Frequency Table") res expect_equal(is.null(res), TRUE) }) test_that("freq2: Simple proc_freq with out works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes"), titles = "My first Frequency Table", options = outcum) res expect_equal(nrow(res), 3) expect_equal(ncol(res), 7) }) # test_that("freq2: proc_freq with label and format options works.", { # # # labels(dat) <- list(Eyes = "Eye Color", # Hair = "Hair Color", # Region = "Geographic Region") # # res <- proc_freq(dat, tables = c("Eyes"), # titles = "My first Frequency Table", # # out = out_spec(label = c(VAR = "Variable", CAT = "Category"), # format = list(CUMPCT = "%.3f"))) # # res # # # proc_print(res) # # a1 <- attributes(res$VAR) # a2 <- attributes(res$CUMPCT) # # expect_equal(nrow(res), 3) # expect_equal(ncol(res), 7) # # expect_equal(a1$label, "Variable") # expect_equal(a2$format, "%.3f") # # }) test_that("freq3: Two table proc_freq test with output works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", HairCount = "Hair"), titles = "My first Frequency Table", options = outcum) res res$Eyes expect_equal(length(res), 2) expect_equal(names(res), c("Eyes", "HairCount")) expect_equal(nrow(res[[1]]), 3) expect_equal(ncol(res[[1]]), 7) expect_equal(nrow(res[[2]]), 5) expect_equal(ncol(res[[2]]), 7) }) test_that("freq4: Simple proc_freq test with weight works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes"), weight = "Count", titles = "My first Frequency Table", options = outcum) res expect_equal(res$CNT[1], 222) expect_equal(nrow(res), 3) expect_equal(ncol(res), 7) }) test_that("freq5: Two var proc_freq with weight works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair"), weight = "Count", titles = "Eye and Hair Color of European Children", options = outcum) res #ex <- file.exists(fl) expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 3) expect_equal(ncol(res[[1]]), 7) expect_equal(res[[1]]$CNT[1], 222) expect_equal(res[[2]]$CNT[5], 113) }) test_that("freq6: Simple proc_freq with output long works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes"), weight = "Count", titles = "My first Frequency Table", output = long) res expect_equal(nrow(res), 3) expect_equal(ncol(res), 5) }) test_that("freq7: Simple proc_freq with 2 way works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes * Hair"), weight = "Count", titles = "My first Frequency Table") res expect_equal(nrow(res), 15) expect_equal(ncol(res), 7) }) test_that("freq8: Simple proc_freq in multiple outputs works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = v(out1 = Eyes, out2 = Hair, out3 = Eyes * Hair), weight = "Count", titles = "My first Frequency Table", options = outcum ) res expect_equal(length(res), 3) expect_equal(names(res), c("out1", "out2", "out3")) expect_equal(nrow(res[[1]]), 3) expect_equal(ncol(res[[1]]), 7) expect_equal(nrow(res[[2]]), 5) expect_equal(ncol(res[[2]]), 7) expect_equal(nrow(res[[3]]), 15) expect_equal(ncol(res[[3]]), 9) }) test_that("freq9: Simple proc_freq 1 way by variable works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes"), weight = "Count", titles = "My first Frequency Table", by = "Region", options = outcum) res expect_equal(nrow(res), 6) expect_equal(ncol(res), 8) }) test_that("freq10: Two way proc_freq works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes * Hair"), options = "outcum", weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(nrow(res), 15) expect_equal(ncol(res), 9) }) test_that("freq11: Two way proc_freq no weight works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c(FreqCount = "Eyes * Hair"), titles = "Eye and Hair Color of European Children", options = outcum) res expect_equal(nrow(res), 15) expect_equal(ncol(res), 9) }) test_that("freq12: One way and two way proc_freq works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair", FreqCount = "Eyes * Hair"), weight = "Count", titles = "Eye and Hair Color of European Children", options = outcum) res expect_equal(nrow(res[[1]]), 3) expect_equal(ncol(res[[1]]), 7) expect_equal(nrow(res[[2]]), 5) expect_equal(ncol(res[[2]]), 7) expect_equal(nrow(res[[3]]), 15) expect_equal(ncol(res[[3]]), 9) }) test_that("freq13: Nocum option work as expected.", { res <- proc_freq(dat, tables = c("Eyes"), output = report, options = nocum, titles = "Eye and Hair Color of European Children") res d <- names(res) expect_equal("CUMSUM" %in% d, FALSE) expect_equal("CUMPCT" %in% d, FALSE) }) test_that("freq14: output = out on table.", { res <- proc_freq(dat, tables = c("Eyes", "Eyes * Hair"), output = out, options = noprint, titles = "Eye and Hair Color of European Children") res d <- names(res) expect_equal(d[1], "Eyes") expect_equal(d[2], "Eyes * Hair") }) test_that("freq15: Outcum option works as expected.", { res <- proc_freq(dat, tables = c("Eyes"), options = nocum, titles = "Eye and Hair Color of European Children") res d <- names(res) expect_equal("CUMSUM" %in% d, FALSE) expect_equal("CUMPCT" %in% d, FALSE) res <- proc_freq(dat, tables = c("Eyes"), options = outcum, titles = "Eye and Hair Color of European Children") res d <- names(res) expect_equal("CUMSUM" %in% d, TRUE) expect_equal("CUMPCT" %in% d, TRUE) }) test_that("freq16: Freq and Pct options works as expected.", { res <- proc_freq(dat, tables = c("Eyes"), options = v(nofreq, nocum), titles = "Eye and Hair Color of European Children") res d <- names(res) expect_equal("CNT" %in% d, FALSE) expect_equal("PCT" %in% d, TRUE) res <- proc_freq(dat, tables = c("Eyes"), options = v(nopercent, nocum), titles = "Eye and Hair Color of European Children") res d <- names(res) expect_equal("CNT" %in% d, TRUE) expect_equal("PCT" %in% d, FALSE) }) test_that("freq17: Sparse option works as expected.", { res <- proc_freq(dat, tables = c("Eyes * Hair"), options = v(nosparse), titles = "Eye and Hair Color of European Children") res expect_equal(nrow(res), 14) expect_equal(ncol(res), 7) }) test_that("freq18: Crosstab works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes * Hair"), weight = "Count", titles = "Eye and Hair Color of European Children", output = report) res expect_equal(nrow(res), 14) expect_equal(ncol(res), 8) }) # Not sure what is wrong with this. Should be working. # test_that("freq19: Format options on table.", { # # # labels(dat) <- list(Eyes = "Eye Color", # Hair = "Hair Color", # Region = "Geographic Region") # # fmt1 <- value(condition(is.na(x), ""), # condition(TRUE, "%.3f%%")) # # res <- proc_freq(dat, tables = c("Eyes * Hair"), # options = v(format = fmt1, out), # weight = "Count", # titles = "Eye and Hair Color of European Children") # # # Interactive test # expect_equal(TRUE, TRUE) # # }) test_that("freq20: SAS replication of one way tables works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair"), titles = "Eye and Hair Color of European Children", weight = "Count", options = outcum) res expect_equal(nrow(res[[1]]), 3) expect_equal(ncol(res[[1]]), 7) expect_equal(nrow(res[[2]]), 5) expect_equal(ncol(res[[2]]), 7) }) test_that("freq21: Rowpct and Colpct options on table work.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes * Hair"), output = report, options = v(norow, nocol), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(nrow(res), 8) expect_equal(ncol(res), 8) }) test_that("freq22: Crosstab option works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair", "Eyes * Hair"), options = v(crosstab), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(nrow(res[[3]]), 14) expect_equal(ncol(res[[3]]), 8) }) # test_that("freq23: proc_freq with drop, keep and rename options works.", { # # # labels(dat) <- list(Eyes = "Eye Color", # Hair = "Hair Color", # Region = "Geographic Region") # # res <- proc_freq(dat, tables = c("Eyes"), # titles = "My first Frequency Table", # out = out_spec(drop = "CUMPCT", # keep = c("CAT", "VAR", "N", "CNT", "PCT"), # rename = c(VAR = "BLOCK"))) # # res # # # proc_print(res) # # expect_equal(nrow(res), 3) # expect_equal(ncol(res), 5) # expect_equal(names(res), c("BLOCK", "CAT", "N", "CNT", "PCT")) # # }) # test_that("freq24: proc_freq with where output option works.", { # # # labels(dat) <- list(Eyes = "Eye Color", # Hair = "Hair Color", # Region = "Geographic Region") # # res <- proc_freq(dat, tables = c("Eyes"), # titles = "My first Frequency Table", # out = out_spec(where = expression(CAT == "green"))) # # res # # # proc_print(res) # # # expect_equal(nrow(res), 1) # expect_equal(ncol(res), 7) # # }) test_that("freq25: Single by group on single table works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes"), by = "Region", weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal("data.frame" %in% class(res), TRUE) expect_equal(nrow(res), 6) expect_equal(ncol(res), 6) expect_equal(typeof(res$BY), 'integer') }) test_that("freq26: Single by group on double table works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair"), by = c("Region"), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 6) expect_equal(nrow(res[[2]]), 10) expect_equal(typeof(res[[1]]$BY), 'integer') expect_equal(typeof(res[[2]]$BY), 'integer') }) test_that("freq27: Double by group on double table works.", { spdat <- dat spdat$Sex <- c(rep("M", 13), rep("F", 14)) labels(spdat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(spdat, tables = c("Eyes", "Hair"), by = c("Sex", "Region"), weight = "Count", options = v(nosparse), titles = "Eye and Hair Color of European Children") res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 12) expect_equal(nrow(res[[2]]), 17) expect_equal(sum(spdat$Count), sum(res$Eyes$CNT)) expect_equal(sum(spdat$Count), sum(res$Hair$CNT)) res <- proc_freq(spdat, tables = c("Eyes", "Hair"), by = c("Sex", "Region"), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 12) expect_equal(nrow(res[[2]]), 20) expect_equal(sum(spdat$Count), sum(res$Eyes$CNT)) expect_equal(sum(spdat$Count), sum(res$Hair$CNT)) }) test_that("freq28: Double by group on double table with table names works.", { spdat <- dat spdat$Sex <- c(rep("M", 13), rep("F", 14)) labels(spdat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(spdat, tables = c(EyeTbl = "Eyes", HairTbl ="Hair"), by = c("Sex", "Region"), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 12) expect_equal(nrow(res[[2]]), 20) expect_equal(names(res)[1], "EyeTbl") expect_equal(names(res)[2], "HairTbl") }) test_that("freq29: Double by group on double table no labels works.", { spdat <- dat spdat$Sex <- c(rep("M", 13), rep("F", 14)) labels(spdat) <- NULL res <- proc_freq(spdat, tables = c(EyeTbl = "Eyes", HairTbl ="Hair"), by = c("Sex", "Region"), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 12) expect_equal(nrow(res[[2]]), 20) expect_equal(names(res)[1], "EyeTbl") expect_equal(names(res)[2], "HairTbl") }) test_that("freq30: Crosstab with by works.", { spdat <- dat spdat$Sex <- c(rep("M", 13), rep("F", 14)) labels(spdat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(spdat, tables = c("Eyes * Hair"), by = c("Sex"), weight = "Count", titles = "Eye and Hair Color of European Children") res expect_equal(nrow(res), 30) expect_equal(ncol(res), 8) }) test_that("freq30: Crosstab with by and report works.", { spdat <- dat spdat$Sex <- c(rep("M", 13), rep("F", 14)) labels(spdat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(spdat, tables = c(FreqTable = "Eyes * Hair"), by = c("Sex"), weight = "Count", titles = "Eye and Hair Color of European Children", output = report) res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 14) expect_equal(names(res)[1], "Sex=F, FreqTable") expect_equal(names(res)[2], "Sex=M, FreqTable") }) test_that("freq31: Parameter checks work.", { expect_error(proc_freq(dat, tables = c("Fork", "Eyes", "Bork"))) expect_error(proc_freq(dat, by = "Fork", tables = "Eye")) dat2 <- dat[0, ] expect_error(proc_freq(dat2, tables = "Eye")) }) test_that("freq32: chi sqr works with weight.", { # fp <- file.path(base_path, "/data/treatment.csv") # csv <- read.csv(fp) res <- proc_freq(prt, tables = "internship * enrollment", output = report, options = chisq, weight = "count") res expect_equal(length(res), 2) res2 <- res[[2]] expect_equal("STAT" %in% names(res2), TRUE) expect_equal(res2[1, "VAL"], 0.8189423) expect_equal(res2[1, "DF"], 1) expect_equal(res2[1, "PROB"], 0.365489592) expect_equal(res2[2, "VAL"], 0.58989261) expect_equal(res2[2, "DF"], 1) expect_equal(res2[2, "PROB"], 0.44246065) }) test_that("freq33: fisher's works with weight.", { res <- proc_freq(prt, tables = "internship * enrollment", output = report, options = fisher, weight = "count") res expect_equal(length(res), 2) res2 <- res[[2]] expect_equal(res2[1, 2], 50) expect_equal(res2[2, 2], 0.85127668) expect_equal(res2[3, 2], 0.22133142) expect_equal(res2[4, 2], 0.41215159) #expect_equal(nrow(res[[1]]), 14) }) test_that("freq34: fisher's works with weight and by.", { res <- proc_freq(prt, tables = "internship * enrollment", output = report, options = v(fisher), by = "sex", weight = "count") res expect_equal(length(res), 4) res2 <- res[[2]] expect_equal(res2[1, 2], 27) expect_equal(res2[2, 2], 0.98846024) expect_equal(res2[3, 2], 0.03111341) expect_equal(res2[4, 2], 0.046665258) res4 <- res[[4]] expect_equal(res4[1, 2], 23) expect_equal(res4[2, 2], 0.83173972) expect_equal(res4[3, 2], 0.29935132) expect_equal(res4[4, 2], 0.524477809) #expect_equal(nrow(res[[1]]), 14) res <- proc_freq(prt, tables = "internship * enrollment", options = v(fisher, list), by = "sex", weight = "count") res expect_equal(length(res), 2) res2 <- res[[2]] expect_equal(res2[1, 2], 27) expect_equal(res2[1, 3], 0.98846024) expect_equal(res2[1, 4], 0.03111341) expect_equal(res2[1, 5], 0.046665258) expect_equal(res2[2, 2], 23) expect_equal(res2[2, 3], 0.83173972) expect_equal(res2[2, 4], 0.29935132) expect_equal(res2[2, 5], 0.524477809) }) test_that("freq35: chi sqr works with weight and by.", { # fp <- file.path(base_path, "/data/treatment.csv") # csv <- read.csv(fp) res <- proc_freq(prt, tables = "internship * enrollment", output = report, options = ChiSq, by = "sex", weight = "count") res expect_equal(length(res), 4) res2 <- res[[2]] expect_equal(res2[1, "VAL"], 4.23661395) expect_equal(res2[1, "DF"], 1) expect_equal(res2[1, "PROB"], 0.039560993) expect_equal(res2[2, "VAL"], 3.4514934) expect_equal(res2[2, "DF"], 1) expect_equal(res2[2, "PROB"], 0.063194646) res4 <- res[[4]] expect_equal(res4[1, "VAL"], 0.55926894) expect_equal(res4[1, "DF"], 1) expect_equal(res4[1, "PROB"], 0.45455495) expect_equal(res4[2, "VAL"], 0.2847875035) expect_equal(res4[2, "DF"], 1) expect_equal(res4[2, "PROB"], 0.5935803491) res <- proc_freq(prt, tables = "internship * enrollment", options = ChiSq, by = "sex", weight = "count") res expect_equal(length(res), 2) res2 <- res[[2]] expect_equal(res2[1, "VAL"], 4.23661395) expect_equal(res2[1, "DF"], 1) expect_equal(res2[1, "PROB"], 0.039560993) expect_equal(res2[2, "VAL"], 3.4514934) expect_equal(res2[2, "DF"], 1) expect_equal(res2[2, "PROB"], 0.063194646) expect_equal(res2[3, "VAL"], 0.55926894) expect_equal(res2[3, "DF"], 1) expect_equal(res2[3, "PROB"], 0.45455495) expect_equal(res2[4, "VAL"], 0.2847875035) expect_equal(res2[4, "DF"], 1) expect_equal(res2[4, "PROB"], 0.5935803491) }) test_that("freq36: 2 way table is sorted properly.", { res <- proc_freq(prt, tables = "internship * enrollment", weight = "count", output = "report") res expect_equal(res[9, 1], "Total") expect_equal(res[10, 1], "Total") }) test_that("freq37: Crosstab works with factors.", { prt2 <- prt prt2$internship <- as.factor(prt2$internship) prt2$enrollment <- as.factor(prt2$enrollment) res <- proc_freq(prt2, tables = c("sex", FreqCounts = "internship * enrollment"), output = "report", weight = "count") res expect_equal(nrow(res[[1]]), 2) expect_equal(ncol(res[[1]]), 6) expect_equal(nrow(res[[2]]), 10) expect_equal(ncol(res[[2]]), 5) #expect_equal(nrow(res[[3]]), 4) #expect_equal(ncol(res[[3]]), 4) }) test_that("freq38: get_output_specs works as expected.", { res1 <- get_output_specs(c("A", "B", "A * B"), list(), "", "") res1 expect_equal(length(res1), 3) expect_equal(res1[[1]]$table, "A") expect_equal(res1[[2]]$table, "B") expect_equal(res1[[3]]$table, "A * B") res2 <- get_output_specs(c(tab1 = "A", "B", tab3 = "A * B"), list(), "", "") res2 expect_equal(length(res2), 3) expect_equal(names(res2), c("tab1", "B", "tab3")) expect_equal(res2[[1]]$table, "A") expect_equal(res2[[2]]$table, "B") expect_equal(res2[[3]]$table, "A * B") ot <- list(out = out_spec(stats = c("n", "pct"), shape = "wide")) res3 <- get_output_specs(c(tab1 = "A", "B", tab3 = "A * B"), ot, "", "") res3 expect_equal(length(res3), 3) expect_equal(names(res3), c("tab1", "B", "tab3")) expect_equal(res3[[1]]$table, "A") expect_equal(res3[[2]]$table, "B") expect_equal(res3[[3]]$table, "A * B") ot <- list(out1 = out_spec(table = "A", stats = c("n", "pct"), shape = "wide"), out2 = out_spec(table = "B", stats = c("n", "pct"), shape = "wide"), out3 = out_spec(table = "A * B", stats = c("n", "pct"), shape = "wide") ) res4 <- get_output_specs(NULL, ot, "", "") res4 expect_equal(length(res4), 3) expect_equal(names(res4), c("out1", "out2", "out3")) expect_equal(res4[[1]]$table, "A") expect_equal(res4[[2]]$table, "B") expect_equal(res4[[3]]$table, "A * B") ot <- list(out1 = out_spec(stats = c("n", "pct"), shape = "wide"), out2 = out_spec(table = "A * B", stats = c("chisq"), shape = "wide") ) res5 <- get_output_specs(c(tab1 = "A", "B", tab3 = "A * B"), ot, "", "") res5 expect_equal(length(res5), 4) expect_equal(names(res5), c("tab1", "B", "tab3", "out2")) expect_equal(res5[[1]]$table, "A") expect_equal(res5[[2]]$table, "B") expect_equal(res5[[3]]$table, "A * B") expect_equal(res5[[4]]$table, "A * B") expect_equal(res5[[4]]$stats, "chisq") }) test_that("freq39: get_output_oneway() works as expected.", { res1 <- get_output_oneway(prt, "internship", "count", NULL, by = c(am = 1), shape = "wide") res1 expect_equal(nrow(res1), 2) expect_equal(ncol(res1), 6) res2 <- get_output_oneway(prt, "internship", "count", NULL, by = c(am = "A", pm = "B")) res2 expect_equal(nrow(res2), 2) expect_equal(ncol(res2), 7) }) test_that("freq40: get_output_oneway() long works as expected.", { res1 <- get_output_oneway(prt, "internship", "count", NULL, by = c(am = 1), shape = "long") res1 expect_equal(nrow(res1), 3) expect_equal(ncol(res1), 5) res2 <- get_output_oneway(prt, "internship", "count", NULL, by = c(am = "A", pm = "B"), shape = "long") res2 expect_equal(nrow(res2), 3) expect_equal(ncol(res2), 6) }) test_that("freq41: get_output_twoway() works as expected.", { res1 <- get_output_twoway(prt, "internship", "enrollment", "count", NULL, FALSE, by = c(by1 = 1), shape = "wide") res1 expect_equal(nrow(res1), 4) expect_equal(ncol(res1), 9) res2 <- get_output_twoway(prt, "internship", "enrollment", "count", NULL, FALSE, by = c(by1 = "A", by2 = "B")) res2 expect_equal(nrow(res2), 4) expect_equal(ncol(res2), 10) }) test_that("freq42: get_output_twoway() long works as expected.", { res1 <- get_output_twoway(prt, "internship", "enrollment", "count", NULL, FALSE, by = c(by1 = 1), shape = "long") res1 expect_equal(nrow(res1), 4) expect_equal(ncol(res1), 8) res2 <- get_output_twoway(prt, "internship", "enrollment", "count", NULL, FALSE, by = c(by1 = "A", by2 = "B"), shape = "long") res2 expect_equal(nrow(res2), 4) expect_equal(ncol(res2), 9) }) test_that("freq43: oneway output statistics work.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair"), output = long, titles = "My first Frequency Table", weight = "Count") res expect_equal(length(res), 2) expect_equal(names(res[[1]]), c("VAR", "STAT", "blue", "brown", "green")) expect_equal(nrow(res[[1]]), 3) expect_equal(nrow(res[[2]]), 3) expect_equal(res[[2]]$STAT, c("N", "CNT", "PCT")) }) test_that("freq45: twoway output statistics work.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Region * Eyes", "Region"), titles = "My first Frequency Table", output = long, options = outcum, weight = "Count") res expect_equal(length(res), 3) expect_equal(names(res[[1]]), c("VAR", "STAT", "blue", "brown", "green")) expect_equal(nrow(res[[1]]), 5) expect_equal(nrow(res[[2]]), 5) expect_equal(res[[2]]$STAT, c("N", "CNT", "PCT", "CUMSUM", "CUMPCT")) }) test_that("freq46: output parameter works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Region * Eyes", "Region"), titles = "My first Frequency Table", weight = "Count", output = long, options = outcum) res expect_equal(length(res), 3) expect_equal(names(res[[1]]), c("VAR", "STAT", "blue", "brown", "green")) expect_equal(nrow(res[[1]]), 5) expect_equal(nrow(res[[2]]), 5) expect_equal(res[[2]]$STAT, c("N", "CNT", "PCT", "CUMSUM", "CUMPCT")) }) test_that("freq47: output report works.", { labels(dat) <- list(Eyes = "Eye Color", Hair = "Hair Color", Region = "Geographic Region") res <- proc_freq(dat, tables = c("Eyes", "Hair", Cross = "Hair * Eyes"), titles = "My first Frequency Table", by = "Region", weight = "Count", output = report) res expect_equal(length(res), 6) nms <- names(res) expect_equal(nms[1], "Region=1, Eyes") expect_equal(nms[4], "Region=2, Eyes") }) test_that("freq48: oneway output stacked works.", { res <- proc_freq(dat, tables = c("Eyes"), titles = "My first Frequency Table", by = "Region", weight = "Count", output = v(stacked)) res expect_equal(nrow(res), 18) expect_equal(ncol(res), 5) }) # test_that("freq49: twoway output stacked works.", { # # # res <- proc_freq(dat, # tables = c("Eyes * Hair"), # titles = "My first Frequency Table", # by = "Region", # view = TRUE, # weight = "Count", # report = out_spec(stats = c("n", "cnt", "pct"), shape = "stacked")) # # # res # # expect_equal(nrow(res), 90) # expect_equal(ncol(res), 7) # }) test_that("freq50: chisq output statistics works.", { res <- proc_freq(prt, tables = c("internship * enrollment"), titles = "My title", by = c("sex"), weight = "count", options = "chisq") res expect_equal(length(res), 2) expect_equal(nrow(res[[1]]), 8) expect_equal(ncol(res[[1]]), 8) expect_equal(nrow(res[[2]]), 4) expect_equal(ncol(res[[2]]), 5) }) test_that("freq51: fisher output statistics works.", { res <- proc_freq(prt, tables = c("internship * enrollment"), titles = "My title", by = c("sex"), weight = "count", options = v(fisher) ) res expect_equal(nrow(res[[1]]), 8) expect_equal(ncol(res[[1]]), 8) expect_equal(nrow(res[[2]]), 2) expect_equal(ncol(res[[2]]), 5) }) test_that("freq52: Logging function works.", { res <- log_freq(mtcars, tables = c("mpg", "cyl"), weight = "count", by = "cyl", outcnt = 6) res expect_equal(length(res), 6) }) test_that("freq53: error on unknown parameter.", { expect_error(proc_freq(prt2, tables = c("internship"), titles = "My first Frequency Table", by = c("sex", "enrollment"), fork = TRUE, weight = "count")) }) # test_that("freq54: where works before and after rename.", { # # # res <- proc_freq(prt2, # tables = c("internship"), # titles = "My first Frequency Table", # by = c("sex", "enrollment"), # weight = "count", # out = out_spec(rename = list(BY2 = "Enrollment"), # where = expression(Enrollment == "no"))) # # res # # expect_equal(nrow(res), 4) # # res <- proc_freq(prt2, # tables = c("internship"), # titles = "My first Frequency Table", # by = c("sex", "enrollment"), # weight = "count", # out = out_spec(rename = list(BY2 = "Enrollment"), # where = expression(BY2 == "no"))) # # res # # expect_equal(nrow(res), 4) # # # # }) test_that("freq56: get_table_list() works as expected.", { vars <- c("A", "B", "A * B", "A * C") res <- get_table_list(vars) res expect_equal(length(res), 4) expect_equal(res[[3]], c("A", "B")) }) test_that("freq56: get_output_tables() works as expected.", { lst <- list(out1 = out_spec(table = "A"), out2 = out_spec(table = "B"), out3 = out_spec(table = "A * B"), out4 = out_spec(table = "A * C")) res <- get_output_tables(lst) res expect_equal(length(res), 4) expect_equal(res[[3]], "A * B") }) test_that("freq55: get_nway_zero_fills() works as expected.", { lst <- list(out1 = out_spec(table = "x"), out2 = out_spec(table = "y"), out3 = out_spec(table = "x * y")) dt <- data.frame(x = c("A", "A", "B", "B"), y = c("C", "C", "C", "D"), z = c("E", "F", "F", "F"), w = c(25, 39, 18, 4)) dt res <- get_nway_zero_fills(dt, lst, "z", NULL) res expect_equal(nrow(res), 20) expect_equal(ncol(res), 5) res <- get_nway_zero_fills(dt, lst, "z", "w") res expect_equal(nrow(res), 20) expect_equal(ncol(res), 5) lst2 <- list(out1 = out_spec(table = "x")) res <- get_nway_zero_fills(dt, lst2, c("y", "z"), weight = "w") res expect_equal(nrow(res), 12) expect_equal(ncol(res), 5) }) test_that("freq52: zero count categories appear on oneway tables.", { sp <- prt2 sp[1, 2] <- "no" res <- proc_freq(sp, tables = c("internship"), titles = "My first Frequency Table", by = c("sex", "enrollment"), weight = "count") res expect_equal(ncol(res), 7) expect_equal(nrow(res), 8) res <- proc_freq(sp, tables = c("internship"), titles = "My first Frequency Table", by = c("sex", "enrollment"), weight = "count", output = report) res expect_equal(length(res), 4) expect_equal(ncol(res[[3]]), 6) expect_equal(nrow(res[[3]]), 2) }) test_that("freq52: zero count categories appear on twoway tables.", { sp <- prt2 sp[1, 2] <- "no" res <- proc_freq(sp, tables = c("internship * enrollment"), titles = "My first Frequency Table", by = c("sex"), weight = "count", output = out) res expect_equal(ncol(res), 8) expect_equal(nrow(res), 8) res <- proc_freq(sp, tables = c("internship * enrollment"), titles = "My first Frequency Table", by = c("sex"), weight = "count", output = report) res expect_equal(length(res), 2) expect_equal(ncol(res[[2]]), 5) expect_equal(nrow(res[[2]]), 10) }) test_that("freq53: notable option works as expected.", { res <- proc_freq(prt, tables = c("internship * enrollment"), titles = "My title", by = c("sex"), weight = "count", options = v(fisher, notable) ) res expect_equal(ncol(res), 5) expect_equal(nrow(res), 2) }) test_that("freq54: nopercent works on two-way.", { res <- proc_freq(dat, tables = Eyes * Hair, options = v(nocol, norow, crosstab, nopercent)) res expect_equal(ncol(res), 8) expect_equal(nrow(res), 4) }) test_that("freq55: get_nlevels works as expected.", { res <- get_nlevels(dat, "Eyes") expect_equal(nrow(res), 1) expect_equal(res$stub[1], "Eyes") expect_equal(res$levels[1], 3) res <- get_nlevels(dat, "Eyes", "Hair") res expect_equal(nrow(res), 2) expect_equal(res[["stub"]][1], "Eyes") expect_equal(res$levels[1], 3) expect_equal(res$levels[2], 5) bv <- c("Region" = 1) res <- get_nlevels(dat, "Eyes", NULL, byvars = bv) res attributes(res) expect_equal(nrow(res), 1) expect_equal(res$stub[1], "Eyes") expect_equal(res$levels[1], 3) expect_equal(is.null(attributes(res)), FALSE) res <- get_nlevels(dat, "Eyes", "Hair", byvars = bv, out = TRUE) res expect_equal(nrow(res), 1) expect_equal(res[["VAR1"]][1], 3) expect_equal(res$VAR2[1], 5) expect_equal(labels(res), list(VAR1 = "Eyes", VAR2 = "Hair" )) }) test_that("freq56: nlevels works as expected.", { res <- proc_freq(dat, tables = "Eyes", output = "report", options = "nlevels") res expect_equal(length(res), 2) expect_equal(ncol(res[[1]]), 2) expect_equal(nrow(res[[1]]), 1) res <- proc_freq(dat, tables = c("Eyes", "Hair"), output = "report", options = "nlevels") res expect_equal(length(res), 4) expect_equal(ncol(res[[1]]), 2) expect_equal(nrow(res[[1]]), 1) }) test_that("freq57: get_nlevels missing option works.", { prtm <- read.table(header = TRUE, text = ' sex internship enrollment count 1 boys yes yes 35 2 boys no yes 14 3 girls yes yes 32 4 girls no yes 53 5 boys yes no 29 6 boys no no 27 7 girls yes no 10 8 girls no no 23 9 NA NA yes 25') res <- get_nlevels(prt, "sex", missing = TRUE) res expect_equal(res$MISS[1], 0) res <- get_nlevels(prtm, "sex", missing = TRUE) res expect_equal(res$MISS[1], 1) res <- get_nlevels(prt, "sex", missing = TRUE, out = TRUE) res expect_equal(res$MISS[1], 0) res <- get_nlevels(prtm, "sex", missing = TRUE, out = TRUE) res expect_equal(res$MISS[1], 1) res <- get_nlevels(prtm, "internship", "enrollment", missing = TRUE, out = FALSE) res expect_equal(res$MISS[1], 1) expect_equal(res$MISS[2], 0) res <- get_nlevels(prtm, "internship", "enrollment", missing = TRUE, out = TRUE) res expect_equal(res$VAR1.MISS[1], 1) expect_equal(res$VAR2.MISS[1], 0) res <- get_nlevels(prtm, "internship", "enrollment", byvars = "sex = 1", missing = TRUE, out = FALSE) res expect_equal(res$MISS[1], 1) expect_equal(res$MISS[2], 0) res <- get_nlevels(prtm, "internship", "enrollment", missing = TRUE, out = TRUE) res expect_equal(res$VAR1.MISS[1], 1) expect_equal(res$VAR2.MISS[1], 0) }) test_that("freq58: proc_freq missing option works.", { prtm <- read.table(header = TRUE, text = ' sex internship enrollment count 1 boys yes yes 35 2 boys no yes 14 3 girls yes yes 32 4 girls no yes 53 5 boys yes NA 29 6 boys no no 27 7 girls yes no 10 8 girls no no 23 9 girls NA yes 25 10 girls NA no 29') res <- proc_freq(prtm, tables = v(internship), options = v(nlevels, missing)) res$tab2 r1 <- res[[1]] expect_equal(length(res), 2) expect_equal(r1$VAR[1], 3) expect_equal(r1$MISS[1], 1) expect_equal(r1$NONMISS[1], 2) res <- proc_freq(prtm, tables = internship * enrollment, options = v(nlevels, missing)) res r1 <- res[[1]] expect_equal(length(res), 2) expect_equal(r1$VAR2[1], 3) expect_equal(r1$VAR2.MISS[1], 1) expect_equal(r1$VAR2.NONMISS[1], 2) }) test_that("freq59: chi sqr works without weight.", { res <- proc_freq(prt, tables = "internship * enrollment", output = report, options = chisq) res expect_equal(length(res), 2) res2 <- res[[2]] expect_equal(res2[1, "VAL"], 0.0) expect_equal(res2[1, "DF"], 1) expect_equal(res2[1, "PROB"], 1.0) }) test_that("freq60: fisher's works without weight.", { res <- proc_freq(prt, tables = "internship * enrollment", output = report, options = fisher) res expect_equal(length(res), 2) res2 <- res[[2]] expect_equal(res2[1, 2], 2) expect_equal(res2[2, 2], 0.75714286) expect_equal(res2[3, 2], 0.75714286) expect_equal(res2[4, 2], 1) #expect_equal(nrow(res[[1]]), 14) }) test_that("freq61: factors and ordering with crosstab output works.", { res1 <- proc_freq(dat, tables = c("Eyes", "Hair", comb = "Eyes * Hair"), output = out, titles = "Eye and Hair Color of European Children") res1 datsp <- dat datsp$Eyes <- factor(dat$Eyes, levels = c("green", "brown", "blue")) datsp$Hair <- factor(dat$Hair, levels = c("fair", "medium", "red", "dark", "black")) res2 <- proc_freq(datsp, tables = c("Eyes", "Hair", comb = "Eyes * Hair"), output = out, titles = "Eye and Hair Color of European Children") res2 expect_equal(as.character(res1$Eyes$CAT), c("blue", "brown", "green")) expect_equal(as.character(res2$Eyes$CAT), c("green", "brown", "blue")) expect_equal(unique(as.character(res1$comb$CAT1)), c("blue", "brown", "green")) expect_equal(unique(as.character(res2$comb$CAT1)), c("green", "brown", "blue")) }) test_that("freq62: factors and ordering with list output works.", { res1 <- proc_freq(dat, tables = c("Eyes", "Hair", comb = "Eyes * Hair"), output = out, options = list, titles = "Eye and Hair Color of European Children") res1 datsp <- dat datsp$Eyes <- factor(dat$Eyes, levels = c("green", "brown", "blue")) datsp$Hair <- factor(dat$Hair, levels = c("fair", "medium", "red", "dark", "black")) res2 <- proc_freq(datsp, tables = c("Eyes", "Hair", comb = "Eyes * Hair"), output = out, options = list, titles = "Eye and Hair Color of European Children") res2 expect_equal(as.character(res1$Eyes$CAT), c("blue", "brown", "green")) expect_equal(as.character(res2$Eyes$CAT), c("green", "brown", "blue")) expect_equal(as.character(res1$Hair$CAT), c("black", "dark", "fair", "medium", "red")) expect_equal(as.character(res2$Hair$CAT), c("fair", "medium", "red", "dark", "black")) expect_equal(unique(as.character(res1$comb$CAT1)), c("blue", "brown", "green")) expect_equal(unique(as.character(res2$comb$CAT1)), c("green", "brown", "blue")) expect_equal(unique(as.character(res1$comb$CAT2)), c("black", "dark", "fair", "medium", "red")) expect_equal(unique(as.character(res2$comb$CAT2)), c("fair", "medium", "red", "dark", "black")) }) test_that("freq63: totals always end up at bottom.", { datsp <- dat datsp$Eyes <- sub("blue", "zed", datsp$Eyes, fixed = TRUE) res1 <- proc_freq(datsp, tables = c("Eyes", "Hair", comb = "Eyes * Hair"), output = out, titles = "Eye and Hair Color of European Children") res1 expect_equal(as.character(res1$Eyes$CAT), c("brown", "green", "zed")) expect_equal(unique(as.character(res1$comb$CAT1)), c("brown", "green","zed")) datsp$Eyes <- factor(datsp$Eyes, levels = c("green", "zed", "brown")) datsp$Hair <- factor(datsp$Hair, levels = c("fair", "medium", "red", "dark", "black")) res2 <- proc_freq(datsp, tables = c("Eyes", "Hair", comb = "Eyes * Hair"), output = out, titles = "Eye and Hair Color of European Children") res2 expect_equal(as.character(res2$Eyes$CAT), c("green", "zed", "brown")) expect_equal(unique(as.character(res2$comb$CAT1)), c("green", "zed", "brown")) }) test_that("freq64: Fisher with sort works as expected.", { prtsp <- prt prtsp$enrollment <- factor(prtsp$enrollment, c("yes", "no")) prtsp$internship <- factor(prtsp$internship, c("yes", "no")) res <- proc_freq(prtsp, tables = c(comb = "internship * enrollment"), options = Fisher, by = "sex", weight = "count") expect_equal(res$`fisher:comb`$FISHER.1.1[1], 35) expect_equal(res$`fisher:comb`$FISHER.1.1[2], 32) expect_equal(res$`fisher:comb`$FISHER.LS[1], 0.98846024) expect_equal(res$`fisher:comb`$FISHER.LS[2], 0.83173972) expect_equal(res$`fisher:comb`$FISHER.RS[1], 0.03111341) expect_equal(res$`fisher:comb`$FISHER.RS[2], 0.29935132) }) test_that("freq65: Fisher without sort works as expected.", { res <- proc_freq(prt, tables = c(comb = "internship * enrollment"), options = Fisher, by = "sex", weight = "count") expect_equal(res$`fisher:comb`$FISHER.1.1[1], 27) expect_equal(res$`fisher:comb`$FISHER.1.1[2], 23) expect_equal(res$`fisher:comb`$FISHER.LS[1], 0.98846024) expect_equal(res$`fisher:comb`$FISHER.LS[2], 0.83173972) expect_equal(res$`fisher:comb`$FISHER.RS[1], 0.03111341) expect_equal(res$`fisher:comb`$FISHER.RS[2], 0.29935132) }) test_that("freq66: nonobs keyword works as expected.", { res <- proc_freq(prt, tables = v(internship), options = v(nonobs), weight = "count") expect_equal("N" %in% names(res), FALSE) }) test_that("freq67: factor with sparse show zero counts.", { datsp <- dat datsp$Eyes <- ifelse(datsp$Eyes == "green", "brown", datsp$Eyes) datsp$Eyes <- factor(datsp$Eyes, levels = c("green", "brown", "blue")) res1 <- proc_freq(datsp, tables = c("Eyes"), output = out, options = nosparse, titles = "Eye and Hair Color of European Children") res1 res2 <- proc_freq(datsp, tables = c("Eyes"), output = out, options = sparse, titles = "Eye and Hair Color of European Children") res2 expect_equal(as.character(res1$CAT), c("brown", "blue")) expect_equal(as.character(res2$CAT), c("green", "brown", "blue")) }) test_that("freq68: factors with by work.", { datsp <- dat datsp$Eyes <- ifelse(datsp$Eyes == "green", "brown", datsp$Eyes) datsp$Eyes <- factor(datsp$Eyes, levels = c("green", "brown", "blue")) res1 <- proc_freq(datsp, tables = c("Hair"), output = out, by = "Eyes", options = nosparse, titles = "Eye and Hair Color of European Children") res1 res2 <- proc_freq(datsp, tables = c("Hair"), output = out, by = "Eyes", options = sparse, titles = "Eye and Hair Color of European Children") res2 expect_equal(unique(as.character(res1$BY)), c("brown", "blue")) expect_equal(unique(as.character(res2$BY)), c("green", "brown", "blue")) expect_equal(class(res1$BY), 'factor') expect_equal(class(res2$BY), 'factor') }) test_that("freq68: var and by as factors work.", { datsp <- dat datsp$Eyes <- ifelse(datsp$Eyes == "green", "brown", datsp$Eyes) datsp$Eyes <- factor(datsp$Eyes, levels = c("green", "brown", "blue")) datsp$Hair <- ifelse(datsp$Hair == "fair", "black", datsp$Hair) datsp$Hair <- factor(datsp$Hair, levels = c("red", "medium", "fair", "dark", "black")) res1 <- proc_freq(datsp, tables = c("Hair"), output = out, by = "Eyes", options = nosparse, titles = "Eye and Hair Color of European Children") res1 res2 <- proc_freq(datsp, tables = c("Hair"), output = out, by = "Eyes", options = sparse, titles = "Eye and Hair Color of European Children") res2 expect_equal(unique(as.character(res1$BY)), c("brown", "blue")) expect_equal(unique(as.character(res1$CAT)), c("red", "medium", "dark", "black")) expect_equal(unique(as.character(res2$BY)), c("green", "brown", "blue")) expect_equal(unique(as.character(res2$CAT)), c("red", "medium", "fair", "dark", "black")) }) test_that("freq69: Param checks work.", { expect_error(proc_freq("bork", tables = c("Hair"))) expect_error(proc_freq(dat[0, ], tables = c("Hair"))) expect_error(proc_freq(dat, tables = c("Hairy"))) expect_error(proc_freq(dat, tables = c("Hair"), output = "spork")) expect_error(proc_freq(dat, tables = c("Hair"), options = "spork")) }) test_that("freq70: Param checks work.", { tst <- read.table(header = TRUE, text = ' var1 var2 var3 1 20 NA 2 NA NA 3 40 NA ') tst$var1 tst$var2 tst$var3 res <- proc_freq(tst, tables = v(var1, var2, var3), options = nlevels) res expect_equal(is.null(res), FALSE) expect_equal(as.numeric(res$`NLevels:var3`$VAR), 0) }) test_that("freq71: factor with missing works as expected.", { datsp <- dat datsp$Eyes <- ifelse(datsp$Eyes == "green", "brown", datsp$Eyes) datsp$Eyes <- factor(datsp$Eyes, levels = c("green", "brown", "blue")) res1 <- proc_freq(datsp, tables = c("Eyes"), output = out, options = missing, titles = "Eye and Hair Color of European Children") res1 expect_equal(as.character(res1$CAT), c("green", "brown", "blue")) datsp$Eyes[2] <- NA res2 <- proc_freq(datsp, tables = c("Eyes"), output = out, options = missing, titles = "Eye and Hair Color of European Children") res2 expect_equal(as.character(res2$CAT), c(".", "blue", "brown", "green")) res3 <- proc_freq(datsp, tables = c("Eyes"), output = out, titles = "Eye and Hair Color of European Children") res3 expect_equal(as.character(res3$CAT), c("green", "brown", "blue")) res4 <- proc_freq(datsp, tables = c("Eyes * Hair"), output = out, options = missing, titles = "Eye and Hair Color of European Children") res4 expect_equal(unique(as.character(res4$CAT1)), c("green", "brown", "blue", NA)) res5 <- proc_freq(datsp, tables = c("Hair * Eyes"), output = out, options = missing, titles = "Eye and Hair Color of European Children") res5 expect_equal(unique(as.character(res5$CAT2)), c("green", "brown", "blue", NA)) }) test_that("freq72: chisquare with age group works as expected.", { agecat <- value(condition(x >= 18 & x <= 29, "18 to 29"), condition(x >=30 & x <= 39, "30 to 39"), condition(x >=40 & x <=49, "40 to 49"), condition(x >= 50, ">= 50"), as.factor = TRUE) adsl$AGECAT <- fapply(adsl$AGE, agecat) proc_freq(adsl, tables = v(AGECAT * ARM), options = v(chisq, nosparse)) -> ageg_chisq ageg_chisq expect_equal(is.nan(ageg_chisq[[2]]$VAL[1]), FALSE) expect_equal(is.nan(ageg_chisq[[2]]$VAL[2]), FALSE) expect_equal(is.nan(ageg_chisq[[2]]$PROB[1]), FALSE) expect_equal(is.nan(ageg_chisq[[2]]$PROB[2]), FALSE) })