Nothing
context("subtotal")
a = 1:7
expect_known_value(cro(net(a, Bottom = 1:2, Top = 6:7, position = "below")),
"rds/subtotal1.rds", update = FALSE)
expect_known_value(cro(net(a, Bottom = function(x) x<3, Top = 6:7, position = "below")),
"rds/subtotal1.rds", update = FALSE)
expect_known_value(cro(net(a, Bottom = 1 %thru% 2, Top = greater(5), position = "below")),
"rds/subtotal1.rds", update = FALSE)
expect_known_value(cro(net(a, Bottom = 1:2, Top = 6:7, position = "above")),
"rds/subtotal2.rds", update = FALSE)
expect_known_value(cro(net(a, Top = 6:7, Bottom = 1:2, position = "top")),
"rds/subtotal3.rds", update = FALSE)
expect_known_value(cro(net(a, Bottom = 1:2, Top = 6:7, position = "bottom")),
"rds/subtotal4.rds", update = FALSE)
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top = 6:7, position = "below")),
"rds/subtotal5.rds", update = FALSE)
expect_error(cro(subtotal(a, Bottom = 1:2 ~ 2.1, Top = 6:7 ~ 7.1, position = "below")))
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top = 6:7, position = "above")),
"rds/subtotal6.rds", update = FALSE)
expect_known_value(cro(subtotal(a, Top = 6:7, Bottom = 1:2, position = "top")),
"rds/subtotal7.rds", update = FALSE)
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top = 6:7, position = "bottom")),
"rds/subtotal8.rds", update = FALSE)
val_lab(a) = c(Three = 3)
expect_known_value(cro(net(a, 2:3, position = "below")),
"rds/subtotal9.rds", update = FALSE)
expect_known_value(cro(subtotal(a, 2:3, position = "above", new_label = "first")),
"rds/subtotal10.rds", update = FALSE)
expect_known_value(cro(net(a, 2:3, position = "top", prefix = "LAST ", new_label = "last")),
"rds/subtotal11.rds", update = FALSE)
expect_known_value(cro(subtotal(a, 2:3, position = "bottom")),
"rds/subtotal12.rds", update = FALSE)
var_lab(a) = "My 'a'"
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top = 6:7, 'My new cat' = 98:99, position = "above")),
"rds/subtotal8a.rds", update = FALSE)
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top = 6:7, 'My new cat' = gt(90), position = "above")),
"rds/subtotal8b.rds", update = FALSE)
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top = 6:7, 'My new cat' = gt(90), position = "top")),
"rds/subtotal8c.rds", update = FALSE)
expect_known_value(cro(subtotal(a, Bottom = 1:2, Top2 = 6:7, Top3 = 5:7, 'My new cat' = gt(90), position = "below")),
"rds/subtotal8d.rds", update = FALSE)
expect_known_value(cro(net(a, Bottom = 1:2, Top2 = 6:7, Top3 = 5:7, 'My new cat' = gt(90), position = "below")),
"rds/subtotal8e.rds", update = FALSE)
b = rev(a)
val_lab(b) = c(Seven = 7)
var_lab(b) = "My 'b'"
my_df = sheet(a, b)
expect_known_value(
cro(net(my_df, 1:2, Top = 6:7, position = "bottom", prefix = "NET ", new_label = "range")),
"rds/subtotal12a.rds", update = FALSE)
expect_known_value(
cro(subtotal(as.list(my_df), 1:2, Top = 6:7, position = "above")),
"rds/subtotal12b.rds", update = FALSE)
my_letters = c("a", "b", "c", "d", "e", "f")
var_lab(my_letters) = "MY LETTERS"
expect_known_value(cro(subtotal(my_letters, c("b", "c", "d"), c("a", "e"), position = "below")),
"rds/subtotal13.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, function(x) x %in% c("b", "c", "d"), c("a", "e"), position = "below")),
"rds/subtotal13.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, perl("b|c|d"), contains("a") | contains("e"), position = "below")),
"rds/subtotal13.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, c("a", "e"), c("b", "c", "d"),position = "above", prefix = "NET ")),
"rds/subtotal14.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, c("a", "e"), c("b", "c", "d"), position = "top", new_label = "range")),
"rds/subtotal15.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, c("a", "e"), c("b", "c", "d"), position = "bottom",
prefix = "NET ", new_label = "first")),
"rds/subtotal16.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, "My bcd" = c("b", "c", "d"), "My ae" = c("a", "e"),
position = "top", new_label = "range")),
"rds/subtotal17.rds", update = FALSE)
expect_known_value(cro(subtotal(my_letters, "My bcd" = c("b", "c", "d"), "My ae" = c("a", "e"), c("x", "y", "z"),
position = "above", new_label = "range")),
"rds/subtotal18.rds", update = FALSE)
expect_known_value(cro(subtotal(
set_var_lab(factor(my_letters), var_lab(my_letters)),
"My bcd" = c("b", "c", "d"), "My ae" = c("a", "e"), c("x", "y", "z"),
position = "above", new_label = "range")),
"rds/subtotal18.rds", update = FALSE)
expect_known_value(
cro(net(my_letters, "My ae" = c("a", "e"), c("b", "c", "d"),
position = "top", new_label = "range")),
"rds/subtotal18a.rds", update = FALSE)
data(mtcars)
mtcars = apply_labels(mtcars,
mpg = "Miles/(US) gallon",
cyl = "Number of cylinders",
disp = "Displacement (cu.in.)",
hp = "Gross horsepower",
drat = "Rear axle ratio",
wt = "Weight (lb/1000)",
qsec = "1/4 mile time",
vs = "Engine",
vs = c("V-engine" = 0,
"Straight engine" = 1),
am = "Transmission",
am = c("Automatic" = 0,
"Manual"=1),
gear = "Number of forward gears",
gear = c(
One = 1,
Two = 2,
Three = 3,
Four = 4,
Five = 5
),
carb = "Number of carburetors"
)
expect_known_value(
mtcars %>%
tab_cells(mpg) %>%
tab_net_cells("Low mpg" = less(mean(mpg)), "High mpg" = greater_or_equal(mean(mpg))) %>%
tab_cols(total(), carb) %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal19.rds", update = FALSE)
expect_known_value(
mtcars %>%
tab_cells(mpg) %>%
tab_net_cells("Low mpg" = less(mean(mpg)), "High mpg" = greater_or_equal(mean(mpg))) %>%
tab_cols(gear) %>%
tab_net_cols(1:2, 3:4, "5 and more" = greater(4)) %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal20.rds", update = FALSE)
expect_known_value(
mtcars %>%
tab_cells(mpg) %>%
tab_rows(gear) %>%
tab_subtotal_rows(1:2, 3:4, "5 and more" = greater(4), position = "above", prefix = "NET ", new_label = "range") %>%
tab_stat_mean() %>%
tab_pivot()
, "rds/subtotal21.rds", update = FALSE)
###########
res = mtcars %>%
tab_cells(mpg) %>%
tab_rows(gear) %>%
tab_subtotal_rows(1:2, hide(3:4), "5 and more" = greater(4), position = "above", prefix = "NET ", new_label = "range") %>%
tab_stat_mean() %>%
tab_pivot()
reference = structure(list(row_labels = c("Number of forward gears|NET One - Two|Miles/(US) gallon|Mean",
"Number of forward gears|One|Miles/(US) gallon|Mean", "Number of forward gears|Two|Miles/(US) gallon|Mean",
"Number of forward gears|NET Three - Four|Miles/(US) gallon|Mean",
"Number of forward gears|5 and more|Miles/(US) gallon|Mean",
"Number of forward gears|Five|Miles/(US) gallon|Mean"), `#Total` = c(NA,
NA, NA, 19.8518518518518, 21.38, 21.38)), row.names = c(NA, -6L
), class = c("etable", "data.frame"))
expect_equal(res, reference)
res = mtcars %>%
tab_cells(mpg) %>%
tab_rows(gear) %>%
tab_subtotal_rows(hide(1:2), hide(3:4), "5 and more" = hide(greater(4)), position = "above", prefix = "NET ", new_label = "range") %>%
tab_stat_mean() %>%
tab_pivot()
reference = structure(list(row_labels = c("Number of forward gears|NET One - Two|Miles/(US) gallon|Mean",
"Number of forward gears|NET Three - Four|Miles/(US) gallon|Mean",
"Number of forward gears|5 and more|Miles/(US) gallon|Mean"),
`#Total` = c(NA, 19.8518518518518, 21.38)), row.names = c(NA,
-3L), class = c("etable", "data.frame"))
expect_equal(res, reference)
res = mtcars %>%
tab_cells(mpg) %>%
tab_rows(gear) %>%
tab_net_rows(unhide(1:2), 3:4, "NET 5 and more" = unhide(greater(4)), position = "below", prefix = "NET ", new_label = "range") %>%
tab_stat_mean() %>%
tab_pivot()
reference = structure(list(row_labels = c("Number of forward gears|One|Miles/(US) gallon|Mean",
"Number of forward gears|Two|Miles/(US) gallon|Mean", "Number of forward gears|NET One - Two|Miles/(US) gallon|Mean",
"Number of forward gears|NET Three - Four|Miles/(US) gallon|Mean",
"Number of forward gears|Five|Miles/(US) gallon|Mean", "Number of forward gears|NET 5 and more|Miles/(US) gallon|Mean"
), `#Total` = c(NA, NA, NA, 19.8518518518518, 21.38, 21.38)), row.names = c(NA,
-6L), class = c("etable", "data.frame"))
expect_equal(res, reference)
#####
expect_known_value(
mtcars %>%
tab_cells(mpg) %>%
tab_subtotal_cells("Low mpg" = less(mean(mpg)), "High mpg" = greater_or_equal(mean(mpg)), position = "top") %>%
tab_cols(total(), carb) %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal22.rds", update = FALSE)
expect_known_value(
mtcars %>%
tab_cells(mpg) %>%
tab_net_cells("Low mpg" = less(mean(mpg)), "High mpg" = greater_or_equal(mean(mpg))) %>%
tab_cols(gear) %>%
tab_subtotal_cols(1:2, 3:4, "5 and more" = greater(4), position = "bottom") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal23.rds", update = FALSE)
expect_known_value(
mtcars %>%
tab_cells(mpg) %>%
tab_rows(gear) %>%
tab_net_rows(1:2, 3:4, "5 and more" = greater(4), position = "above", prefix = "NET ", new_label = "first") %>%
tab_stat_mean() %>%
tab_pivot()
, "rds/subtotal24.rds", update = FALSE)
categ = mrset(v1 = c(1, 2, 3, 4), v2 = c(NA, NA, 1, 2))
val_lab(categ) = c(
One = 1,
Two = 2,
Three = 3,
Four = 4
)
var_lab(categ) = "My multiple"
expect_known_value(
cro(subtotal(categ, 1:2, 3:4))
, "rds/subtotal25.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, 1:2, function(x) x>2))
, "rds/subtotal25.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, 1:2, 3:4, position = "bottom", prefix = "SUBTOTAL "))
, "rds/subtotal26.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, lte(2), gte(3), position = "bottom", prefix = "SUBTOTAL "))
, "rds/subtotal26.rds", update = FALSE)
expect_known_value(
cro(net(categ, 1:2, "ThreeFour" = 3:4, new_label = "range"))
, "rds/subtotal27.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, c(1, 3), c(2, 4), position = "above"))
, "rds/subtotal27a.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, c(1, 3), c(2, 4), position = "above"))
, "rds/subtotal27a.rds", update = FALSE)
# expect_known_value(
# categ %>%
# tab_cells(mrset(v1, v2)) %>%
# tab_subtotal_cells("Net One" = c(1, 3), "Net Two" = c(2, 4),
# position = "above",
# prefix = "NET ",
# new_label = "first") %>%
# tab_stat_cases() %>%
# tab_pivot()
# , "rds/subtotal27b.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, c(1, 3), c(2, 4), position = "top"))
, "rds/subtotal27c.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, ONE_THREE = c(1, 3), position = "below"))
, "rds/subtotal27d.rds", update = FALSE)
expect_known_value(
cro(subtotal(categ, c(1, 2), c(3, 4, 5), position = "below"))
, "rds/subtotal27e.rds", update = FALSE)
################
suppressWarnings(RNGversion("3.5.0"))
set.seed(311265)
brand = sample(c(1:9),100, replace=TRUE)
gender = sample(1:2, 100, replace=TRUE)
wave = rep(1, 50)
data2018 = data.frame(gender, brand, wave)
brand = sample(c(1:9, 15, 21),50, replace=TRUE)
gender = sample(1:2, 50, replace=TRUE)
wave = rep(2,50)
data2019 = data.frame(gender, brand, wave)
data = rbind(data2018, data2019)
val_lab(data$gender) = c("female"=2, "male"=1)
val_lab(data$brand) = c("AA1" = 1, "AA2" = 2, "AA3" = 3, "AA4"=15, "AA5"=21, "BB1" = 4, "BB2" = 5, "BB3" = 6, "CC1" = 7, "CC2" = 8, "CC3" = 9)
val_lab(data$wave) <- c("Wave 2018"=1, "Wave 2019"=2)
expect_known_value(
data %>%
tab_cols(wave %nest% gender) %>%
tab_cells(brand) %>%
tab_subtotal_cells(c(1:3,15,21), 4:6, 7:9, position = "above", prefix = "GROUP ", new_label = "range") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal28.rds", update = FALSE)
expect_known_value(
data %>%
tab_cols(wave %nest% gender) %>%
tab_cells(brand) %>%
tab_subtotal_cells(c(3, 15, 21,2,1), 7:9, position = "above", prefix = "GROUP ", new_label = "range") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal29.rds", update = FALSE)
expect_known_value(
data %>%
tab_cols(wave %nest% gender) %>%
tab_cells(brand) %>%
tab_subtotal_cells(c(1:3,15,21), 4:6, 7:9, position = "below", prefix = "GROUP ", new_label = "range") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal30.rds", update = FALSE)
expect_known_value(
data %>%
tab_cols(wave %nest% gender) %>%
tab_cells(brand) %>%
tab_subtotal_cells(c(3, 15, 21,2,1), 7:9, position = "below", prefix = "GROUP ", new_label = "range") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal31.rds", update = FALSE)
expect_known_value(
data %>%
tab_cols(wave %nest% gender) %>%
tab_cells(brand) %>%
tab_subtotal_cells(c(1:3,15,21), 4:6, 7:9, position = "top", prefix = "GROUP ", new_label = "range") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal32.rds", update = FALSE)
expect_known_value(
data %>%
tab_cols(wave %nest% gender) %>%
tab_cells(brand) %>%
tab_subtotal_cells(c(3, 15, 21,2,1), 7:9, position = "bottom", prefix = "GROUP ", new_label = "range") %>%
tab_stat_cases() %>%
tab_pivot()
, "rds/subtotal33.rds", update = FALSE)
suppressWarnings(RNGversion("3.5.0"))
set.seed(12345)
df = data.frame(group = rep(1:5, each = 4),
varA = sample(1:4, 20, replace = TRUE),
varB = sample(6:9, 20, replace = TRUE))
output = df %>%
tab_cells(varA, varB) %>%
tab_cols(total(label = "")) %>%
tab_rows(net(group, "Group 1" = 1, "All Groups" = TRUE, position = "above")) %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_pivot()
res = structure(list(row_labels = c("Group 1|varA", "Group 1|varB",
"All Groups|varA", "All Groups|varB", "2|varA", "2|varB", "3|varA",
"3|varB", "4|varA", "4|varB", "5|varA", "5|varB"), `Valid N` = c(4L,
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L), Mean = c(3.75, 7.75,
3.75, 7.75, 2, 7.75, 2.25, 7, 2, 7, 2.25, 8), SD = c(0.5, 0.957427107756338,
0.5, 0.957427107756338, 0.816496580927726, 0.5, 1.5, 1.4142135623731,
0.816496580927726, 0.816496580927726, 1.25830573921179, 1.4142135623731
), Median = c(4, 7.5, 4, 7.5, 2, 8, 2, 6.5, 2, 7, 2, 8.5)), row.names = c(NA,
-12L), class = c("etable", "data.frame"))
expect_equal(output, res)
output = df %>%
tab_cells(varA, varB) %>%
tab_cols(total(label = "")) %>%
tab_rows(net(group, "Group 1" = 1, "All Groups" = other(), position = "above")) %>%
tab_stat_fun("Valid N" = w_n, "Mean" = w_mean, "SD" = w_sd,
"Median" = w_median, method = list) %>%
tab_pivot()
res = structure(list(row_labels = c("Group 1|varA", "Group 1|varB",
"All Groups|varA", "All Groups|varB"), `Valid N` = c(4L, 4L,
20L, 20L), Mean = c(3.75, 7.75, 2.45, 7.5), SD = c(0.5, 0.957427107756338,
1.14593101656986, 1.05131496607569), Median = c(4, 7.5, 2, 7.5
)), row.names = c(NA, -4L), class = c("etable", "data.frame"))
if(as.numeric(version$major) >=4){
expect_equal(output, res)
}
context("inside_columns with subtotal issue #102")
data(infert)
res = infert %>%
tab_cells(parity) %>%
tab_cols(
#total(),
subtotal(
education,
"LESS THAN 12 Y.O." = levels(education)[1:2],
"GREATER THAN 5 Y.O." = levels(education)[2:3]
)[,-1]
) %>%
tab_stat_cases() %>%
tab_pivot(
stat_position = "inside_columns"
)
expect_identical(res,
structure(list(row_labels = c("parity|1", "parity|2", "parity|3",
"parity|4", "parity|5", "parity|6", "parity|#Total cases"), `0-5yrs` = c(3,
NA, NA, 3, NA, 6, 12), `6-11yrs` = c(42, 42, 21, 12, 3, NA, 120
), `LESS THAN 12 Y.O.` = c(45, 42, 21, 15, 3, 6, 132), `6-11yrs` = c(42,
42, 21, 12, 3, NA, 120), `12+ yrs` = c(54, 39, 15, 3, 3, 2, 116
), `GREATER THAN 5 Y.O.` = c(96, 81, 36, 15, 6, 2, 236)), row.names = c(NA,
-7L), class = c("etable", "data.frame"))
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.