Nothing
tests/testthat/test-freq.R
In procs: Recreates Some 'SAS®' Procedures in 'R'
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')
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(res2[1, 2], 0.8189423)
expect_equal(res2[2, 2], 1)
expect_equal(res2[3, 2], 0.365489592)
#expect_equal(nrow(res[[2]]), 14)
})
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, 2], 4.23661395)
expect_equal(res2[2, 2], 1)
expect_equal(res2[3, 2], 0.039560993)
res4 <- res[[4]]
expect_equal(res4[1, 2], 0.55926894)
expect_equal(res4[2, 2], 1)
expect_equal(res4[3, 2], 0.45455495)
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, 2], 4.23661395)
expect_equal(res2[1, 3], 1)
expect_equal(res2[1, 4], 0.039560993)
expect_equal(res2[2, 2], 0.55926894)
expect_equal(res2[2, 3], 1)
expect_equal(res2[2, 4], 0.45455495)
})
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]]), 2)
expect_equal(ncol(res[[2]]), 4)
})
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, 2], 0.0)
expect_equal(res2[2, 2], 1)
expect_equal(res2[3, 2], 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))
})
Try the procs package in your browser
Any scripts or data that you put into this service are public.
procs documentation built on May 29, 2024, 2:12 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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')
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(res2[1, 2], 0.8189423)
expect_equal(res2[2, 2], 1)
expect_equal(res2[3, 2], 0.365489592)
#expect_equal(nrow(res[[2]]), 14)
})
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, 2], 4.23661395)
expect_equal(res2[2, 2], 1)
expect_equal(res2[3, 2], 0.039560993)
res4 <- res[[4]]
expect_equal(res4[1, 2], 0.55926894)
expect_equal(res4[2, 2], 1)
expect_equal(res4[3, 2], 0.45455495)
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, 2], 4.23661395)
expect_equal(res2[1, 3], 1)
expect_equal(res2[1, 4], 0.039560993)
expect_equal(res2[2, 2], 0.55926894)
expect_equal(res2[2, 3], 1)
expect_equal(res2[2, 4], 0.45455495)
})
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]]), 2)
expect_equal(ncol(res[[2]]), 4)
})
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, 2], 0.0)
expect_equal(res2[2, 2], 1)
expect_equal(res2[3, 2], 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))
})
Try the procs package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.