Nothing
if(isTRUE(getOption("covr"))) {
context("custom tables")
suppressWarnings(RNGversion("3.5.0"))
data(mtcars)
# add labels to dataset
mtcars = apply_labels(mtcars,
mpg = "Miles/(US) gallon",
cyl = "Number of cylinders",
disp = "Displacement (cu.in.)",
carb = NULL,
qsec = "1/4 mile time",
hp = "Gross horsepower",
vs = "Engine",
vs = num_lab("
0 V-engine
1 Straight engine
"),
am = "Transmission",
am = num_lab("
0 Automatic
1 Manual
")
)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun(w_mean) %>%
tab_pivot()
expect_known_value(res, "rds/ctable0.rds", update = FALSE)
expect_error(mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun(w_mean) %>%
tab_caption("my table") %>%
tab_pivot()
)
expect_identical(
mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun(w_mean) %>%
tab_pivot() %>%
tab_caption("my ", "table"),
mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun(w_mean) %>%
tab_pivot() %>%
set_caption("my table")
)
res = mtcars %>%
tab_cols(vs) %>%
tab_cells(mpg, disp) %>%
tab_rows(am) %>%
tab_stat_fun(w_mean) %>%
tab_pivot
expect_known_value(res, "rds/ctable0.rds", update = FALSE)
res = mtcars %>%
tab_rows(am) %>%
tab_cols(vs) %>%
tab_cells(mpg, disp) %>%
tab_stat_fun(w_mean) %>%
tab_pivot
expect_known_value(res, "rds/ctable0.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun(w_mean = w_mean) %>%
tab_pivot
expect_known_value(res, "rds/ctable1.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun("|" = w_mean) %>%
tab_pivot
expect_known_value(res, "rds/ctable2.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun("|" = w_mean, label = "Mean value") %>%
tab_pivot
expect_known_value(res, "rds/ctable3.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun("|" = w_mean, label = "Mean value") %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable3.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_fun("|" = w_mean, label = "Mean value") %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable4.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_mean(label = "Mean value") %>%
tab_pivot()
expect_known_value(res, "rds/ctable3.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_mean(label = "Mean value") %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable4.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_mean() %>%
tab_stat_sd() %>%
tab_stat_valid_n() %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable5.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(vs) %>%
tab_rows(am) %>%
tab_stat_mean() %>%
tab_stat_sd() %>%
tab_stat_valid_n() %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable6.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp) %>%
tab_cols(total(), vs) %>%
tab_rows(am) %>%
tab_stat_fun(summary) %>%
tab_pivot()
if(as.numeric(version$major) ==3 && as.numeric(version$minor)<4){
expect_known_value(res, "rds/ctable7.rds", update = FALSE)
} else {
expect_known_value(res, "rds/ctable7_R3.4.rds", update = FALSE)
}
res = mtcars %>%
tab_cells(vs) %>%
tab_cols(total(), am) %>%
tab_stat_cpct(total_row_position = "none", label = "col %") %>%
tab_stat_rpct(total_row_position = "none", label = "row %") %>%
tab_stat_tpct(total_row_position = "none", label = "table %") %>%
tab_cells(total(vs, label = "#Total|cases")) %>%
tab_stat_cases(total_row_position = "none") %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable8.rds", update = FALSE)
res = mtcars %>%
tab_total_row_position("none") %>%
tab_cells(vs) %>%
tab_cols(total(), am) %>%
tab_stat_cpct(label = "col %") %>%
tab_stat_rpct(label = "row %") %>%
tab_stat_tpct(label = "table %") %>%
tab_cells(total(vs, label = "#Total|cases")) %>%
tab_stat_cases() %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable8.rds", update = FALSE)
res = mtcars %>%
tab_subgroup(vs == 0) %>%
tab_cells(vs) %>%
tab_cols(total(), am) %>%
tab_subgroup() %>%
tab_stat_cpct(total_row_position = "none", label = "col %") %>%
tab_stat_rpct(total_row_position = "none", label = "row %") %>%
tab_stat_tpct(total_row_position = "none", label = "table %") %>%
tab_cells(total(vs, label = "#Total|cases")) %>%
tab_stat_cases(total_row_position = "none") %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable8.rds", update = FALSE)
res = mtcars %>%
tab_subgroup(vs == 0) %>%
tab_cells(vs) %>%
tab_cols(total(), am) %>%
tab_stat_cpct(total_row_position = "none", label = "col %") %>%
tab_stat_rpct(total_row_position = "none", label = "row %") %>%
tab_stat_tpct(total_row_position = "none", label = "table %") %>%
tab_cells(total(vs, label = "#Total|cases")) %>%
tab_stat_cases(total_row_position = "none") %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable9.rds", update = FALSE)
res = mtcars %>%
tab_cells(cyl) %>%
tab_cols(total(), am) %>%
tab_stat_rpct(total_row_position = "none") %>%
tab_pivot() %>%
tab_transpose() %>%
tab_sort_desc()
expect_known_value(res, "rds/ctable10.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, disp, hp) %>%
tab_cols(total(label = "#Total| "), am) %>%
tab_stat_fun(Mean = w_mean, "Std. dev" = w_sd, "Valid N" = w_n, method = list) %>%
tab_sort_asc() %>%
tab_transpose() %>%
tab_pivot() %>%
split_columns()
expect_known_value(res, "rds/ctable11.rds", update = FALSE)
set.seed(1)
df = data.frame(area=rep(c('Area 1','Area 2'), each=6),
var_orange=sample(0:1, 12, T),
var_banana=sample(0:1, 12, T),
var_melon=sample(0:1, 12, T),
var_mango=sample(0:1, 12, T))
res = df %>%
tab_cells(mdset(var_orange, var_banana, var_melon, var_mango)) %>%
tab_cols(total(), list(area)) %>%
tab_stat_cpct_responses(total_row_position = "below", total_statistic = "u_responses") %>%
tab_pivot()
expect_known_value(res, "rds/ctable12.rds", update = FALSE)
res = mtcars %>%
tab_cells(cyl, carb) %>%
tab_cols(total(), am %nest% vs) %>%
tab_stat_fun(Mean = w_mean, "Std. dev" = w_sd, "Valid N" = w_n) %>%
tab_stat_cpct() %>%
tab_pivot()
expect_known_value(res, "rds/ctable13.rds", update = FALSE)
res = mtcars %>%
tab_cols(total(), am %nest% vs) %>%
tab_cells(cyl) %>%
tab_stat_fun(Mean = w_mean, "Std. dev" = w_sd, "Valid N" = w_n) %>%
tab_stat_cpct() %>%
tab_cells(carb) %>%
tab_stat_fun(Mean = w_mean, "Std. dev" = w_sd, "Valid N" = w_n) %>%
tab_stat_cpct() %>%
tab_pivot()
expect_known_value(res, "rds/ctable14.rds", update = FALSE)
res = mtcars %>%
tab_cols(total(), am %nest% vs)
for(each in qc(cyl, carb, hp)){
res = res %>% tab_cells(vars(each)) %>%
tab_stat_fun(Mean = w_mean, "Std. dev" = w_sd, "Valid N" = w_n) %>%
tab_stat_cpct()
}
res = res %>% tab_pivot()
expect_known_value(res, "rds/ctable15.rds", update = FALSE)
res = mtcars %>%
tab_cells(cyl, carb) %>%
tab_cols(total(), am %nest% vs) %>%
tab_stat_fun(w_mean, w_sd, w_n, method = list) %>%
tab_pivot()
expect_known_value(res, "rds/ctable16.rds", update = FALSE)
res = mtcars %>%
tab_cells(cyl) %>%
tab_cols(total(), am) %>%
tab_stat_cpct(total_row_position = "none", label = "col %") %>%
tab_stat_rpct(total_row_position = "none", label = "row %") %>%
tab_stat_tpct(total_row_position = "none", label = "table %") %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable17.rds", update = FALSE)
res = mtcars %>%
tab_cells(cyl) %>%
tab_cols(total(), am) %>%
tab_total_row_position("none") %>%
tab_stat_cpct(label = "col %") %>%
tab_stat_rpct(label = "row %") %>%
tab_stat_tpct(label = "table %") %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable17.rds", update = FALSE)
res = mtcars %>%
tab_cells(cyl) %>%
tab_cols(total(), am) %>%
tab_rows(vs) %>%
tab_stat_cpct(total_row_position = "none", label = "col %") %>%
tab_stat_rpct(total_row_position = "none", label = "row %") %>%
tab_stat_tpct(total_row_position = "none", label = "table %") %>%
tab_pivot(stat_position = "inside_rows")
expect_known_value(res, "rds/ctable18.rds", update = FALSE)
context("custom tables summary stats")
mtcars$mpg[1:2] = NA
mtcars$wt[4:5] = NA
mtcars$wt[6] = -1
mtcars$wt[15] = -1
mtcars$wt[16] = 0
mtcars$wt[20] = NA
# write_labelled_spss(mtcars, "mtcars.csv")
res = mtcars %>% tab_cells(mpg, qsec, hp, disp) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable19.rds", update = FALSE)
res = mtcars %>%
tab_weight(wt) %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight() %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable19.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable20.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_subgroup(!is.na(wt) & wt>0) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable20.rds", update = FALSE)
res = mtcars %>%
tab_subgroup(!is.na(wt) & wt>0) %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
expect_known_value(res, "rds/ctable20.rds", update = FALSE)
res1 = sheet(a = c(1, 2, 3, 4, 5), b = c(5, 5, 1, 2, NA)) %>%
tab_cells(a, b) %>%
tab_mis_val(3:5) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
res2 = sheet(a = c(1, 2, 3, 4, 5), b = c(5, 5, 1, 2, NA)) %>%
tab_cells(a, b) %>%
tab_mis_val(gt(2)) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
res4 = sheet(a = c(1, 2, 3, 4, 5), b = c(5, 5, 1, 2, NA)) %>%
tab_cells(a, b) %>%
tab_mis_val(3 | gt(3)) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
res3 = sheet(a = c(1, 2, NA, NA, NA), b = c(NA, NA, 1, 2, NA)) %>%
tab_mis_val(1:2) %>%
tab_cells(a, b) %>%
tab_mis_val() %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns")
expect_identical(res1, res2)
expect_identical(res1, res3)
expect_identical(res1, res4)
data("product_test")
codeframe_likes = num_lab("
1 Liked everything
2 Disliked everything
3 Chocolate
4 Appearance
5 Taste
6 Stuffing
7 Nuts
8 Consistency
98 Other
99 Hard to answer
")
set.seed(1)
pr_t = product_test %>%
let(
# recode age by groups
age_cat = if_val(s2a, lo %thru% 25 ~ 1, lo %thru% hi ~ 2),
wgt = runif(.N, 0.25, 4)
) %>%
apply_labels(
c1 = "Preferences",
c1 = num_lab("
1 VSX123
2 SDF456
3 Hard to say
"),
age_cat = "Age",
age_cat = c("18 - 25" = 1, "26 - 35" = 2),
a1_1 = "Likes. VSX123",
b1_1 = "Likes. SDF456",
a1_1 = codeframe_likes,
b1_1 = codeframe_likes,
a22 = "Overall quality. VSX123",
b22 = "Overall quality. SDF456",
a22 = num_lab("
1 Extremely poor
2 Very poor
3 Quite poor
4 Neither good, nor poor
5 Quite good
6 Very good
7 Excellent
"),
b22 = num_lab("
1 Extremely poor
2 Very poor
3 Quite poor
4 Neither good, nor poor
5 Quite good
6 Very good
7 Excellent
")
)
expect_error(
pr_t %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_cases(
total_statistic = c("u_cases", "u_repsonses", "u_cpct", "u_cpct_repsonses", "u_rpct", "u_tpct",
"w_cases", "w_repsonses", "w_cpct", "w_cpct_repsonses", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
)
res = pr_t %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_cases(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable20_1.rds", update = FALSE
)
# for code coverage
res = pr_t %>% cross_cases(list(mrset(a1_1 %to% a1_6), a22),
list(mrset(b1_1 %to% b1_6), b22),
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct")
)
expect_known_value(
res,
"rds/ctable20_1.rds", update = FALSE
)
res = pr_t %>% cross_cases(list(mrset(a1_1 %to% a1_6), a22),
list(mrset(b1_1 %to% b1_6), b22),
weight = 1,
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct")
)
expect_known_value(
res,
"rds/ctable20_1a.rds", update = FALSE
)
#####
res = pr_t %>%
tab_total_statistic("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct") %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_cases() %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable20_1.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_cases(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable21.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_cpct(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable22.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_rpct(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable23.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_tpct(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable24.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cells(mrset(a1_1 %to% a1_6), a22) %>%
tab_cols(mrset(b1_1 %to% b1_6), b22) %>%
tab_stat_cpct_responses(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable25.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cols(drop_unused_labels(a22), drop_unused_labels(b22)) %>%
tab_cells(mrset(a1_1 %to% a1_6)) %>%
tab_stat_cpct_responses(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_sort_desc() %>%
tab_cells(mrset(b1_1 %to% b1_6)) %>%
tab_stat_cpct_responses(
total_statistic = c("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct"
)) %>%
tab_sort_asc() %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable25_sorting.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cols(drop_unused_labels(a22), drop_unused_labels(b22)) %>%
tab_cells(mrset(a1_1 %to% a1_6)) %>%
tab_total_statistic("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct") %>%
tab_stat_cpct_responses() %>%
tab_sort_desc() %>%
tab_cells(mrset(b1_1 %to% b1_6)) %>%
tab_stat_cpct_responses() %>%
tab_sort_asc() %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable25_sorting.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cols(drop_unused_labels(a22), drop_unused_labels(b22)) %>%
tab_cells(mrset(a1_1 %to% a1_6)) %>%
tab_total_statistic("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct") %>%
tab_stat_cpct_responses() %>%
tab_sort_desc() %>%
tab_cells(mrset(b1_1 %to% b1_6)) %>%
tab_total_label("Wow! responses") %>%
tab_stat_cpct_responses(total_statistic = "u_cases") %>%
tab_sort_asc() %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable25_different_total.rds", update = FALSE
)
res = pr_t %>%
tab_weight(wgt) %>%
tab_cols(drop_unused_labels(a22), drop_unused_labels(b22)) %>%
tab_cells(mrset(a1_1 %to% a1_6)) %>%
tab_total_statistic("u_cases", "u_responses", "u_cpct", "u_rpct", "u_tpct",
"w_cases", "w_responses", "w_cpct", "w_rpct", "w_tpct") %>%
tab_stat_cpct_responses() %>%
tab_sort_desc() %>%
tab_cells(mrset(b1_1 %to% b1_6)) %>%
tab_total_label(paste0("Wow! responses ", var_lab(a22))) %>%
tab_stat_cpct_responses(total_statistic = "u_cases") %>%
tab_sort_asc() %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable25_different_total2.rds", update = FALSE
)
# pr_t %>%
# tab_cols(total(), age_cat) %>%
# tab_cells(unvr(mrset(a1_1 %to% a1_6))) %>%
# tab_stat_cpct(label = var_lab(a1_1)) %>%
# tab_cells(unvr(mrset(b1_1 %to% b1_6))) %>%
# tab_stat_cpct(label = var_lab(b1_1)) %>%
# tab_pivot(stat_position = "inside_columns")
#############
res = mtcars %>%
tab_cells(qsec, mpg) %>%
tab_stat_fun(my_fun = w_mean, w_median) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable26.rds", update = FALSE
)
res = mtcars %>%
tab_cells(vars(qc(mpg, qsec, hp, disp))) %>%
tab_rows(am) %>%
tab_cols(vs) %>%
tab_stat_fun_df(w_cor) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable27.rds", update = FALSE
)
res = mtcars %>%
tab_cells(vars(qc(mpg, qsec, hp, disp))) %>%
tab_rows(am %nest% vs) %>%
tab_stat_fun_df(w_cor) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable28.rds", update = FALSE
)
res = mtcars %>% tab_cells() %>%
tab_rows() %>%
tab_cols() %>%
tab_stat_cases() %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable29.rds", update = FALSE
)
res = mtcars %>%
tab_cells(vars(qc(mpg, qsec, hp, disp))) %>%
tab_rows(am %nest% vs) %>%
tab_stat_fun_df(sum = colSums, mean = colMeans, method = list) %>%
tab_pivot()
expect_known_value(
res,
"rds/ctable30.rds", update = FALSE
)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_columns", stat_label = "outside")
expect_known_value(res, "rds/ctable31.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "inside_rows", stat_label = "outside")
expect_known_value(res, "rds/ctable32.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "outside_rows", stat_label = "outside")
expect_known_value(res, "rds/ctable33.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_cols(total(), am, vs) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "outside_columns", stat_label = "outside")
expect_known_value(res, "rds/ctable34.rds", update = FALSE)
mtcars2 = mtcars
mtcars2$am = unvr(mtcars2$am)
res = mtcars2 %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_cols(total(), "My am" = am) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max() %>%
tab_pivot(stat_position = "outside_columns", stat_label = "outside")
expect_known_value(res, "rds/ctable35.rds", update = FALSE)
mtcars2$vs = unvr(mtcars2$vs)
res = mtcars2 %>%
tab_cells("My vs" = vs) %>%
tab_cols(total(), "My am" = am) %>%
tab_stat_cpct() %>%
tab_pivot()
expect_known_value(res, "rds/ctable36.rds", update = FALSE)
res = mtcars %>%
tab_cells(mpg, qsec, hp, disp) %>%
tab_weight(wt) %>%
tab_stat_mean() %>%
tab_stat_median() %>%
tab_stat_sd() %>%
tab_stat_sum() %>%
tab_stat_se() %>%
tab_stat_unweighted_valid_n() %>%
tab_stat_valid_n() %>%
tab_stat_min() %>%
tab_stat_max()
expect_output_file(print(res), "rds/print_intermediate_table.txt")
context("custom tables error")
expect_error(
mtcars %>% tab_stat_cases()
)
expect_error(
mtcars %>% tab_stat_cpct()
)
expect_error(
mtcars %>% tab_stat_cpct_responses()
)
expect_error(
mtcars %>% tab_stat_rpct()
)
expect_error(
mtcars %>% tab_stat_tpct()
)
expect_error(
mtcars %>% tab_stat_fun()
)
expect_error(
mtcars %>% tab_stat_fun_df()
)
expect_error(
mtcars %>% tab_cells(am) %>% tab_pivot()
)
expect_error(
mtcars %>% tab_pivot()
)
expect_error(
1:5 %>% tab_cells(42)
)
context("custom table long expression as argument")
res = mtcars %>%
tab_cells(list(am, am, am, am, am, am, am, am, am, am, am, am, am, am, am, am)) %>%
tab_stat_mean() %>%
tab_pivot()
expect_known_value(res, "rds/ctable37.rds", update = FALSE)
res = mtcars %>%
tab_total_row_position("above") %>%
tab_total_statistic("u_cases", "u_rpct") %>%
tab_total_label(paste(var_lab(mpg), c("unw. cases", "unw. row pct."))) %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_cases() %>%
tab_pivot()
res2 = mtcars %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_cases(total_row_position = "above",
total_statistic = c("u_cases", "u_rpct"),
total_label = paste(var_lab(mtcars$mpg), c("unw. cases", "unw. row pct."))) %>%
tab_pivot()
expect_identical(res, res2)
res = mtcars %>%
tab_total_statistic("u_cases", "u_rpct") %>%
tab_total_row_position("above") %>%
tab_total_label(paste(var_lab(mpg), c("unw. cases", "unw. row pct."))) %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_cpct() %>%
tab_pivot()
res2 = mtcars %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_cpct(total_row_position = "above",
total_statistic = c("u_cases", "u_rpct"),
total_label = paste(var_lab(mtcars$mpg), c("unw. cases", "unw. row pct."))) %>%
tab_pivot()
expect_identical(res, res2)
res = mtcars %>%
tab_total_label(paste(var_lab(mpg), c("unw. cases", "unw. row pct."))) %>%
tab_total_statistic("u_cases", "u_rpct") %>%
tab_total_row_position("above") %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_tpct() %>%
tab_pivot()
res2 = mtcars %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_tpct(total_row_position = "above",
total_statistic = c("u_cases", "u_rpct"),
total_label = paste(var_lab(mtcars$mpg), c("unw. cases", "unw. row pct."))) %>%
tab_pivot()
expect_identical(res, res2)
res = mtcars %>%
tab_total_label(paste(var_lab(mpg), c("unw. cases", "unw. row pct."))) %>%
tab_total_statistic("u_cases", "u_rpct") %>%
tab_total_row_position("above") %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_rpct() %>%
tab_pivot()
res2 = mtcars %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_rpct(total_row_position = "above",
total_statistic = c("u_cases", "u_rpct"),
total_label = paste(var_lab(mtcars$mpg), c("unw. cases", "unw. row pct."))) %>%
tab_pivot()
expect_identical(res, res2)
res = mtcars %>%
tab_total_label(paste(var_lab(mpg), c("unw. cases", "unw. row pct."))) %>%
tab_total_statistic("u_cases", "u_rpct") %>%
tab_total_row_position("above") %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_cpct_responses() %>%
tab_pivot()
res2 = mtcars %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_stat_cpct_responses(total_row_position = "above",
total_statistic = c("u_cases", "u_rpct"),
total_label = paste(var_lab(mtcars$mpg), c("unw. cases", "unw. row pct."))) %>%
tab_pivot()
expect_identical(res, res2)
for(each_stat in c(tab_stat_cases, tab_stat_cpct,
tab_stat_cpct_responses, tab_stat_rpct, tab_stat_tpct)){
res = mtcars %>%
tab_total_label(paste(var_lab(mpg), c("unw. cases", "unw. row pct."))) %>%
tab_total_statistic("u_cases", "u_rpct") %>%
tab_total_row_position("above") %>%
tab_cells(am) %>%
tab_cols(vs) %>%
tab_total_label() %>%
tab_total_statistic() %>%
tab_total_row_position() %>%
each_stat() %>%
tab_pivot()
res2 = mtcars %>%
tab_cells(am) %>%
tab_cols(vs) %>%
each_stat() %>%
tab_pivot()
expect_identical(res, res2)
}
res = mtcars %>%
tab_row_label("Table!", "Start!") %>%
tab_cells(vs) %>%
tab_cols(total(), am) %>%
tab_stat_mean() %>%
tab_row_label("Wow! Percent! %%%", label = var_lab(vs)) %>%
tab_stat_cpct(total_row_position = "none") %>%
tab_row_label(var_lab(am), var_lab(mpg)) %>%
tab_row_label("### the end ###") %>%
tab_pivot()
expect_known_value(res, "rds/ctable38.rds", update = FALSE)
res = mtcars %>%
tab_cells(vs) %>%
tab_cols(total(), am) %>%
tab_stat_mean() %>%
tab_row_label("Wow! Percent! %%%") %>%
tab_stat_cpct() %>%
tab_pivot()
context("tab_last_vstack/tab_last_hstack")
res = pr_t %>% tab_cols(total(), age_cat) %>%
tab_cells("Mean" = unlab(a22)) %>%
tab_stat_mean(label = var_lab(a22)) %>%
tab_cells("Mean" = unlab(b22)) %>%
tab_stat_mean(label = var_lab(b22)) %>%
tab_last_hstack(stat_position = "inside_columns") %>%
tab_cells("Column %" = unlab(a22)) %>%
tab_stat_cpct(label = var_lab(a22)) %>%
tab_cells("Column %" = unlab(b22)) %>%
tab_stat_cpct(label = var_lab(b22)) %>%
tab_last_hstack(stat_position = "inside_columns") %>%
tab_pivot() %>%
make_subheadings()
expect_known_value(
res,
"rds/ctable40.rds", update = FALSE
)
res = pr_t %>% tab_cols(total(), age_cat) %>%
tab_cells("Mean" = unlab(a22)) %>%
tab_stat_mean(label = var_lab(a22)) %>%
tab_cells("Mean" = unlab(b22)) %>%
tab_stat_mean(label = var_lab(b22)) %>%
tab_last_hstack(stat_position = "outside_columns",
stat_label = "outside") %>%
tab_cells("Column %" = unlab(a22)) %>%
tab_stat_cpct(label = var_lab(a22)) %>%
tab_cells("Column %" = unlab(b22)) %>%
tab_stat_cpct(label = var_lab(b22)) %>%
tab_last_hstack(stat_position = "outside_columns",
stat_label = "outside") %>%
tab_pivot() %>%
make_subheadings()
expect_known_value(
res,
"rds/ctable41.rds", update = FALSE
)
context("tab_pivot inside columns double labels")
res = mtcars %>%
tab_cells(am) %>%
tab_cols(total(), vs, vs) %>%
tab_total_row_position("none") %>%
tab_stat_cpct(label = "col %") %>%
tab_stat_rpct(label = "row %") %>%
tab_stat_tpct(label = "table %") %>%
tab_pivot(stat_position = "inside_columns")
expect_equal(res, structure(list(row_labels = c("Transmission|Automatic", "Transmission|Manual"
), `#Total|col %` = c(59.375, 40.625), `#Total|row %` = c(100,
100), `#Total|table %` = c(59.375, 40.625), `Engine|V-engine|col %` = c(66.6666666666667,
33.3333333333333), `Engine|V-engine|row %` = c(63.1578947368421,
46.1538461538462), `Engine|V-engine|table %` = c(37.5, 18.75),
`Engine|Straight engine|col %` = c(50, 50), `Engine|Straight engine|row %` = c(36.8421052631579,
53.8461538461538), `Engine|Straight engine|table %` = c(21.875,
21.875), `Engine|V-engine|col %` = c(66.6666666666667, 33.3333333333333
), `Engine|V-engine|row %` = c(63.1578947368421, 46.1538461538462
), `Engine|V-engine|table %` = c(37.5, 18.75), `Engine|Straight engine|col %` = c(50,
50), `Engine|Straight engine|row %` = c(36.8421052631579,
53.8461538461538), `Engine|Straight engine|table %` = c(21.875,
21.875)), row.names = c(NA, -2L), 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.