if(isTRUE(getOption("covr"))){ context("elementary_fre") suppressWarnings(RNGversion("3.5.0")) data(mtcars) mtcars = mtcars %>% apply_labels( 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", carb = "Number of carburetors" ) mtcars$am[1:2] = NA expect_equal_to_reference(fre(mtcars$am), "rds/fre2.5.rds", update = FALSE) mtcars$vs[4:5] = NA mtcars$weight = 2 mtcars$vs1 = ifelse(1:32<=16, mtcars$vs, NA) mtcars$vs2 = ifelse(1:32>16, mtcars$vs, NA) mtcars$vs1[4:5] = NA ############################################################################################ ############################################################################################ ############################################################################################ ############################################################################################ context("etable methods") expect_known_value(fre(mtcars$am)[,"Count"], "rds/fre2.6.rds", update = FALSE) expect_known_value(fre(mtcars$am)[2, ], "rds/fre2.7.rds", update = FALSE) expect_known_value(fre(mtcars$am)[,"Count"][,1], "rds/fre2.6.rds", update = FALSE) expect_known_value(fre(mtcars$am)[,"Count"][2,], "rds/fre2.8.rds", update = FALSE) expect_known_value(fre(mtcars$am)[,"Count", drop = TRUE], "rds/fre2.9.rds", update = FALSE) expect_known_value(fre(mtcars$am)[,"Count", drop = TRUE][3], "rds/fre2.10.rds", update = FALSE) expect_known_value(fre(mtcars$am)[,"Count"][2, , drop = TRUE], "rds/fre2.11.rds", update = FALSE) context("fre drop_unused") a = factor(c("a", "b", "c"), levels = rev(c("a", "b", "c", "d", "e"))) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = FALSE) ,"rds/fre_new_args1.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = TRUE),"rds/fre_new_args2.rds", update = FALSE) var_lab(a) = "My 'a' with labels" expect_known_value(fre(a),"rds/fre_new_args3.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE),"rds/fre_new_args4.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = TRUE),"rds/fre_new_args5.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = TRUE, prepend_var_lab = TRUE),"rds/fre_new_args6.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = FALSE),"rds/fre_new_args7.rds", update = FALSE) a = 3:5 val_lab(a) = autonum(letters[5:1]) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = FALSE),"rds/fre_new_args1.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = TRUE),"rds/fre_new_args2.rds", update = FALSE) var_lab(a) = "My 'a' with labels" expect_known_value(fre(a),"rds/fre_new_args3.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE),"rds/fre_new_args4.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = TRUE),"rds/fre_new_args5.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = TRUE, prepend_var_lab = TRUE),"rds/fre_new_args6.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE, prepend_var_lab = FALSE),"rds/fre_new_args7.rds", update = FALSE) context("fre and cro examples") a = factor(c("a", "b", "c"), levels = rev(c("a", "b", "c"))) expect_known_value(fre(a), "rds/order_factor_fre20.rds", update = FALSE) expect_known_value(cro(a, list(a, total())), "rds/order_factor_cro20a.rds", update = FALSE) expect_known_value(cro(list(a), list(a, total())), "rds/order_factor_cro20.rds", update = FALSE) expect_known_value(cro(list(a), list(a, total()), total_label = "BASE"), "rds/order_factor_cro21.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_label = "BASE"), "rds/order_factor_cro22.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_statistic = "w_cases", total_label = "BASE"), "rds/order_factor_cro23.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_statistic = c("u_cases", "w_cases"), total_label = "BASE"), "rds/order_factor_cro24.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_statistic = c("u_cases", "w_cases"), total_label = c("BASE", "W_BASE")), "rds/order_factor_cro25.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_statistic = c("u_cases", "w_cases"), total_label = c("BASE", "W_BASE"), subgroup = a=="a"), "rds/order_factor_cro26.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_statistic = c("u_cases", "w_cases"), total_label = c("BASE", "W_BASE"), subgroup = FALSE), "rds/order_factor_cro27.rds", update = FALSE) expect_known_value( cro(list(a), list(a, total()), weight = 2, total_statistic = c("w_cases", "u_cases"), total_label = c("W_BASE", "BASE")), "rds/order_factor_cro28.rds", update = FALSE) expect_known_value( drop_rc(cro(list(a), list(a, total()), weight = 2, total_statistic = c("u_cases", "w_cases"), total_label = c("BASE", "W_BASE"), subgroup = a=="a")), "rds/order_factor_cro29.rds", update = FALSE) expect_known_value( drop_rc(cro(list(a), list(a, total()), weight = 2, total_statistic = c("u_cases", "w_cases"), total_label = c("BASE", "W_BASE"), subgroup = FALSE)), "rds/order_factor_cro30.rds", update = FALSE) expect_known_value(cro(list(a)), "rds/order_factor_cro31.rds", update = FALSE) # data(mtcars) var_lab(mtcars$vs) = "Engine" val_lab(mtcars$vs) = c("V-engine" = 0, "Straight engine" = 1) var_lab(mtcars$am) = "Transmission" val_lab(mtcars$am) = c(automatic = 0, manual=1) expect_known_value(fre(mtcars$vs), "rds/fre_ex1.rds", update = FALSE) expect_known_value(fre(mtcars$vs, weight = 1), "rds/fre_ex1.rds", update = FALSE) expect_known_value(with(mtcars, cro(am, vs)), "rds/fre_ex2.rds", update = FALSE) expect_known_value(with(mtcars, cro(am, vs, weight = 1)), "rds/fre_ex2.rds", update = FALSE) expect_known_value(with(mtcars, cro_cpct(am, list(vs, total()))), "rds/fre_ex3.rds", update = FALSE) expect_known_value(with(mtcars, cro_cpct(am, list(vs, total())))[, '#Total'], "rds/fre_ex3.1.rds", update = FALSE) expect_known_value(with(mtcars, cro_cpct(am, list(vs, total())))[3, ], "rds/fre_ex3.2.rds", update = FALSE) expect_known_value(with(mtcars, cro_cpct(am, list(vs, total())))[['#Total']], "rds/fre_ex3.3.rds", update = FALSE) expect_identical(fre(list(mtcars$vs, mtcars$am)), add_rows(fre(mtcars$vs, prepend_var_lab = TRUE), fre(mtcars$am, prepend_var_lab = TRUE)) ) double_fre = fre(list(mtcars$vs, mtcars$am)) expect_known_value( split_columns(double_fre), "rds/fre_split_columns.rds", update = FALSE) expect_identical(fre(list(mtcars$vs, mtcars$am), prepend_var_lab = FALSE), add_rows(fre(mtcars$vs, prepend_var_lab = FALSE), fre(mtcars$am, prepend_var_lab = FALSE)) ) # multiple-choice variable # brands - multiple response question # Which brands do you use during last three months? set.seed(123) brands = data.frame(t(replicate(20,sample(c(1:5,NA),4,replace = FALSE)))) # score - evaluation of tested product score = sample(-1:1,20,replace = TRUE) var_lab(brands) = "Used brands" val_lab(brands) = make_labels(" 1 Brand A 2 Brand B 3 Brand C 4 Brand D 5 Brand E ") var_lab(score) = "Evaluation of tested brand" val_lab(score) = make_labels(" -1 Dislike it 0 So-so 1 Like it ") expect_known_value(fre(brands), "rds/fre_ex4.rds", update = FALSE) expect_known_value(fre(as.dichotomy(brands)), "rds/fre_dichotomy.rds", update = FALSE) mat_brands = as.matrix(brands) expect_known_value(fre(mat_brands), "rds/fre_ex4mat.rds", update = FALSE) expect_known_value(cro(brands, list(total(), score)), "rds/fre_ex5.rds", update = FALSE) expect_known_value(cro(mrset(brands), list(total(), score)), "rds/fre_ex5mrset.rds", update = FALSE) expect_known_value(cro(as.dichotomy(brands), list(total(), score)), "rds/fre_ex5mrset.rds", update = FALSE) expect_known_value(cro_cpct(mrset(brands), list(total(), score)), "rds/fre_ex6mrset.rds", update = FALSE) expect_known_value(cro_cpct(as.dichotomy(brands), list(total(), score)), "rds/fre_ex6mrset.rds", update = FALSE) a = 1 var_lab(a) = "Total" val_lab(a) = c("all" = 1) expect_known_value(cro_cpct(mrset(brands), a), "rds/fre_ex7.rds", update = FALSE) expect_known_value(cro_cpct_responses(mrset(brands), a), "rds/fre_ex7responses.rds", update = FALSE) expect_known_value(cro_cpct_responses(mrset(brands), score), "rds/fre_ex7responses2.rds", update = FALSE) expect_identical(cro_cpct_responses(score, a, total_label = "#Total"), cro_cpct(score, a, total_label = "#Total")) # expect_known_value(cro_cpct_responses(as.dichotomy(mrset(brands)), a), "rds/fre_ex7responses.rds", update = FALSE) ################################################# context("fre and cro some special cases") expect_known_value(fre(numeric(0)), "rds/fre1.rds", update = FALSE) a = matrix(1:9, 3) expect_known_value(fre(a[, FALSE, drop = FALSE]), "rds/fre1matrix.rds", update = FALSE) a = numeric(0) val_lab(a) = autonum(letters[1:3]) expect_known_value(fre(a), "rds/fre1_empty_with_labels.rds", update = FALSE) expect_known_value(cro(a), "rds/cro_empty_with_labels.rds", update = FALSE) expect_known_value(cro(as.dichotomy(as.data.frame(matrix(1, 3, 3)))), "rds/cro_single_column_mdset.rds", update = FALSE) aaa = data.frame(1:5)[, -1, drop = FALSE] expect_known_value(cro(mdset(aaa)), "rds/cro_zero_column_multiple_set.rds", update = FALSE) expect_known_value(cro(mrset(aaa)), "rds/cro_zero_column_multiple_set.rds", update = FALSE) expect_known_value(cro(mrset(aaa[FALSE, ])), "rds/cro_zero_column_multiple_set.rds", update = FALSE) expect_known_value(cro(mrset(as.data.frame(rep(1,3)))), "rds/cro_single_column_mdset.rds", update = FALSE) expect_known_value(fre(a, drop_unused_labels = FALSE), "rds/fre1_empty_with_labels_not_drop.rds", update = FALSE) a = rep(NA, 5) expect_known_value(fre(a), "rds/fre2.rds", update = FALSE) expect_known_value(cro(list(a), list(a, total())), "rds/cro1.rds", update = FALSE) expect_known_value(drop_rc(cro(list(a), list(a, total()))), "rds/cro1_drop.rds", update = FALSE) expect_known_value(cro_cpct(list(a), list(a, total())), "rds/cro1.rds", update = FALSE) a = c(1,1,1, NA, NA) b = c(NA, NA, NA, 1, 1) expect_known_value(cro(list(a), list(b)), "rds/cro3.rds", update = FALSE) if(sessionInfo()$R.version$arch!="i386"){ expect_known_value(cro_cpct(list(a), list(b)), "rds/cro3.rds", update = FALSE) expect_known_value(cro_rpct(list(a), list(b)), "rds/cro3.rds", update = FALSE) expect_known_value(cro_tpct(list(a), list(b)), "rds/cro3.rds", update = FALSE) a = c(1,1,1, 1, 1) b = c(1, 1, 1, 1, 1) weight = rep(NA, 5) expect_known_value(cro(list(a), list(b), weight = weight), "rds/cro3.rds", update = FALSE) expect_known_value(cro_cpct(list(a), list(b), weight = weight), "rds/cro3.rds", update = FALSE) expect_known_value(cro_rpct(list(a), list(b), weight = weight), "rds/cro3.rds", update = FALSE) expect_known_value(cro_tpct(list(a), list(b), weight = weight), "rds/cro3.rds", update = FALSE) } context("cro_fun") a = c(1,1,1, NA, NA) b = c(NA, NA, NA, 1, 1) expect_error(cro_fun(a, b)) expect_known_value(cro_fun(a, list(b, total()), fun = length), "rds/cro_fun1.rds", update = FALSE) a = c(1,1,1, 1, 1) b = c(1, 1, 2, 2, 2) expect_known_value(cro_fun(b, list(a, total()), fun = mean), "rds/cro_fun2.rds", update = FALSE) expect_known_value(cro_fun(b, list(as.matrix(a), total()), fun = mean), "rds/cro_fun2.rds", update = FALSE) weight = rep(1, 5) expect_known_value(cro_fun(b, list(a, total()), weight = weight, fun = function(x, weight){ weighted.mean(x, w = weight) }), "rds/cro_fun2.rds", update = FALSE) expect_known_value(cro_fun(b, list(a, total()), weight = 1, fun = function(x, weight){ weighted.mean(x, w = weight) }), "rds/cro_fun2.rds", update = FALSE) expect_known_value(cro_fun(b, list(1, total()), weight = 1, fun = function(x, weight){ weighted.mean(x, w = weight) }), "rds/cro_fun2.rds", update = FALSE) ############## expect_known_value(cro_fun_df(b, list(a, total()), weight = weight, fun = function(x, weight){ setNames(weighted.mean(x[[1]], w = weight), names(x)) }), "rds/cro_fun3.rds", update = FALSE) expect_known_value(cro_fun_df(b, list(1, total()), weight = 1, fun = function(x, weight){ setNames(weighted.mean(x[[1]], w = weight), names(x)) }), "rds/cro_fun3.rds", update = FALSE) expect_error( cro_fun_df(b, a, weight = 1:2, fun = function(x, weight){ setNames(weighted.mean(x[[1]], w = weight), names(x)) }) ) expect_known_value(cro_fun_df(b, list(a, total()), weight = 1, fun = function(x, weight){ setNames(weighted.mean(x[[1]], w = weight), names(x)) }), "rds/cro_fun3.rds", update = FALSE) expect_known_value(cro_fun_df(b, list(as.matrix(a), total()), weight = 1, fun = function(x, weight){ setNames(weighted.mean(x[[1]], w = weight), names(x)) }), "rds/cro_fun3.rds", update = FALSE) weight = rep(NA, 5) expect_known_value(cro_fun(b, list(as.labelled(a), total()), weight = weight, fun = function(x, weight){ weighted.mean(x, w = weight) }), "rds/cro_fun4.rds", update = FALSE) weight = c(0, 0, 1, 1, 1) expect_known_value(cro_fun(b, list(a, total()), weight = weight, fun = function(x, weight){ weighted.mean(x, w = weight) }), "rds/cro_fun5.rds", update = FALSE) a = c(1,1,1, 1, 1) b = c(0, 1, 2, 2, NA) weight = c(0, 0, 1, 1, 1) expect_known_value(cro_fun(b, list(a, total()), weight = weight, fun = function(x, weight){ weighted.mean(x, w = weight) }), "rds/cro_fun6.rds", update = FALSE) expect_known_value(cro_fun(b, list(a, total()), weight = weight, fun = function(x, weight, na.rm){ weighted.mean(x, w = weight, na.rm = na.rm) }, na.rm = TRUE), "rds/cro_fun7.rds", update = FALSE) expect_error( cro_fun(b, a, weight = 1:2, fun = function(x, weight, na.rm){ weighted.mean(x, w = weight, na.rm = na.rm) }, na.rm = TRUE) ) expect_error(cro_fun(b, a, weight = weight, fun = function(x, w, na.rm){ weighted.mean(x, w = w, na.rm = na.rm) }, na.rm = TRUE)) expect_known_value(cro_fun(iris[,-5], list(iris$Species, total()), fun = median), "rds/cro_fun8.rds", update = FALSE) # data(mtcars) mtcars = mtcars %>% apply_labels( 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", carb = "Number of carburetors" ) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = mean)), "rds/cro_fun9.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(as.data.frame(am), total()), fun = mean)), "rds/cro_fun9.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun_df(data.frame(hp, mpg, disp), list(am, total()), fun = mean_col)), "rds/cro_fun9.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(fctr(am):fctr(vs), total()), fun = mean)), "rds/cro_fun10.rds", update = FALSE) if(as.numeric(version$major) ==3 && as.numeric(version$minor)<4){ expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), am, fun = summary)), "rds/cro_fun11.rds", update = FALSE) } else { expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), am, fun = summary)), "rds/cro_fun11_R3.4.rds", update = FALSE) } expect_known_value( with(mtcars, cro_fun_df(data.frame(hp, mpg, disp), list(am, total()), fun = colMeans)), "rds/cro_fun9.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun_df(data.frame(hp, mpg, disp), list(as.sheet(am), total()), fun = colMeans)), "rds/cro_fun9.rds", update = FALSE) if(as.numeric(version$major) ==3 && as.numeric(version$minor)<4){ expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), am, fun = summary)), "rds/cro_fun11.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), am, row_vars = vs, fun = summary)), "rds/cro_fun11vs.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) t(summary(x)))), "rds/cro_fun12.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), row_vars = vs, fun = function(x) t(summary(x)))), "rds/cro_fun12vs.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) matrix(summary(x),2)) ), "rds/cro_fun13.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) { res = matrix(summary(x),2) rownames(res) = c("a","b") colnames(res) = c("c","d","e") res })), "rds/cro_fun14.rds", update = FALSE) } else { expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), am, fun = summary)), "rds/cro_fun11_R3.4.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), am, row_vars = vs, fun = summary)), "rds/cro_fun11vs_R3.4.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) t(summary(x)))), "rds/cro_fun12_R3.4.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), row_vars = vs, fun = function(x) t(summary(x)))), "rds/cro_fun12vs_R3.4.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) matrix(summary(x),2)) ), "rds/cro_fun13_R3.4.rds", update = FALSE) expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) { res = matrix(summary(x),2) rownames(res) = c("a","b") colnames(res) = c("c","d","e") res })), "rds/cro_fun14_R3.4.rds", update = FALSE) } expect_known_value( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) { c(mean = mean(x, na.rm = TRUE), stdev = sd(x, na.rm = TRUE), valid = sum(!is.na(x))) })), "rds/cro_fun15.rds", update = FALSE) expect_error( with(mtcars, cro_fun(data.frame(hp, mpg, disp), list(am, total()), fun = function(x) sheet(t(x))) ) ) context("cro_mean") a = c(1,1,1, NA, NA) b = c(NA, NA, NA, 1, 1) expect_known_value(cro_mean(a, list(b, total())), "rds/cro_mean1.rds", update = FALSE) expect_known_value(cro_sum(a, list(b, total())), "rds/cro_sum1.rds", update = FALSE) expect_known_value(cross_sum(sheet(a, b), a, list(b, total())), "rds/cro_sum1.rds", update = FALSE) expect_known_value(cro_median(a, list(b, total())), "rds/cro_median1.rds", update = FALSE) a = c(1,1,1, 1, 1) b = c(1, 1, 2, 2, 2) expect_known_value(cro_mean(b, list(a, total())), "rds/cro_mean2.rds", update = FALSE) expect_known_value(cro_median(b, list(a, total())), "rds/cro_median2.rds", update = FALSE) expect_known_value(cross_median(sheet(a, b), b, list(a, total())), "rds/cro_median2.rds", update = FALSE) weight = rep(1, 5) expect_known_value(cro_mean(b, list(a, total()), weight = weight), "rds/cro_mean2.rds", update = FALSE) expect_known_value(cro_sum(b, list(a, total()), weight = weight), "rds/cro_sum3.rds", update = FALSE) expect_known_value(cro_sum(b, list(a, total()), weight = 1), "rds/cro_sum3.rds", update = FALSE) weight = rep(NA, 5) expect_known_value(cro_mean(b, list(a, total()), weight = weight), "rds/cro_mean4.rds", update = FALSE) expect_known_value(cro_sum(b, list(a, total()), weight = weight), "rds/cro_sum4.rds", update = FALSE) weight = c(0, 0, 1, 1, 1) expect_known_value(cro_mean(b, list(a, total()), weight = weight), "rds/cro_mean5.rds", update = FALSE) expect_known_value(cro_sum(b, list(a, total()), weight = weight), "rds/cro_sum5.rds", update = FALSE) a = c(1,1,1, 1, 1) b = c(0, 1, 2, 2, NA) weight = c(0, 0, 1, 1, 1) expect_known_value(cro_mean(b, list(a, total()), weight = weight), "rds/cro_mean6.rds", update = FALSE) expect_known_value(cro_median(b, list(a, total()), weight = weight), "rds/cro_median6.rds", update = FALSE) expect_known_value(cro_sum(b, list(a, total()), weight = weight), "rds/cro_sum6.rds", update = FALSE) expect_known_value(cro_median(iris[,-5], list(iris$Species, total())), "rds/cro_median8.rds", update = FALSE) expect_known_value(cross_median(iris, ..[!perl("Species")], list(Species, total())), "rds/cro_median8.rds", update = FALSE) expect_known_value(cro_median(iris[,-5], list(iris$Species, total()), weight = rep(1, 150)), "rds/cro_median8.rds", update = FALSE) expect_known_value(cro_median(iris[,-5], list(iris$Species, total()), weight = 1), "rds/cro_median8.rds", update = FALSE) expect_known_value(cro_mean(iris[,-5], list(iris$Species, total())), "rds/cro_mean8.rds", update = FALSE) expect_known_value(cro_sum(iris[,-5], list(iris$Species, total())), "rds/cro_sum8.rds", update = FALSE) expect_known_value(cross_sum(iris, ..[!perl("Species")], list(Species, total())), "rds/cro_sum8.rds", update = FALSE) expect_known_value(cro_fun(iris[,-5], list(iris$Species, total()), fun = mean), "rds/cro_mean8.rds", update = FALSE) expect_known_value(cro_fun_df(iris[,-5], list(iris$Species, total()), fun = mean_col), "rds/cro_mean8.rds", update = FALSE) ##### expect_known_value(cro_median(as.list(iris[,-5]), list(iris$Species, total())), "rds/cro_median8.rds", update = FALSE) expect_known_value(cro_mean(as.list(iris[,-5]), list(iris$Species, total())), "rds/cro_mean8.rds", update = FALSE) expect_known_value(cro_sum(as.list(iris[,-5]), list(iris$Species, total())), "rds/cro_sum8.rds", update = FALSE) expect_known_value(cro_fun(as.list(iris[,-5]), list(iris$Species, total()), fun = mean), "rds/cro_mean8.rds", update = FALSE) expect_known_value(cro_fun_df(as.list(iris[,-5]), list(iris$Species, total()), fun = mean_col), "rds/cro_mean8.rds", update = FALSE) # expect_known_value(cro_fun_df(iris[,-5], list(iris$Species, total()), fun = mean_col), # "rds/cro_mean8.rds", update = FALSE) ##### expect_known_value(cro_median(as.matrix(iris[,-5]), list(iris$Species, total())), "rds/cro_median8.rds", update = FALSE) expect_known_value(cro_mean(as.matrix(iris[,-5]), list(iris$Species, total())), "rds/cro_mean8.rds", update = FALSE) expect_known_value(cro_sum(as.matrix(iris[,-5]), list(iris$Species, total())), "rds/cro_sum8.rds", update = FALSE) expect_known_value(cro_fun(as.matrix(iris[,-5]), list(iris$Species, total()), fun = mean), "rds/cro_mean8.rds", update = FALSE) # expect_known_value(cro_fun_df(as.list(iris[,-5]), iris$Species, fun = mean_col), "rds/cro_mean8.rds", update = FALSE) ############ expect_known_value(cro_fun_df(iris[,-5], list(iris$Species, total()), fun = function(x) cor(x)[,1]), "rds/cro_fun_df1.rds", update = FALSE) expect_known_value(cro_fun_df(as.list(iris[,-5]), list(iris$Species, total()), fun = summary), "rds/cro_fun_df2.rds", update = FALSE) # expect_known_value(cro_fun(iris[,-5], list(iris$Species, total()), fun = summary), # "rds/cro_fun_df2.rds", update = FALSE) context("table_summary methods") # data(mtcars) mtcars = mtcars %>% apply_labels( 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", carb = "Number of carburetors" ) expect_known_value(cro_mean(mtcars$mpg, list(unvr(mtcars$am), total()))[,"manual"], "rds/mean_methods_1.rds", update = FALSE) expect_known_value(cro_fun(list(mtcars$mpg), list(unvr(mtcars$am), total()), fun = sum)[, 1], "rds/fun_methods_1.rds", update = FALSE) duplicated_colnames = merge(cro_mean(mtcars$mpg, list(mtcars$am, total())), cro_mean(mtcars$mpg, list(mtcars$am, total()))) expect_known_value(duplicated_colnames[,-2], "rds/cro_methods_2.rds", update = FALSE) expect_known_value(duplicated_colnames[,seq_along(duplicated_colnames)[-2]], "rds/cro_methods_2.rds", update = FALSE) duplicated_colnames = merge(cro(mtcars$vs, list(mtcars$am, total())), cro(mtcars$vs, list(mtcars$am, total()))) expect_known_value(duplicated_colnames[,-2], "rds/cro_methods_3.rds", update = FALSE) expect_known_value(duplicated_colnames[,seq_along(duplicated_colnames)[-2]], "rds/cro_methods_3.rds", update = FALSE) context("datetime") aaa = rep(c(as.POSIXct("2016-09-22 02:28:39"), as.POSIXct("2016-09-22 03:28:39")), 10) var_lab(aaa) = "aaa" bbb = rep(c(as.POSIXct("2016-09-22 03:28:39"), as.POSIXct("2016-09-22 02:28:39")), 10) var_lab(bbb) = "bbb" a_total = rep("total", 20) aaa_str = as.character(aaa) var_lab(aaa_str) = "aaa" bbb_str = as.character(bbb) var_lab(bbb_str) = "bbb" expect_identical(fre(aaa), fre(aaa_str)) expect_identical(cro(aaa, bbb), cro(aaa_str, bbb_str)) expect_identical(cro_cpct(aaa, bbb), cro_cpct(aaa_str, bbb_str)) expect_identical(cro_rpct(aaa, a_total),cro_rpct(aaa_str, a_total)) expect_identical(cro_rpct(list(aaa), list(a_total)), cro_rpct(list(aaa_str), list("total"))) expect_identical(cro_rpct(list(aaa), list("total")),cro_rpct(list(aaa_str), list(a_total))) expect_identical(cro_tpct(a_total, bbb), cro_tpct(a_total, bbb_str)) context("cro duplicated names") data(iris) ex_iris = iris[,-5] correct_iris = iris[,-5] colnames(ex_iris) = c("a", "a", "a", "a") colnames(correct_iris) = c("v1", "v2", "v3", "v4") var_lab(ex_iris[[1]]) = "v1" var_lab(ex_iris[[2]]) = "v2" var_lab(ex_iris[[3]]) = "v3" var_lab(ex_iris[[4]]) = "v4" expect_identical(cro_mean(ex_iris, iris$Species), cro_mean(correct_iris, iris$Species)) expect_identical(cro_sum(ex_iris, iris$Species), cro_sum(correct_iris, iris$Species)) expect_identical(cro_median(ex_iris, iris$Species), cro_median(correct_iris, iris$Species)) expect_identical(cro_fun(ex_iris, iris$Species, fun = mean), cro_fun(correct_iris, iris$Species, fun = mean)) expect_identical(cro_fun_df(ex_iris, iris$Species, fun = mean_col), cro_fun_df(correct_iris, iris$Species, fun = mean_col)) data(iris) # ex_iris = iris[,-5] lst_iris = as.list(ex_iris) names(lst_iris) = NULL expect_identical(cro_mean(lst_iris, iris$Species), cro_mean(correct_iris, iris$Species)) expect_identical(cro_sum(lst_iris, iris$Species), cro_sum(correct_iris, iris$Species)) expect_identical(cro_median(lst_iris, iris$Species), cro_median(correct_iris, iris$Species)) expect_identical(cro_fun(lst_iris, iris$Species, fun = mean), cro_fun(correct_iris, iris$Species, fun = mean)) expect_identical(cro_fun_df(lst_iris, iris$Species, fun = mean_col), cro_fun_df(correct_iris, iris$Species, fun = mean_col)) # data(iris) # lst_iris = as.list(iris[,-5]) # names(lst_iris) = NULL # colnames(correct_iris) = c("V1", "V2", "V3", "V4") # expect_identical(cro_mean(lst_iris, iris$Species), cro_mean(correct_iris, iris$Species)) # expect_identical(cro_sum(lst_iris, iris$Species), cro_sum(correct_iris, iris$Species)) # expect_identical(cro_median(lst_iris, iris$Species), cro_median(correct_iris, iris$Species)) # expect_identical(cro_fun(lst_iris, iris$Species, fun = mean), cro_fun(correct_iris, iris$Species, fun = mean)) # expect_identical(cro_fun_df(lst_iris, iris$Species, fun = mean_col), # cro_fun_df(correct_iris, iris$Species, fun = mean_col)) ################## # multiple-choice variable # brands - multiple response question # Which brands do you use during last three months? set.seed(123) brands = data.frame(t(replicate(20,sample(c(1:5,NA),4,replace = FALSE)))) # score - evaluation of tested product score = sample(-1:1,20,replace = TRUE) var_lab(brands) = "Used brands" val_lab(brands[[3]]) = make_labels(" 1 Brand A 2 Brand B 3 Brand C 4 Brand D 5 Brand E ") var_lab(score) = "Evaluation of tested brand" val_lab(score) = make_labels(" -1 Dislike it 0 So-so 1 Like it ") expect_known_value(fre(brands), "rds/fre_ex4.rds", update = FALSE) ####### # data(mtcars) expect_error(fre(mtcars$dont_exist)) expect_error(cro(mtcars$dont_exist, mtcars$am)) expect_error(cro(mtcars$am, mtcars$dont_exist)) expect_error(cro_cpct(mtcars$dont_exist, mtcars$am)) expect_error(cro_cpct(mtcars$am, mtcars$dont_exist)) expect_error(cro_rpct(mtcars$dont_exist, mtcars$am)) expect_error(cro_rpct(mtcars$am, mtcars$dont_exist)) expect_error(cro_tpct(mtcars$dont_exist, mtcars$am)) expect_error(cro_tpct(mtcars$am, mtcars$dont_exist)) expect_error(cro_sum(mtcars$dont_exist, mtcars$am)) expect_error(cro_sum(mtcars$am, mtcars$dont_exist)) expect_error(cro_mean(mtcars$dont_exist, mtcars$am)) expect_error(cro_mean(mtcars$am, mtcars$dont_exist)) expect_error(cro_median(mtcars$dont_exist, mtcars$am)) expect_error(cro_median(mtcars$am, mtcars$dont_exist)) expect_error(cro_fun(mtcars$dont_exist, mtcars$am, fun = sum)) expect_error(cro_fun(mtcars$am, mtcars$dont_exist, fun = sum)) expect_error(cro_fun_df(mtcars$dont_exist, mtcars$am, fun = median)) expect_error(cro_fun_df(mtcars$am, mtcars$dont_exist, fun = sum)) data(iris) expect_error( cro_fun(iris[,-5], iris$Species, fun = sum, weight = runif(150)) ) expect_error( cro_fun_df(iris[,-5], iris$Species, fun = sum_col, weight = runif(150)) ) }