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')
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)
})
Try the procs package in your browser
Any scripts or data that you put into this service are public.
procs documentation built on Aug. 8, 2025, 7:45 p.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')
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)
})
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.