rstatix/0000755000176200001440000000000015074715412011756 5ustar liggesusersrstatix/tests/0000755000176200001440000000000015074310430013107 5ustar liggesusersrstatix/tests/testthat/0000755000176200001440000000000015074715412014760 5ustar liggesusersrstatix/tests/testthat/test-levene_test.R0000644000176200001440000000063315074310430020366 0ustar liggesuserscontext("test-levene_test") test_that("Levene test output is correctly formatted", { # Prepare the data data("ToothGrowth") df <- ToothGrowth df$dose <- as.factor(df$dose) # Compute Levene's Test results <- df %>% levene_test(len ~ dose) expect_equal(results$df1, 2) expect_equal(results$df2, 57) expect_equal(round(results$statistic, 3), 0.646) expect_equal(round(results$p, 3), 0.528) }) rstatix/tests/testthat/test-get_n.R0000644000176200001440000000114715074310430017146 0ustar liggesuserscontext("test-get_n") test_that("Checking that get_n works for T-test", { data("ToothGrowth") stat.test <- ToothGrowth %>% t_test(len ~ dose) expect_equal(get_n(stat.test), c(40, 40, 40)) }) test_that("Checking that get_n works for grouped T-test", { data("ToothGrowth") stat.test <- ToothGrowth %>% group_by(dose) %>% t_test(len ~ supp) expect_equal(get_n(stat.test), c(20, 20, 20)) }) test_that("Checking that get_n works for grouped ANOVA", { data("ToothGrowth") res.aov <- ToothGrowth %>% group_by(supp) %>% anova_test(len ~ dose) expect_equal(get_n(res.aov), c(30, 30)) }) rstatix/tests/testthat/test-wilcox_test.R0000644000176200001440000001072615074375624020441 0ustar liggesuserscontext("test-wilcox-test") test_that("Checking one-sample test", { data("ToothGrowth") res <- ToothGrowth %>% wilcox_test(len ~ 1, mu = 0) expect_equal(res$group1, "1") expect_equal(res$group2, "null model") expect_equal(res$n, 60) expect_equal(as.numeric(res$statistic), 1830) expect_equal(signif(res$p, 3), 1.66e-11) }) test_that("Checking two-sample unpaired test", { data("ToothGrowth") res <- ToothGrowth %>% wilcox_test(len ~ supp) expect_equal(res$group1, "OJ") expect_equal(res$group2, "VC") expect_equal(res$n1, 30) expect_equal(res$n2, 30) expect_equal(as.numeric(res$statistic), 575.5) # Accept either 0.0645 (legacy) or 0.0637 (R-devel with exact conditional inference) expect_true(signif(res$p, 3) %in% c(0.0645, 0.0637), info = paste("Observed p =", signif(res$p, 3))) }) test_that("Checking two-sample paired test", { data("ToothGrowth") res <- ToothGrowth %>% wilcox_test(len ~ supp, paired = TRUE) expect_equal(res$group1, "OJ") expect_equal(res$group2, "VC") expect_equal(res$n1, 30) expect_equal(res$n2, 30) # Accept either 350/0.00431 (legacy) or 369/0.00383 (R-devel) expect_true(as.numeric(res$statistic) %in% c(350, 369), info = paste("Observed statistic =", as.numeric(res$statistic))) expect_true(signif(res$p, 3) %in% c(0.00431, 0.00383), info = paste("Observed p =", signif(res$p, 3))) }) test_that("Checking pairwise comparisons", { data("ToothGrowth") res <- ToothGrowth %>% wilcox_test(len ~ dose) expect_equal(res$group1, c("0.5", "0.5", "1")) expect_equal(res$group2, c("1", "2", "2")) expect_equal(res$n1, c(20, 20, 20)) expect_equal(res$n2, c(20, 20, 20)) expect_equal(as.numeric(res$statistic), c(33.5, 1.5, 61.0)) # Accept either legacy or R-devel p-values legacy_p <- c(7.02e-6, 8.41e-08, 1.77e-04) rdevel_p <- c(7.74e-07, 4.35e-11, 7.57e-05) observed_p <- signif(res$p, 3) expect_true(all(observed_p %in% c(legacy_p, rdevel_p)) || all(abs(observed_p - legacy_p) < 1e-6) || all(abs(observed_p - rdevel_p) < 1e-6), info = paste("Observed p =", paste(observed_p, collapse=", "))) }) test_that("Checking pairwise comparison against ref group", { data("ToothGrowth") res <- ToothGrowth %>% wilcox_test(len ~ dose, ref.group = "0.5") expect_equal(res$group1, c("0.5", "0.5")) expect_equal(res$group2, c("1", "2")) expect_equal(res$n1, c(20, 20)) expect_equal(res$n2, c(20, 20)) expect_equal(as.numeric(res$statistic), c(33.5, 1.5)) # Accept either legacy or R-devel p-values legacy_p <- c(7.02e-6, 8.41e-08) rdevel_p <- c(7.74e-07, 4.35e-11) observed_p <- signif(res$p, 3) expect_true(all(observed_p %in% c(legacy_p, rdevel_p)) || all(abs(observed_p - legacy_p) < 1e-6) || all(abs(observed_p - rdevel_p) < 1e-6), info = paste("Observed p =", paste(observed_p, collapse=", "))) }) test_that("Checking pairwise comparisons against all", { data("ToothGrowth") res <- ToothGrowth %>% wilcox_test(len ~ dose, ref.group = "all") expect_equal(res$group1, c("all", "all", "all")) expect_equal(res$group2, c("0.5", "1", "2")) expect_equal(res$n1, c(60, 60, 60)) expect_equal(res$n2, c(20, 20, 20)) expect_equal(as.numeric(res$statistic), c(965.0, 572.5, 262.5)) expect_equal(signif(res$p, 3), c(0.0000508, 0.764, 0.000179)) }) test_that("Checking grouped tests", { data("ToothGrowth") res <- ToothGrowth %>% group_by(dose) %>% wilcox_test(len ~ supp) expect_equal(res$group1, c("OJ", "OJ", "OJ")) expect_equal(res$group2, c("VC", "VC", "VC")) expect_equal(res$n1, c(10, 10, 10)) expect_equal(res$n2, c(10, 10, 10)) expect_equal(as.numeric(res$statistic), c(80.5, 88.5, 49.5)) # Accept either legacy or R-devel p-values legacy_p <- c(0.0232, 0.00403, 1) rdevel_p <- c(0.0198, 0.00223, 0.986) observed_p <- signif(res$p, 3) expect_true(all(abs(observed_p - legacy_p) < 0.005) || all(abs(observed_p - rdevel_p) < 0.005), info = paste("Observed p =", paste(observed_p, collapse=", "))) }) test_that("Empty values are not counting in group n size (104)", { # Data without NA df <- data.frame( g = rep(c("a", "b"), each = 10), v = rnorm(20) ) # run Wilcoxon test --> sample sizes are correct res <- wilcox_test(df, v ~ g, paired = TRUE) expect_equal(c(res$n1, c(res$n1)), c(10, 10)) # Insert NAs df$v[c(1, 12:14)] <- NA #repeat Wilcox test --> sample sizes are still the same res <- wilcox_test(data = df, v ~ g, paired = TRUE) expect_equal(c(res$n1, res$n2), c(9, 7)) }) rstatix/tests/testthat/test-emmeans_test.R0000644000176200001440000000572115074310430020540 0ustar liggesusers test_that("emmeans_test works", { # Data preparation df <- ToothGrowth df$dose <- as.factor(df$dose) # Pairwise comparisons comparisons <- df %>% group_by(supp) %>% emmeans_test(len ~ dose, p.adjust.method = "bonferroni") %>% as.data.frame(stringsAsFactors = FALSE) # raw emmeans output res_emmeans <- attr(comparisons, "emmeans") %>% as.data.frame(stringsAsFactors = FALSE) attributes(comparisons) <- list( names = colnames(comparisons), row.names = row.names(comparisons), class = "data.frame" ) attributes(res_emmeans) <- list( names = colnames(res_emmeans), row.names = row.names(res_emmeans), class = "data.frame" ) # Expected values expected_comparisons <- tibble::tribble( ~supp, ~term, ~.y., ~group1, ~group2, ~df, ~statistic, ~p, ~p.adj, ~p.adj.signif, "OJ", "dose", "len", "0.5", "1", 54, -5.83122150109434, 3.17564054631384e-07, 9.52692163894153e-07, "****", "OJ", "dose", "len", "0.5", "2", 54, -7.9001659830032, 1.42971201237994e-10, 4.28913603713983e-10, "****", "OJ", "dose", "len", "1", "2", 54, -2.06894448190887, 0.0433521450968846, 0.130056435290654, "ns", "VC", "dose", "len", "0.5", "1", 54, -5.41250654642231, 1.46293144787886e-06, 4.38879434363658e-06, "****", "VC", "dose", "len", "0.5", "2", 54, -11.1821523188884, 1.13067681037436e-15, 3.39203043112308e-15, "****", "VC", "dose", "len", "1", "2", 54, -5.7696457724661, 3.98114048489776e-07, 1.19434214546933e-06, "****" ) %>% dplyr::mutate(supp = factor(supp, levels = c("OJ", "VC"))) %>% data.frame(stringsAsFactors = FALSE, row.names = as.character(1:6)) expected_emmeans <- tibble::tribble( ~supp, ~dose, ~emmean, ~se, ~df, ~conf.low, ~conf.high, ~method, "OJ", "0.5", 13.23, 1.14835308804166, 54, 10.9276906782585, 15.5323093217415, "Emmeans test", "OJ", "1", 22.7, 1.14835308804166, 54, 20.3976906782585, 25.0023093217415, "Emmeans test", "OJ", "2", 26.06, 1.14835308804166, 54, 23.7576906782585, 28.3623093217415, "Emmeans test", "VC", "0.5", 7.98, 1.14835308804166, 54, 5.67769067825848, 10.2823093217415, "Emmeans test", "VC", "1", 16.77, 1.14835308804166, 54, 14.4676906782585, 19.0723093217415, "Emmeans test", "VC", "2", 26.14, 1.14835308804166, 54, 23.8376906782585, 28.4423093217415, "Emmeans test" ) %>% dplyr::mutate( supp = factor(supp, levels = c("OJ", "VC")), dose = factor(dose, levels = c("0.5", "1", "2")) ) %>% data.frame(stringsAsFactors = FALSE, row.names = as.character(1:6)) # Make sure that he class of grouping variable is preserved expect_equal(class(comparisons$supp), "factor") expect_equal(comparisons, expected_comparisons, tolerance = 1e-4) expect_equal(res_emmeans, expected_emmeans, tolerance = 1e-4) }) rstatix/tests/testthat/test-add_x_position.R0000644000176200001440000001351615074310430021060 0ustar liggesuserscontext("test-add_x_position") # Data preparation data("ToothGrowth") df <- ToothGrowth df$dose <- as.factor(df$dose) test_that("add_x_position works for any data frame with group1 and group2 cols", { stat.test <- data.frame( stringsAsFactors = FALSE, group1 = c("0.5", "0.5", "1"), group2 = c("1", "2", "2"), p = c(1.27e-07, 4.4e-14, 1.91e-05) ) %>% add_x_position() expect_equal(stat.test$xmin, c(1, 1, 2)) expect_equal(stat.test$xmax, c(2, 3, 3)) }) test_that("add_x_position works for rstatix in a basic ggplot setting", { stat.test <- df %>% t_test(len ~ supp) %>% add_x_position() expect_equal(stat.test$xmin, 1) expect_equal(stat.test$xmax, 2) }) test_that("add_x_position works for rstatix in a basic ggplot facet setting", { stat.test <- df %>% group_by(dose) %>% t_test(len ~ supp) %>% add_x_position(x = "supp") expect_equal(stat.test$xmin, c(1, 1, 1)) expect_equal(stat.test$xmax, c(2, 2, 2)) }) test_that("add_x_position works for comparison against reference groups", { stat.test <- df %>% t_test(len ~ dose, ref.group = "0.5") %>% add_x_position(x = "dose") expect_equal(stat.test$xmin, c(1, 1)) expect_equal(stat.test$xmax, c(2, 3)) }) test_that("add_x_position works for comparison against all (basemean)", { stat.test <- df %>% t_test(len ~ dose, ref.group = "all") %>% add_x_position(x = "dose") expect_equal(stat.test$xmin, c(1, 2, 3)) expect_equal(stat.test$xmax, c(1,2, 3)) }) test_that("add_x_position works for comparison against null (one-sample test)", { stat.test <- df %>% group_by(dose) %>% t_test(len ~ 1) %>% add_x_position(x = "dose") expect_equal(stat.test$x, c(1, 2, 3)) }) test_that("add_x_position works for specified comparisons of interest", { stat.test <- df %>% t_test(len ~ dose, comparisons = list(c("0.5", "1"), c("0.5", "2"))) %>% add_x_position(x = "dose") expect_equal(stat.test$xmin, c(1, 1)) expect_equal(stat.test$xmax, c(2,3)) }) test_that("add_x_position works for grouped plots: grouping by x-var and performing test between legend groups", { stat.test <- df %>% group_by(dose) %>% t_test(len ~ supp) %>% add_x_position(x = "dose") expect_equal(stat.test$x, c(1, 2, 3)) expect_equal(stat.test$xmin, c(0.8, 1.8, 2.8)) expect_equal(stat.test$xmax, c(1.2, 2.2, 3.2)) }) test_that("add_x_position works for grouped plots: grouping by legend-var and performing test between x-group", { stat.test <- df %>% group_by(supp) %>% t_test(len ~ dose) %>% add_x_position(x = "dose") expect_equal(stat.test$xmin, c(1, 1, 2, 1, 1, 2)) expect_equal(stat.test$xmax, c(2, 3, 3, 2, 3, 3)) }) test_that("Grouped pairwise tests: grouping by x-var and performing test between legend groups", { stat.test <- df %>% group_by(supp) %>% t_test(len ~ dose) %>% add_x_position(x = "supp", dodge = 0.8) expect_equal(stat.test$x, c(1, 1, 1, 2, 2, 2)) expect_equal(round(stat.test$xmin, 2), c(0.73, 0.73, 1, 1.73, 1.73, 2)) expect_equal(round(stat.test$xmax, 2), c(1, 1.27, 1.27, 2, 2.27, 2.27)) }) test_that("Grouped pairwise tests: grouping by x-var and performing test between legend groups using ref.group", { stat.test <- df %>% group_by(supp) %>% t_test(len ~ dose, ref.group = "0.5") %>% add_x_position(x = "supp", dodge = 0.8) expect_equal(stat.test$x, c(1, 1, 2, 2)) expect_equal(round(stat.test$xmin, 2), c(0.73, 0.73, 1.73, 1.73)) expect_equal(round(stat.test$xmax, 2), c(1, 1.27, 2, 2.27)) }) test_that("Grouped plots: test that add_x_position works with different number of groups at each x pos.", { # https://github.com/kassambara/ggpubr/issues/326 demo_data <- data.frame( stringsAsFactors = FALSE, Study = c("A","A","A","A","A","A", "A","A","A","A","B","B","B","B","B","B","B","B", "B","B","C","C","C","C","C","C","C","C","C", "C","C","C","C","C","C","D","D","D","D","D", "D","D","D","D","D","D","D","D","D","D"), Studytype = c("X","X","X","X","X","X", "X","X","X","X","X","X","X","X","X","X","X","X", "X","X","Y","Y","Y","Y","Y","Y","Y","Y","Y", "Y","Y","Y","Y","Y","Y","Y","Y","Y","Y","Y", "Y","Y","Y","Y","Y","Y","Y","Y","Y","Y"), Values = c(4469L,4797L,5101L,5397L, 4542L,2780L,4326L,3396L,3657L,3199L,9221L,10176L, 9277L,10500L,9707L,7406L,7756L,7601L,7586L,7353L, 1811L,1485L,3003L,1629L,2495L,4207L,4265L,3629L, 4157L,3495L,2075L,2112L,2973L,3086L,2943L,5664L,6690L, 3538L,5741L,7880L,5848L,6390L,6569L,6114L,6520L, 7389L,6843L,7611L,6621L,7340L), Group = as.factor(c("CTR", "CTR","CTR","CTR","CTR","Dis1","Dis1","Dis1", "Dis1","Dis1","CTR","CTR","CTR","CTR", "CTR","Dis1","Dis1","Dis1","Dis1","Dis1", "CTR","CTR","CTR","CTR","CTR","Dis2","Dis2", "Dis2","Dis2","Dis2","Dis3","Dis3", "Dis3","Dis3","Dis3","CTR","CTR","CTR","CTR", "CTR","Dis2","Dis2","Dis2","Dis2","Dis2", "Dis3","Dis3","Dis3","Dis3","Dis3")) ) stat.test <- demo_data %>% group_by(Study) %>% wilcox_test(Values ~ Group, ref.group = "CTR") %>% add_significance("p") stat.test <- stat.test %>% add_xy_position(x = "Study", dodge = 0.8) #bxp <- ggpubr::ggboxplot(demo_data, x = "Study", y = "Values", fill = "Group") + #ggpubr::stat_pvalue_manual(stat.test, label = "p") stat.test$x <- round(stat.test$x, 2) stat.test$xmin <- round(stat.test$xmin, 2) stat.test$xmax <- round(stat.test$xmax, 2) expect_equal(stat.test$x, c(1, 2, 3, 3, 4, 4)) expect_equal(stat.test$xmin, c(0.8, 1.8, 2.73, 2.73, 3.73, 3.73)) expect_equal(stat.test$xmax, c(1.2, 2.2, 3, 3.27, 4, 4.27)) }) rstatix/tests/testthat/test-p_mark_significance.R0000644000176200001440000000024415074310430022022 0ustar liggesuserscontext("test-p_mark_significance") test_that("p_mark_significance works when NA only", { na_signif <- p_mark_significant(NA) expect_equal(na_signif, "NA") }) rstatix/tests/testthat/test-shapiro_test.R0000644000176200001440000000073315074310430020556 0ustar liggesuserscontext("test-shapiro_test") test_that("Shapiro test works when input data contains column names 'value' or 'variable'", { df <- iris # Column names contain value colnames(df)[2] <- "value" res <- df %>% shapiro_test(value) res_value <- round(res$p, 3) # Column names contain variable colnames(df)[2] <- "variable" res <- df %>% shapiro_test(variable) res_variable <- round(res$p, 3) expect_equal(res_value, 0.101) expect_equal(res_variable, 0.101) }) rstatix/tests/testthat/test-get_summary_stats.R0000644000176200001440000000066115074310430021624 0ustar liggesuserscontext("test-get_summary_stats") test_that("Checking that get_summary_stats keeps the order of columns specified by the user", { res <- data.frame( c = rnorm(50,10,5), b = rnorm(50,100,20), a = rnorm(50,0,1) ) %>% get_summary_stats(a, c, b, type = "mean_sd") obtained_var_order <- as.character(res$variable) expected_var_order <- c("a", "c", "b") expect_equal(obtained_var_order, expected_var_order) }) rstatix/tests/testthat/test-remove_ns.R0000644000176200001440000000645315074377214020071 0ustar liggesuserscontext("test-remove_ns") stat.test <- PlantGrowth %>% wilcox_test(weight ~ group) test_that("remove_ns works when col = NULL", { result <- remove_ns(stat.test, col = NULL) p <- round(result$p, 3) # Accept either 0.009 (legacy) or 0.011 (R-devel with exact conditional inference) expect_true(p %in% c(0.009, 0.011), info = paste("Observed p =", p)) }) test_that("remove_ns works when col = NA", { result <- remove_ns(stat.test, col = NA) p <- round(result$p, 3) # Accept either 0.009 (legacy) or 0.011 (R-devel with exact conditional inference) expect_true(p %in% c(0.009, 0.011), info = paste("Observed p =", p)) }) test_that("remove_ns works when col is logical", { result <- remove_ns(stat.test, col = TRUE) p.true <- round(result$p, 3) result <- remove_ns(stat.test, col = FALSE) p.false <- round(result$p, 3) # Accept either 0.009 (legacy) or 0.011 (R-devel with exact conditional inference) expect_true(p.true %in% c(0.009, 0.011), info = paste("Observed p.true =", p.true)) # Accept both legacy and R-devel vectors expect_true(all(p.false %in% c(0.199, 0.063, 0.009, 0.197)), info = paste("Observed p.false =", paste(p.false, collapse=", "))) }) test_that("remove_ns works when col is specified", { stat.test2 <- stat.test %>% add_significance("p") result.when.p <- remove_ns(stat.test2, col = "p") result.when.p.adj <- remove_ns(stat.test2, col = "p.adj") result.when.p.adj.signif <- remove_ns(stat.test2, col = "p.adj.signif") result.when.p.signif <- remove_ns(stat.test2, col = "p.signif") # Accept either "**" (legacy, p=0.009) or "*" (R-devel, p=0.011) expect_true(result.when.p$p.signif %in% c("**", "*"), info = paste("Observed p.signif =", result.when.p$p.signif)) expect_true(result.when.p.adj$p.signif %in% c("**", "*"), info = paste("Observed p.signif =", result.when.p.adj$p.signif)) expect_true(result.when.p.adj.signif$p.signif %in% c("**", "*"), info = paste("Observed p.signif =", result.when.p.adj.signif$p.signif)) expect_true(result.when.p.signif$p.signif %in% c("**", "*"), info = paste("Observed p.signif =", result.when.p.signif$p.signif)) }) test_that("remove_ns works when signif.cutoff is specified", { stat.test2 <- stat.test %>% add_significance("p") result <- remove_ns(stat.test2, signif.cutoff = 0.01) # Accept either 0 (legacy, p=0.009 < 0.01) or 1 (R-devel, p=0.011 > 0.01) expect_true(nrow(result) %in% c(0, 1), info = paste("Observed nrow =", nrow(result))) }) test_that("remove_ns works when signif.cutoff and col are specified", { stat.test2 <- stat.test %>% add_significance("p") result1 <- remove_ns(stat.test2, col = "p.adj", signif.cutoff = 0.01) result2 <- remove_ns(stat.test2, col = "p", signif.cutoff = 0.01) # Accept either 0 (legacy) or 1 (R-devel) expect_true(nrow(result1) %in% c(0, 1), info = paste("Observed nrow(result1) =", nrow(result1))) # Legacy: p=0.009 < 0.01, so nrow=1 with "**" # R-devel: p=0.011 > 0.01, so nrow=0 expect_true(nrow(result2) %in% c(0, 1), info = paste("Observed nrow(result2) =", nrow(result2))) if(nrow(result2) == 1) { expect_true(result2$p.signif %in% c("**", "*"), info = paste("Observed p.signif =", result2$p.signif)) } }) rstatix/tests/testthat/test-anova_test.R0000644000176200001440000000674415074310430020225 0ustar liggesuserscontext("test-anova_test") test_that("Checking one-way ANOVA test", { data("ToothGrowth") res.aov <- ToothGrowth %>% anova_test(len ~ dose) expect_equal(res.aov$Effect, "dose") expect_equal(res.aov$DFn, 1) expect_equal(res.aov$DFd, 58) expect_equal(res.aov$F, 105.065) expect_equal(res.aov$ges, 0.644) }) test_that("Checking grouped one-way ANOVA test", { data("ToothGrowth") res.aov <- ToothGrowth %>% group_by(supp) %>% anova_test(len ~ dose) expect_equal(res.aov$Effect, c("dose", "dose")) expect_equal(res.aov$DFn, c(1, 1)) expect_equal(res.aov$DFd, c(28, 28)) expect_equal(res.aov$F, c(36.013, 117.948)) expect_equal(res.aov$ges, c(0.563, 0.808)) }) test_that("Checking two-way ANOVA test", { data("ToothGrowth") res.aov <- ToothGrowth %>% anova_test(len ~ supp*dose) expect_equal(res.aov$Effect, c("supp", "dose", "supp:dose")) expect_equal(res.aov$DFn, c(1, 1, 1)) expect_equal(res.aov$DFd, c(56, 56, 56)) expect_equal(res.aov$F, c(12.317, 133.415, 5.333)) expect_equal(res.aov$p, c(8.94e-04, 1.91e-16, 2.50e-02)) expect_equal(res.aov$ges, c(0.180, 0.704, 0.087)) }) test_that("Checking repeated measures ANOVA test", { data("ToothGrowth") df <- ToothGrowth df$id <- rep(1:10, 6) res.aov <- df %>% anova_test(dv = len, wid = id, within = c(supp, dose)) anova.table <- res.aov$ANOVA sphericity <- res.aov$`Mauchly's Test for Sphericity` corrections <- res.aov$`Sphericity Corrections` expect_equal(anova.table$Effect, c("supp", "dose", "supp:dose")) expect_equal(anova.table$DFn, c(1, 2, 2)) expect_equal(anova.table$DFd, c(9, 18, 18)) expect_equal(anova.table$F, c(34.866, 106.470, 2.534)) expect_equal(anova.table$p, c(2.28e-04, 1.06e-10, 1.07e-01)) expect_equal(anova.table$ges, c(0.224, 0.773, 0.132)) expect_equal(sphericity$W, c(0.807, 0.934)) expect_equal(corrections$GGe, c(0.838, 0.938)) expect_equal(corrections$HFe, c(1.008, 1.176)) }) test_that("Checking that get_anova_table works with any data frame", { data("ToothGrowth") expect_is(get_anova_table(ToothGrowth), "data.frame") }) test_that("Checking that get_anova_table works for grouped repeated measures ANOVA", { data("ToothGrowth") df <- ToothGrowth df$id <- rep(1:10, 6) res.aov <- df %>% group_by(supp) %>% anova_test(dv = len, wid = id, within = dose) aov.table <- get_anova_table(res.aov) expect_equal(aov.table$F, c(23.936, 57.783)) }) test_that("Checking that get_anova_table performs auto sphericity correction", { data("ToothGrowth") df <- ToothGrowth df$id <- rep(1:10, 6) res.aov <- df %>% anova_test(dv = len, wid = id, within = c(supp, dose)) res.aov2 <- res.aov res.aov2$`Mauchly's Test for Sphericity`$p[1] <- 0.05 # significant # Correction not applied, because there is not significant sphericity test auto <- get_anova_table(res.aov, correction = "auto") expect_equal(auto$DFn, c(1, 2, 2)) expect_equal(auto$DFd, c(9, 18, 18)) expect_equal(auto$F, c(34.866, 106.470, 2.534)) # Correction automatically applied to the DF of the effect where sphericity is signiica,t auto2 <- get_anova_table(res.aov2, correction = "auto") expect_equal(auto2$DFn, c(1, 1.68, 2)) expect_equal(auto2$DFd, c(9, 15.09, 18)) expect_equal(auto2$F, c(34.866, 106.470, 2.534)) # Check that GG correction works for all within-subject variables gg <- get_anova_table(res.aov2, correction = "GG") expect_equal(gg$DFn, c(1, 1.68, 1.88)) expect_equal(gg$DFd, c(9, 15.09, 16.88)) expect_equal(gg$p, c(2.28e-04, 2.79e-09, 1.12e-01)) }) rstatix/tests/testthat.R0000644000176200001440000000007215074310430015071 0ustar liggesuserslibrary(testthat) library(rstatix) test_check("rstatix") rstatix/tests/spelling.R0000644000176200001440000000020415074310430015043 0ustar liggesusersif(requireNamespace('spelling', quietly = TRUE)) spelling::spell_check_test(vignettes = TRUE, error = FALSE, skip_on_cran = TRUE) rstatix/MD50000644000176200001440000002157715074715412012302 0ustar liggesusersafde1d2c3d8959cf5f7384d1f94e66ba *DESCRIPTION 557de5785071bac01d4dd7bc439a99b6 *NAMESPACE 1fa39213df51db5cb06bd2589dd5b836 *NEWS.md d6ac9490368da98e62ee5fee3d1439f2 *R/add_significance.R 7bfc41c8e2bdfaeb81bedaa86211eed3 *R/adjust_pvalue.R 1338c6db639dc3dee6600e9443e019a0 *R/anova_summary.R 77f6c8b85caee18da64844d1f82f551f *R/anova_test.R 7118eac79e848e7ed5ec8e59b093299f *R/as_cor_mat.R 34f6380e599280c2a9074608ef42fddf *R/binom_test.R 9f3a9024a41bb9f661d4af58e9d45aea *R/box_m.R da3f183168c934db393d646158236650 *R/chisq_test.R f1f5d16b71fc333c5fecd804918c4ce9 *R/cochran_qtest.R ca6eacc7db90238c5734ab7744d951b9 *R/cohens_d.R bb1c918e4d0cdd3ddfa0353b682dd469 *R/cor_as_symbols.R 2d62b214a65bc7a0a0260508b513f38a *R/cor_mark_significant.R e9a6da7a6e96111377eb23b63fbaa17d *R/cor_mat.R f741b4e6bf5127ce32d926e5ac42cea7 *R/cor_plot.R 8350cc882a0bf4383722417aea0efc8f *R/cor_reorder.R f47b1241f146e1a58edca20fee1f1be6 *R/cor_reshape.R 74f9cc86893a92bf5a4a8f34bea01dbe *R/cor_select.R 91ddb9dec1afc96d8a9111c47cf83542 *R/cor_test.R 9afd5dbb7eb4eef3c854443ad1fb3328 *R/counts_to_cases.R 584116d12f1cf518509e655016ff4a13 *R/cramer_v.R b7a7b07d19454112b01ac395977d0001 *R/df.R f648a46129eaa297b25fd2719358004a *R/doo.R dac8162ca6d004390516f79ba47a7f4f *R/dunn_test.R 3e13a194d7b299580852e23e6d6e7527 *R/emmeans_test.R e3231b7384bf86cf64f4628b40ef0b5a *R/eta_squared.R b0971d54cef8279d90dff336390e7c0d *R/factorial_design.R 8e05326cc8f25d112411331bf8dea853 *R/factors.R e63bcbdd3b9c977628389f2973bf48c4 *R/fisher_test.R 739121ee1921ccdd0ccd1b941fc955f6 *R/freq_table.R 61a085a041d81a4f181fdc269279c0e1 *R/friedman_effsize.R cf5081d4c5df62671554ae70fa00d5fe *R/friedman_test.R 94777c99bf3122d82811f2aea83f1058 *R/games_howell_test.R 786f1063db2c26c98349695cef4e397f *R/get_comparisons.R df5f3e755e717c04456374f17fed6b41 *R/get_manova_table.R aef2d86c7337b5be9b01c35d80c6f0e4 *R/get_mode.R 53a6bc03995549a87d1d6737088c7bd0 *R/get_pvalue_position.R 94c2cc57cebf9d73aabb2b311b73b11a *R/get_summary_stats.R bb1b7d4373ece84009d7705bb20fac5b *R/get_test_label.R ffed7d90833d4d32dbc5c71094f16bc8 *R/kruskal_effesize.R cf85b73c1e82d4552195fbc5cdf2f943 *R/kruskal_test.R a05f798b023323202bd5c5d13cb4e9de *R/levene_test.R 93473f3cc29fbc2009601e89e6c01be2 *R/mahalanobis_distance.R a0f8b7f9f0539719c405e38f1b5c88a0 *R/make_clean_names.R c34753dcc932f05b3abad4dd543914ff *R/mcnemar_test.R a8cacf22040f2c9d5614dac6b76192d9 *R/multinom_test.R 6d04aeceb048ee6f4a032cdb290e998a *R/outliers.R 5a856e0b97c5880d8327ebffd9aed377 *R/p_value.R 4335eca5d152e9dea191688188bf81f0 *R/prop_test.R 217b76648b64bd00caef6fd732ae93ff *R/prop_trend_test.R d007ab4b8df2b0469607582f9512f801 *R/pull_triangle.R f9e62df69d12206ebfc6007f06eff534 *R/reexports.R b6939ad3d433bb756ab5f79192486919 *R/remove_ns.R 1f35ba26e8d8f38cd9197882d65dff73 *R/replace_triangle.R 031df170ca0e9ec318d1f372f45ad0bb *R/sample_n_by.R f7588351fd87cf36b14d712257552e9c *R/shapiro_test.R 96dc9b372554e77933d4db8bbb9c855f *R/sign_test.R 6cdbe0bfe3500ad5d18976ba51c8430f *R/t_test.R b305b3c418bc56d3eda69d4f22f2f392 *R/tukey_hsd.R 5bc6b25de0df2fbdf1d0795d29ec28da *R/utilities.R 431d7a2e86c3f00f6100a5fa2cfc643c *R/utilities_two_sample_test.R 29fd2f2c91abc81242969187953d650d *R/utils-manova.R 65cef5e0674056f6fc07dd2b3ca85c13 *R/utils-pipe.R 7a8bed3a365425332d890fb7eea43707 *R/welch_anova_test.R 3c7c89e84d4bef649216d213f96cc321 *R/wilcox_effsize.R d13cfda1f5b3baf24f0fd0c2a8102ca1 *R/wilcox_test.R 05f5358e8fcdb5051f298d8ce35f034e *README.md 63c674b0fe938402be376b923b380496 *inst/WORDLIST a88996d6ebb74e7d78dc4fc2ede7240f *man/Manova.Rd c7b514e6b6ba50d031e74c85a7de4f6a *man/add_significance.Rd f80f1f8a83ece26d3c9c69cfc9abf928 *man/adjust_pvalue.Rd 2a7a63ad9b3d21a9236dc485769f51fa *man/anova_summary.Rd c89f7622937cefe4d14668f1df8e8b44 *man/anova_test.Rd a87a2fb7ccb20c762d78940df6d283d4 *man/as_cor_mat.Rd 24ca33a376300ef734bb3a3cea4b4214 *man/binom_test.Rd 631b2d67055455a80074bb76e9d36a32 *man/box_m.Rd 7c579d30571f24009e45e52614d8a995 *man/chisq_test.Rd a4e6f30d831c859087756467bfdf4513 *man/cochran_qtest.Rd 020868513b9f3ae2cad65d212c5a7dc6 *man/cohens_d.Rd 13888842d8cffab804d589ef1e1a9078 *man/cor_as_symbols.Rd 40bfc70aa098fabe1495b5c77c3cfa01 *man/cor_mark_significant.Rd f6f34e6fb90db7e28a5a15a746e364bf *man/cor_mat.Rd 1eecdc97dc3fb8a004c3ae6434795f93 *man/cor_plot.Rd 132087a5d673f8cf467539ebae8182a7 *man/cor_reorder.Rd 5c5631097193442cc1ecceba68c554ef *man/cor_reshape.Rd 3ff5d235dd3b844bb01a18b27cd148c5 *man/cor_select.Rd 9167dc6972cad5e2fbfc567d35cb9244 *man/cor_test.Rd 90e795efb08cd85567ab17d7a7a99053 *man/counts_to_cases.Rd 2772cf3340824b1d12d603d3b06e8863 *man/cramer_v.Rd c100a522a902ed5968a136d87c611f49 *man/df_arrange.Rd 5ad9b10b4e9752b2ef7f7b48d6393b48 *man/df_get_var_names.Rd 5a104c6455c799ea630fb4ebbda4072c *man/df_group_by.Rd f48b442829bb1b77e5bb4acea1db3947 *man/df_label_value.Rd 1b18ab01364afdf6b1ff6227878fc30b *man/df_nest_by.Rd 7548b599cdb275869fde090d733c17ee *man/df_select.Rd daa7e610c83ea0d52680db7f0d7785b4 *man/df_split_by.Rd 2e3ea3820aabaf5bb9bacebbf0b74119 *man/df_unite.Rd c828eda713217a6ed2c4a4cfed1f91b2 *man/doo.Rd 6e138dbb5da18d1b60008ac349e48883 *man/dunn_test.Rd e8b5b4dfce41992db3cd5d6f0db0e78e *man/emmeans_test.Rd 4759b0980ecf4e3402398fd8bccf006b *man/eta_squared.Rd a8cc2066ce655796674312adb3f7880e *man/factorial_design.Rd a7a500337481b0aa59f23bcfc7da9884 *man/factors.Rd b9071e08e28682300081fb78b728df36 *man/fisher_test.Rd 267c2558568c097b56c745dfb1022a0e *man/freq_table.Rd 38f3bdca58c2b15923862c0ccf3f1e11 *man/friedman_effsize.Rd 431d23b8b4d37f963e696537e0c7214b *man/friedman_test.Rd 7db5421b21e2b9c3ac6f107d1f9d3036 *man/games_howell_test.Rd bf55765139dc09a0aa5d299a699f25c5 *man/get_comparisons.Rd 9d0226d5c3e7aee77a9c30a1b1af2e49 *man/get_mode.Rd bd917eb894fb7189d2f08e9ec7c44242 *man/get_pvalue_position.Rd d1d8dc15d6de4606e64a63f799772e88 *man/get_summary_stats.Rd f0fe1a9139b786295d1ed04b4dbe5dcc *man/get_test_label.Rd 01df0345b3d71faeb9fdc5dc4dc5d04a *man/kruskal_effsize.Rd aad26da1a0dbbb2696b5c396f06a5316 *man/kruskal_test.Rd 87e09851c062d3495f314fe6cc096f79 *man/levene_test.Rd cedc3ab69094e5ceae1d197de3c69605 *man/mahalanobis_distance.Rd 7d83ccf15aaf4cafe96bcf1a710cb160 *man/make_clean_names.Rd 0cded6cd8f269e6131c56551742080a3 *man/mcnemar_test.Rd e7f29d9fa81116023e94ccd3d9218d2c *man/multinom_test.Rd 110e1d0d6e140c45064adee726b97275 *man/outliers.Rd 27a96661553a8e9891140ae86fed8a06 *man/p_value.Rd 4894ca10756199e25f914bfd34f517b0 *man/pipe.Rd 55a58ab314c84c9f96600fa49ea2f1f1 *man/prop_test.Rd a263be3d488679d1fdbd6d539ade9eea *man/prop_trend_test.Rd 67f42ba66867ec62e1a91d428c11d87b *man/pull_triangle.Rd 8f1b01ffaae44cf0122f2eb076c77da1 *man/reexports.Rd 2c1d214a21a23367854e769731391837 *man/remove_ns.Rd dac8621554d9c05f8513f401e5aba15a *man/replace_triangle.Rd 658a7cc0b91a6c08e2298989b0da82da *man/sample_n_by.Rd 2e4e3a092ad9d341b08a2dbf0ce913fe *man/shapiro_test.Rd c86ceb8c08428e72b1f38bcda0d805ba *man/sign_test.Rd edcfe2f08cc260811455b570f59a4d30 *man/t_test.Rd fb58d6d229dc9add2dc9e7eaef3bc0af *man/tukey_hsd.Rd 98987b08fadb5806ed139e548102f8d3 *man/welch_anova_test.Rd 6779653990efa8b4ccf0e40fd8731ef2 *man/wilcox_effsize.Rd 70063896a920ace1de13add824d1040d *man/wilcox_test.Rd 1a37bf6f61366dcab43a7a1d11136ea3 *tests/spelling.R c93b013fe9b4bdf779bd4df2ec8390e5 *tests/testthat.R a7ca7e063336230d10d319f496f7a688 *tests/testthat/test-add_x_position.R a033534a633b7ea35800c7121e3b1d92 *tests/testthat/test-anova_test.R bb3a1167e99a053004d83ca01cc6e85f *tests/testthat/test-emmeans_test.R 082fe154487fa2c68bc68a470543231c *tests/testthat/test-get_n.R c804949bcb7d480febb58b6f2adb0b9c *tests/testthat/test-get_summary_stats.R b922019dde91bd6b5168fe9f44b38b18 *tests/testthat/test-levene_test.R a82e342765f643049607382e557336bb *tests/testthat/test-p_mark_significance.R 36777c5e8b3d521cda0fa7a9331bcbfa *tests/testthat/test-remove_ns.R 0176887f00aed45408ff50dc4620d173 *tests/testthat/test-shapiro_test.R 921b84049700cfcfc1f142d8955b1ec5 *tests/testthat/test-wilcox_test.R 66adb57e436ee0670acd6fcc030c961d *tools/README--grouped-two-sample-t-test-1.png c32c0e90c2efa079845cb159711efc21 *tools/README-comaprison-against-reference-group-1.png ba384ac2c666123b27b9cfeb6bed689e *tools/README-comaprison-against-reference-group-2.png eb2a8978bcaa5194829a0356dfaaae41 *tools/README-comaprison-against-reference-group-3.png 32fb57db11c532affe227a11d1be3f5b *tools/README-comparison-against-base-mean-1.png dd9e93f020002533a8bb6ddd3927b6bf *tools/README-custoize-p-value-labels-1.png 0e9e5b4a6e42908e1fef329816d4d43f *tools/README-grouped-two-sample-t-test-1.png 33a1c9dc20771f975bfb7c7528ebd944 *tools/README-paired-t-test-1.png de99e9e5716b68404664c43c7d5b1057 *tools/README-pairwise-comparisons-1.png b8f0992d4126b19e0869cf444a295eea *tools/README-two-sample-t-test-1.png 6626f4ffe4131f0ef4ba0ed6f3b58b76 *tools/README-unnamed-chunk-10-1.png 3b61e644baf07ee14903b46a715101b0 *tools/README-unnamed-chunk-8-1.png 3b61e644baf07ee14903b46a715101b0 *tools/README-unnamed-chunk-9-1.png c093d3420f9c684f77b6c424e0cdea05 *tools/README-unpaired-two-sample-t-test-1.png rstatix/R/0000755000176200001440000000000015074436115012157 5ustar liggesusersrstatix/R/add_significance.R0000644000176200001440000000313515074310430015525 0ustar liggesusers#' @include utilities.R NULL #' Add P-value Significance Symbols #' @description Add p-value significance symbols into a data frame. #' @param data a data frame containing a p-value column. #' @param p.col column name containing p-values. #' @param output.col the output column name to hold the adjusted p-values. #' @param cutpoints numeric vector used for intervals. #' @param symbols character vector, one shorter than cutpoints, used as #' significance symbols. #' #' @return a data frame #' #' @examples #' # Perform pairwise comparisons and adjust p-values #' ToothGrowth %>% #' t_test(len ~ dose) %>% #' adjust_pvalue() %>% #' add_significance("p.adj") #' #' @rdname add_significance #' @export add_significance <- function( data, p.col = NULL, output.col = NULL, cutpoints = c(0, 0.0001, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "ns") ) { .attributes <- get_test_attributes(data) if(is.null(p.col)) p.col <- data %>% p_detect("p.adj") if(is.null(p.col)) p.col <- data %>% p_detect("p") if(is.null(p.col)) return(data) else if(!(p.col %in% colnames(data))) stop("The column ", p.col, " does not exist in the data") if(is.null(output.col)) output.col <- paste0(p.col, ".signif") .p.values <- data %>% pull(!!p.col) if(all(is.na(.p.values))) { .p.signif <- rep("", length(.p.values)) } else{ .p.signif <- .p.values %>% stats::symnum(cutpoints = cutpoints, symbols = symbols, na = "") %>% as.character() } data %>% keep_only_tbl_df_classes() %>% mutate(!!output.col := .p.signif) %>% set_test_attributes(.attributes) } rstatix/R/friedman_effsize.R0000644000176200001440000001024615074310430015574 0ustar liggesusers#' @include utilities.R friedman_test.R NULL #' Friedman Test Effect Size (Kendall's W Value) #' #'@description Compute the effect size estimate (referred to as \code{w}) for #' Friedman test: \code{W = X2/N(K-1)}; where \code{W} is the Kendall's W #' value; \code{X2} is the Friedman test statistic value; \code{N} is the sample #' size. \code{k} is the number of measurements per subject. #' #' The Kendall’s W coefficient assumes the value from 0 (indicating no #' relationship) to 1 (indicating a perfect relationship). #' #' Kendalls uses the Cohen’s interpretation guidelines of \code{0.1 - < 0.3} (small #' effect), \code{0.3 - < 0.5} (moderate effect) and \code{>= 0.5} (large #' effect) #' #' Confidence intervals are calculated by bootstap. #' #'@inheritParams friedman_test #'@inheritParams wilcox_effsize #'@param ... other arguments passed to the function \code{\link[stats]{friedman.test}()} #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y variable used in the test. \item \code{n}: Sample #' counts. \item \code{effsize}: estimate of the effect size. \item #' \code{magnitude}: magnitude of effect size. \item \code{conf.low,conf.high}: #' lower and upper bound of the effect size confidence interval.} #' #'@references Maciej Tomczak and Ewa Tomczak. The need to report effect size #' estimates revisited. An overview of some recommended measures of effect #' size. Trends in Sport Sciences. 2014; 1(21):19-25. #' #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth %>% #' filter(supp == "VC") %>% #' mutate(id = rep(1:10, 3)) #' head(df) #' #' # Friedman test effect size #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% friedman_effsize(len ~ dose | id) #' @export friedman_effsize <- function(data, formula, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ...){ args <- as.list(environment()) %>% .add_item(method = "friedman_effsize") if(is_grouped_df(data)){ results <- data %>% doo( .friedman_effsize, formula, ci = ci, conf.level = conf.level, ci.type = ci.type, nboot = nboot, ... ) } else{ results <- .friedman_effsize( data, formula, ci = ci, conf.level = conf.level, ci.type = ci.type, nboot = nboot, ... ) } results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "friedman_effsize")) } .friedman_effsize <- function(data, formula, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ...){ results <- kendall_w(data, formula, ...) # Confidence interval of the effect size if (ci == TRUE) { # Paired data, bootstrap should be performed on wide data vars <- get_friedman_vars(formula) data.wide <- data %>% select(!!!syms(c(vars$wid, vars$dv, vars$within))) %>% spread(key = vars$within, value = vars$dv) # Boot function stat.func <- function(data.wide, subset) { if(!is.null(subset)) data.wide <- data.wide[subset, ] data.long <- data.wide %>% mutate(!!vars$wid := 1:nrow(data.wide)) %>% gather(key = !!vars$within, value = !!vars$dv, - !!vars$wid) kendall_w(data.long, formula)$effsize } CI <- get_boot_ci( data.wide, stat.func, conf.level = conf.level, type = ci.type, nboot = nboot ) results <- results %>% add_columns(conf.low = CI[1], conf.high = CI[2], .after = "effsize") } results %>% mutate(magnitude = get_kendall_w_magnitude(.data$effsize)) } kendall_w <- function(data, formula, subset = NULL, ...){ if(!is.null(subset)) data <- data[subset, ] res.f <- friedman_test(data, formula, ...) x2 <- res.f$statistic nb.samples <- res.f$n k <- nrow(data)/nb.samples # number of measurements per sample w <- x2 / (nb.samples * (k-1)) tibble( .y. = get_formula_left_hand_side(formula), n = nb.samples, effsize = w, method = "Kendall W" ) } get_kendall_w_magnitude <- function(d){ magnitude.levels = c(0.3, 0.5, Inf) magnitude = c("small","moderate","large") d.index <- findInterval(abs(d), magnitude.levels)+1 magnitude <- factor(magnitude[d.index], levels = magnitude, ordered = TRUE) magnitude } rstatix/R/cor_reorder.R0000644000176200001440000000223715074310430014602 0ustar liggesusers#' @include utilities.R NULL #' Reorder Correlation Matrix #' @description reorder correlation matrix, according to the coefficients, #' using the hierarchical clustering method. #'@param x a correlation matrix. Particularly, an object of class \code{cor_mat}. #'@return a data frame #'@seealso \code{\link{cor_mat}()}, \code{\link{cor_gather}()}, \code{\link{cor_spread}()} #' @examples #' # Compute correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_mat() #' # #' # Reorder by correlation and get p-values #' #:::::::::::::::::::::::::::::::::::::::::: #' # Reorder #' cor.mat %>% #' cor_reorder() #' # Get p-values of the reordered cor_mat #' cor.mat %>% #' cor_reorder() %>% #' cor_get_pval() #' #' @name cor_reorder #' @export cor_reorder <- function(x){ pvalue <- attr(x, "pvalue") x <- as_matrix(x) hc <- stats::as.dist(1 - x) %>% stats::hclust(method = "complete") x <- x %>% subset_matrix(hc$order) if(!is.null(pvalue)){ pvalue <- pvalue %>% subset_matrix(hc$order) x <- x %>% set_attrs(pvalue = pvalue) %>% add_class("cor_mat") } x } rstatix/R/get_mode.R0000644000176200001440000000143515074310430014057 0ustar liggesusers#' @include utilities.R NULL #' Compute Mode #' #' @description Compute the mode in a given vector. Mode is the most frequent #' value. #' #' @param x a vector. Can be numeric, factor or character vector. #' #' @examples #' #' # Mode of numeric vector #' x <- c(1:5, 6, 6, 7:10) #' get_mode(x) #' #' # Bimodal #' x <- c(1:5, 6, 6, 7, 8, 9, 9, 10) #' get_mode(x) #' #' # No mode #' x <- c(1, 2, 3, 4, 5) #' get_mode(x) #' #' # Nominal vector #' fruits <- c(rep("orange", 10), rep("apple", 5), rep("lemon", 2)) #' get_mode(fruits) #' @export get_mode <- function(x){ .x <- factor(x) .table <- table(.x) .max <- max(.table) if(all(.table == .max)){ .mode <- NA } else{ .mode <- names(.table)[.table == .max] } if(is.numeric(x)){ .mode <- as.numeric(.mode) } .mode } rstatix/R/mahalanobis_distance.R0000644000176200001440000000505515074310430016426 0ustar liggesusers#' @include utilities.R NULL #'Compute Mahalanobis Distance and Flag Multivariate Outliers #' #'@description Pipe-friendly wrapper around to the function #' \code{\link[stats]{mahalanobis}()}, which returns the squared #' Mahalanobis distance of all rows in x. Compared to the base function, it #' automatically flags multivariate outliers. #' #' Mahalanobis distance is a common metric used to identify multivariate #' outliers. The larger the value of Mahalanobis distance, the more unusual the #' data point (i.e., the more likely it is to be a multivariate outlier). #' #' The distance tells us how far an observation is from the center of the cloud, taking into #' account the shape (covariance) of the cloud as well. #' #' To detect outliers, the calculated Mahalanobis distance is compared against #' a chi-square (X^2) distribution with degrees of freedom equal to the number #' of dependent (outcome) variables and an alpha level of 0.001. #' #' The threshold to declare a multivariate outlier is determined using the #' function \code{qchisq(0.999, df) }, where df is the degree of freedom (i.e., #' the number of dependent variable used in the computation). #' #'@param data a data frame. Columns are variables. #'@param ... One unquoted expressions (or variable name). Used to select a #' variable of interest. Can be also used to ignore a variable that are not #' needed for the computation. For example specify \code{-id} to ignore the id #' column. #' #'@return Returns the input data frame with two additional columns: 1) #' "mahal.dist": Mahalanobis distance values; and 2) "is.outlier": logical #' values specifying whether a given observation is a multivariate outlier #' #' @examples #' #' # Compute mahalonobis distance and flag outliers if any #' iris %>% #' doo(~mahalanobis_distance(.)) #' #'# Compute distance by groups and filter outliers #' iris %>% #' group_by(Species) %>% #' doo(~mahalanobis_distance(.)) %>% #' filter(is.outlier == TRUE) #' #'@export mahalanobis_distance <- function(data, ...){ if(is_grouped_df(data)){ results <- data %>% doo(~mahalanobis_distance(.)) } data <- data %>% select_numeric_columns() vars <- data %>% get_selected_vars(...) n.vars <- length(vars) threshold <- stats::qchisq(0.999, n.vars) .data <- data %>% select(!!!syms(vars)) %>% as.matrix() distance <- stats::mahalanobis( .data, center = colMeans(.data), cov = cov(.data) ) results <- data %>% mutate( mahal.dist = round(distance, 3), is.outlier = .data$mahal.dist > threshold ) results } rstatix/R/replace_triangle.R0000644000176200001440000000533515074310430015577 0ustar liggesusers#' @include utilities.R NULL #' Replace Lower and Upper Triangular Part of a Matrix #' @description Replace the lower or the upper triangular part of a #' (correlation) matrix. #' @param x a (correlation) matrix #' @param diagonal logical. Default is FALSE. If TRUE, the matrix diagonal is #' included. #' @param triangle the triangle to replace. Allowed values are one of #' "upper" and "lower". #' @param by a replacement argument. Appropriate values are either "" or NA. Used to replace #' the upper, lower or the diagonal part of the matrix. #' @return an object of class \code{cor_mat_tri}, which is a data frame #' @seealso \code{\link{pull_triangle}()} #' @examples #' # Compute correlation matrix and pull triangles #' #:::::::::::::::::::::::::::::::::::::::::: #' # Correlation matrix #' cor.mat <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_mat() #' cor.mat #' #' # Replace upper triangle by NA #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat %>% replace_upper_triangle(by = NA) #' #' #' # Replace upper triangle by NA and reshape the #' # correlation matrix to have unique combinations of variables #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat %>% #' replace_upper_triangle(by = NA) %>% #' cor_gather() #' @describeIn replace_triangle replaces the specified triangle by empty or NA. #' @export replace_triangle <- function(x, triangle = c("lower", "upper"), by = "", diagonal = FALSE){ triangle <- match.arg(triangle) remaining.triangle <- ifelse( triangle == "lower", "upper", "lower" ) remaining.triangle.class <- paste0(remaining.triangle, "_tri") replacement <- by get_tri <- switch( triangle, upper = upper.tri, lower = lower.tri ) res <- as_matrix(x) res[get_tri(res)] <- replacement if (!diagonal) diag(res) <- replacement res <- res %>% matrix_to_dataframe() if(.is_cor_mat(x)){ pvalue <- x %>% attr("pvalue") %>% as_matrix() pvalue[get_tri(pvalue)] <- replacement if (!diagonal) diag(pvalue) <- replacement pvalue <- pvalue %>% matrix_to_dataframe() res <- res %>% set_attrs(pvalue = pvalue) %>% add_class("cor_mat_tri") } res %>% add_class(remaining.triangle.class) } #' @describeIn replace_triangle replaces the upper triangular part of a matrix. #' Returns an object of class \code{lower_tri}. #' @export replace_upper_triangle <- function(x, by = "", diagonal = FALSE){ x %>% replace_triangle("upper", by = by, diagonal = diagonal) } #' @describeIn replace_triangle replaces the lower triangular part of a matrix. #' Returns an object of class \code{lower_tri} #' @export replace_lower_triangle <- function(x, by = "", diagonal = FALSE){ x %>% replace_triangle("lower", by = by, diagonal = diagonal) } rstatix/R/get_summary_stats.R0000644000176200001440000001776415074310430016062 0ustar liggesusers#' @include utilities.R NULL #'Compute Summary Statistics #'@description Compute summary statistics for one or multiple numeric variables. #'@param data a data frame #'@param ... (optional) One or more unquoted expressions (or variable names) #' separated by commas. Used to select a variable of interest. If no variable #' is specified, then the summary statistics of all numeric variables in the #' data frame is computed. #'@param type type of summary statistics. Possible values include: \code{"full", #' "common", "robust", "five_number", "mean_sd", "mean_se", "mean_ci", #' "median_iqr", "median_mad", "quantile", "mean", "median", "min", "max"} #'@param show a character vector specifying the summary statistics you want to #' show. Example: \code{show = c("n", "mean", "sd")}. This is used to filter #' the output after computation. #' @param probs numeric vector of probabilities with values in [0,1]. Used only when type = "quantile". #'@return A data frame containing descriptive statistics, such as: \itemize{ #' \item \strong{n}: the number of individuals \item \strong{min}: minimum #' \item \strong{max}: maximum \item \strong{median}: median \item #' \strong{mean}: mean \item \strong{q1, q3}: the first and the third quartile, #' respectively. \item \strong{iqr}: interquartile range \item \strong{mad}: #' median absolute deviation (see ?MAD) \item \strong{sd}: standard deviation #' of the mean \item \strong{se}: standard error of the mean \item \strong{ci}: 95 percent confidence interval of the mean } #' @examples #' # Full summary statistics #' data("ToothGrowth") #' ToothGrowth %>% get_summary_stats(len) #' #' # Summary statistics of grouped data #' # Show only common summary #' ToothGrowth %>% #' group_by(dose, supp) %>% #' get_summary_stats(len, type = "common") #' #' # Robust summary statistics #' ToothGrowth %>% get_summary_stats(len, type = "robust") #' #' # Five number summary statistics #' ToothGrowth %>% get_summary_stats(len, type = "five_number") #' #' # Compute only mean and sd #' ToothGrowth %>% get_summary_stats(len, type = "mean_sd") #' #' # Compute full summary statistics but show only mean, sd, median, iqr #' ToothGrowth %>% #' get_summary_stats(len, show = c("mean", "sd", "median", "iqr")) #' #'@export get_summary_stats <- function( data, ..., type = c("full", "common", "robust", "five_number", "mean_sd", "mean_se", "mean_ci", "median_iqr", "median_mad", "quantile", "mean", "median", "min", "max" ), show = NULL, probs = seq(0, 1, 0.25) ){ type = match.arg(type) if(is_grouped_df(data)){ results <- data %>% doo(get_summary_stats, ..., type = type, show = show, probs = probs) return(results) } data <- data %>% select_numeric_columns() vars <- data %>% get_selected_vars(...) n.vars <- length(vars) if(n.vars >= 1){ data <- data %>% select(!!!syms(vars)) } variable <- .value. <- NULL data <- data %>% gather(key = "variable", value = ".value.") %>% filter(!is.na(.value.)) %>% dplyr::mutate(variable = factor(.data$variable, levels = vars)) %>% group_by(variable) results <- switch( type, common = common_summary(data), robust = robust_summary(data), five_number = five_number_summary(data), mean_sd = mean_sd(data), mean_se = mean_se(data), mean_ci = mean_ci(data), median_iqr = median_iqr(data), median_mad = median_mad(data), quantile = quantile_summary(data, probs), mean = mean_(data), median = median_(data), min = min_(data), max = max_(data), full_summary(data) ) %>% dplyr::ungroup() %>% dplyr::mutate_if(is.numeric, round, digits = 3) if(!is.null(show)){ show <- unique(c("variable", "n", show)) results <- results %>% select(!!!syms(show)) } results } full_summary <- function(data){ confidence <- 0.95 alpha <- 1 - confidence .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), min = min(.value., na.rm=TRUE), max = max(.value., na.rm=TRUE), median = stats::median(.value., na.rm=TRUE), q1 = stats::quantile(.value., 0.25, na.rm = TRUE), q3 = stats::quantile(.value., 0.75, na.rm = TRUE), iqr = stats::IQR(.value., na.rm=TRUE), mad = stats::mad(.value., na.rm=TRUE), mean = mean(.value., na.rm = TRUE), sd = stats::sd(.value., na.rm = TRUE) ) %>% mutate( se = .data$sd / sqrt(.data$n), ci = abs(stats::qt(alpha/2, .data$n-1)*.data$se) ) } common_summary <- function(data){ confidence <- 0.95 alpha <- 1 - confidence .value. <- ci <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), min = min(.value., na.rm=TRUE), max = max(.value., na.rm=TRUE), median = stats::median(.value., na.rm=TRUE), iqr = stats::IQR(.value., na.rm=TRUE), mean = mean(.value., na.rm = TRUE), sd = stats::sd(.value., na.rm = TRUE) ) %>% mutate( se = .data$sd / sqrt(.data$n), ci = abs(stats::qt(alpha/2, .data$n-1)*.data$se) ) } robust_summary <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), median = stats::median(.value., na.rm=TRUE), iqr = stats::IQR(.value., na.rm=TRUE) ) } quantile_summary <- function(data, probs = seq(0, 1, 0.25)){ core_func <- function(data, probs){ .value. <- NULL n <- sum(!is.na(data$.value.)) names(n) <- "n" q <- stats::quantile(data$.value., probs, na.rm = TRUE) results <- t(matrix(c(n, q))) colnames(results) <- c("n", names(q)) tibble::as_tibble(results) } results <- data %>% nest() %>% mutate(.results. = map(data, core_func, probs)) %>% select(.data$variable, .data$.results.) %>% unnest(cols = ".results.") results } five_number_summary <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), min = min(.value., na.rm=TRUE), max = max(.value., na.rm=TRUE), q1 = stats::quantile(.value., 0.25, na.rm = TRUE), median = stats::median(.value., na.rm=TRUE), q3 = stats::quantile(.value., 0.75, na.rm = TRUE) ) } mean_ <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), mean = mean(.value., na.rm = TRUE) ) } median_ <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), median = stats::median(.value., na.rm=TRUE) ) } max_ <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), max = max(.value., na.rm = TRUE) ) } min_ <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), min = min(.value., na.rm = TRUE) ) } mean_sd <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), mean = mean(.value., na.rm = TRUE), sd = stats::sd(.value., na.rm = TRUE) ) } mean_se <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), mean = mean(.value., na.rm = TRUE), sd = stats::sd(.value., na.rm = TRUE) ) %>% mutate(se = .data$sd / sqrt(.data$n))%>% select(-.data$sd) } mean_ci <- function(data){ confidence <- 0.95 alpha <- 1 - confidence .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), mean = mean(.value., na.rm = TRUE), sd = stats::sd(.value., na.rm = TRUE) ) %>% mutate( se = .data$sd / sqrt(.data$n), ci = abs(stats::qt(alpha/2, .data$n-1)*.data$se) )%>% select(-.data$se, -.data$sd) } median_iqr <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), median = stats::median(.value., na.rm=TRUE), iqr = stats::IQR(.value., na.rm=TRUE) ) } median_mad <- function(data){ .value. <- NULL data %>% dplyr::summarise( n = sum(!is.na(.value.)), median = stats::median(.value., na.rm=TRUE), mad = stats::mad(.value., na.rm=TRUE) ) } rstatix/R/utils-pipe.R0000644000176200001440000000031715074310430014365 0ustar liggesusers#' Pipe operator #' #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs NULL rstatix/R/games_howell_test.R0000644000176200001440000001270515074310430016003 0ustar liggesusers#' @include utilities.R t_test.R NULL #'Games Howell Post-hoc Tests #' #'@description Performs Games-Howell test, which is used to compare all possible #' combinations of group differences when the assumption of homogeneity of #' variances is violated. This post hoc test provides confidence intervals for #' the differences between group means and shows whether the differences are #' statistically significant. #' #' The test is based on Welch’s degrees of freedom correction and uses Tukey’s #' studentized range distribution for computing the p-values. The test compares #' the difference between each pair of means with appropriate adjustment for #' the multiple testing. So there is no need to apply additional p-value #' corrections. #' #'@inheritParams t_test #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y (outcome) variable used in the test. \item #' \code{group1,group2}: the compared groups in the pairwise tests. \item #' \code{n1,n2}: Sample counts. \item \code{estimate, conf.low, conf.high}: #' mean difference and its confidence intervals. \item \code{statistic}: Test #' statistic (t-value) used to compute the p-value. \item \code{df}: degrees of #' freedom calculated using Welch’s correction. \item \code{p.adj}: adjusted p-value using Tukey's method. \item #' \code{method}: the statistical test used to compare groups. \item #' \code{p.adj.signif}: the significance level of p-values. } #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #'@details The Games-Howell method is an improved version of the Tukey-Kramer #' method and is applicable in cases where the equivalence of variance #' assumption is violated. It is a t-test using Welch’s degree of freedom. This #' method uses a strategy for controlling the type I error for the entire #' comparison and is known to maintain the preset significance level even when #' the size of the sample is different. However, the smaller the number of #' samples in each group, the it is more tolerant the type I error control. #' Thus, this method can be applied when the number of samples is six or more. #' #'@references \itemize{ \item Aaron Schlege, #' https://rpubs.com/aaronsc32/games-howell-test. \item Sangseok Lee, Dong Kyu #' Lee. What is the proper way to apply the multiple comparison test?. Korean J #' Anesthesiol. 2018;71(5):353-360. } #' #' #' @examples #' # Simple test #' ToothGrowth %>% games_howell_test(len ~ dose) #' #' # Grouped data #' ToothGrowth %>% #' group_by(supp) %>% #' games_howell_test(len ~ dose) #' #'@rdname games_howell_test #'@export games_howell_test <- function(data, formula, conf.level = 0.95, detailed = FALSE){ args <- as.list(environment()) %>% .add_item(p.adjust.method = "Tukey", method = "games_howell_test") results <- data %>% doo(.games_howell_test, formula, conf.level = conf.level) if(!detailed){ results <- results %>% select( -.data$se, -.data$method, -.data$statistic, -.data$df, -.data$n1, -.data$n2 ) } results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "games_howell_test")) } .games_howell_test <- function(data, formula, conf.level = 0.95){ outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(number.of.groups == 1){ stop("all observations are in the same group") } data <- data %>% select(!!!syms(c(outcome, group))) %>% get_complete_cases() %>% .as_factor(group) x <- data %>% pull(!!outcome) g <- data %>% pull(!!group) if (!all(is.finite(g))) stop("all group levels must be finite") # Statistics for games howell tests grp.sizes <- tapply(x, g, length) nb.groups <- length(grp.sizes) grp.means <- tapply(x, g, mean) grp.vars <- tapply(x, g, stats::var) # Helper functions get_mean_diff <- function(i, j){ grp.means[i] - grp.means[j] } get_weltch_sd <- function(i, j){ sqrt((grp.vars[i]/grp.sizes[i]) + (grp.vars[j]/grp.sizes[j])) } get_degree_of_freedom <- function(i, j){ A <- ((grp.vars[i]/grp.sizes[i]) + (grp.vars[j]/grp.sizes[j]))^2 B <- ((grp.vars[i]/grp.sizes[i])^2)/(grp.sizes[i] - 1) C <- ((grp.vars[j]/grp.sizes[j])^2)/(grp.sizes[j] - 1) A/(B+C) } mean.diff <- stats::pairwise.table( get_mean_diff, levels(g), p.adjust.method = "none" ) %>% tidy_squared_matrix() weltch.sd <- stats::pairwise.table( get_weltch_sd, levels(g), p.adjust.method = "none" ) %>% tidy_squared_matrix() df <- stats::pairwise.table( get_degree_of_freedom, levels(g), p.adjust.method = "none" ) %>% tidy_squared_matrix() t <- abs(mean.diff$value)/weltch.sd$value p <- stats::ptukey(t*sqrt(2), nb.groups, df$value, lower.tail = FALSE) se <- weltch.sd$value*sqrt(0.5) q <- stats::qtukey(p = conf.level, nb.groups, df = df$value) conf.high <- mean.diff$value + q*se conf.low <- mean.diff$value - q*se n1 <- grp.sizes[mean.diff$group1] n2 <- grp.sizes[mean.diff$group2] results <- mean.diff %>% rename(estimate = .data$value) %>% mutate( conf.low = conf.low, conf.high = conf.high, se = se, statistic = t, df = df$value, p.adj = p_round(p, digits = 3) ) %>% add_column(n1 = n1, n2 = n2, .after = "group2") %>% add_column(.y. = outcome, .before = "group1") %>% add_significance("p.adj") %>% mutate(method = "Games-Howell") results } rstatix/R/cramer_v.R0000644000176200001440000000145415074310430014073 0ustar liggesusers#' @include utilities.R #' NULL #'Compute Cramer's V #'@description Compute Cramer's V, which measures the strength of the #' association between categorical variables. #'@inheritParams stats::chisq.test #'@param ... other arguments passed to the function #' \code{\link[stats]{chisq.test}()}. #'@examples #' #' # Data preparation #' df <- as.table(rbind(c(762, 327, 468), c(484, 239, 477))) #' dimnames(df) <- list( #' gender = c("F", "M"), #' party = c("Democrat","Independent", "Republican") #' ) #' df #' # Compute cramer's V #' cramer_v(df) #' #'@export cramer_v <- function(x, y = NULL, correct = TRUE, ...) { test <- stats::chisq.test(x, y, correct = correct, ...) chi2 <- test$statistic N <- sum(test$observed) k <- min(dim(test$observed)) V <- sqrt(chi2/(N * (k - 1))) as.numeric(V) } rstatix/R/counts_to_cases.R0000644000176200001440000000212615074310430015465 0ustar liggesusers#' Convert a Table of Counts into a Data Frame of cases #' @description converts a contingency table or a data frame of counts into a #' data frame of individual observations. #' @param x a contingency table or a data frame #' @param count.col the name of the column containing the counts. Default is "Freq". #' @return a data frame of cases #' #' @examples #' # Create a cross-tabulation demo data #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' xtab <- as.table( #' rbind(c(20, 5), c(16,9)) #' ) #' dimnames(xtab) <- list( #' before = c("non.smoker", "smoker"), #' after = c("non.smoker", "smoker") #' ) #' xtab #' #' # Convert into a data frame of cases #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' df <- counts_to_cases(xtab) #' head(df) #' #' @export counts_to_cases <- function(x, count.col = "Freq") { if(!inherits(x, "table")) x <- as.table(as.matrix(x)) x <- as.data.frame(x) # Get the row indices to pull from x idx <- rep.int(seq_len(nrow(x)), x[[count.col]]) # Drop count column x[[count.col]] <- NULL # Get the rows from x x <- x[idx, ] rownames(x) <- 1:nrow(x) x } rstatix/R/cor_reshape.R0000644000176200001440000000736015074310430014571 0ustar liggesusers#' @include utilities.R cor_mat.R NULL #' Reshape Correlation Data #' @description Reshape correlation analysis results. Key functions: \itemize{ #' \item \code{cor_gather()}: takes a correlation matrix and collapses (i.e. melt) it into a paired list #' (long format). \item \code{cor_spread()}: spread a long correlation data format across #' multiple columns. Particularly, it takes the results of \code{\link{cor_test}} #' and transforms it into a correlation matrix. } #' @param data a data frame or matrix. #' @param drop.na logical. If TRUE, drop rows containing missing values after gathering the data. #' @param value column name containing the value to spread. #' @seealso \code{\link{cor_mat}()}, \code{\link{cor_reorder}()} #' @examples #' # Data preparation #' #:::::::::::::::::::::::::::::::::::::::::: #' mydata <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) #' head(mydata, 3) #' #' # Reshape a correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' # Compute a correlation matrix #' cor.mat <- mydata %>% cor_mat() #' cor.mat #' #' # Collapse the correlation matrix into long format #' # paired list data frame #' long.format <- cor.mat %>% cor_gather() #' long.format #' #' # Spread a correlation data format #' #:::::::::::::::::::::::::::::::::::::::::: #' # Spread the correlation coefficient value #' long.format %>% cor_spread(value = "cor") #' # Spread the p-value #' long.format %>% cor_spread(value = "p") #' @describeIn cor_reshape takes a correlation matrix and collapses (or melt) it into long #' format data frame (paired list) #' @export cor_gather <- function(data, drop.na = TRUE){ rowname <- column <- NULL if(inherits(data, "cor_mat")){ cor.value <- data p.value <- data %>% cor_get_pval() } else if(inherits(data, "cor_mat_tri")){ cor.value <- data %>% as_numeric_triangle() p.value <- data %>% cor_get_pval() %>% as_numeric_triangle() } else if(inherits(data, "rcorr")){ cor.value <- data$r %>% as_tibble(rownames = "rowname") p.value <- data$P %>% as_tibble(rownames = "rowname") } else { cor.value <- data %>% as_tibble(rownames = "rowname") p.value <- NULL } cor.value <- cor.value %>% keep_only_tbl_df_classes() %>% gather(key = "column", value = "cor", -rowname) if(!is.null(p.value)){ p.value <- p.value %>% keep_only_tbl_df_classes() %>% gather(key = "column", value = "p", -rowname) cor.value <- cor.value %>% left_join(p.value, by = c("rowname", "column")) colnames(cor.value) <- c("var1", "var2", "cor", "p") } else{ colnames(cor.value) <- c("var1", "var2", "cor") } if(drop.na) cor.value <- cor.value %>% drop_na() cor.value } #' @describeIn cor_reshape spread a long correlation data frame into wide #' format. Expects the columns "var1", "var2" and "cor" in the data. #' (correlation matrix). #' @export cor_spread <- function(data, value = "cor"){ if(!(all(c("var1", "var2", value) %in% colnames(data)))){ stop("The input data should contains the columns: var1, var2 and cor") } var1 <- var2 <- cor <- p <- NULL row.vars <- data %>% pull(var1) %>% unique() col.vars <- data %>% pull(var2) %>% unique() res <- data %>% keep_only_tbl_df_classes() %>% select(var1, var2, !!value) %>% spread(key = "var2", value = value) %>% rename(rowname = var1) %>% respect_variables_order(row.vars = row.vars, col.vars = col.vars) colnames(res)[1] <- "rowname" res } # Helper functions # ::::::::::::::::::::::::::::::::::::::::::::::::::::: # Reorder a correlation matrix according # to the order of variables in vars respect_variables_order <- function(data, vars, row.vars = vars, col.vars = vars){ data %>% subset_matrix(row.vars = row.vars, col.vars = col.vars) } rstatix/R/kruskal_test.R0000644000176200001440000000411115074310430015001 0ustar liggesusers#' @include utilities.R NULL #'Kruskal-Wallis Test #' #' #'@description Provides a pipe-friendly framework to perform Kruskal-Wallis #' rank sum test. Wrapper around the function #' \code{\link[stats]{kruskal.test}()}. #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{x ~ group} where \code{x} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ cancer_group}. #'@param ... other arguments to be passed to the function #' \code{\link[stats]{kruskal.test}}. #' #'@return return a data frame with the following columns: \itemize{ \item #' \code{.y.}: the y variable used in the test. \item \code{n}: sample count. #' \item \code{statistic}: the kruskal-wallis rank sum statistic used to #' compute the p-value. \item \code{p}: p-value. \item \code{method}: the #' statistical test used to compare groups.} #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # Kruskal-wallis rank sum test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% kruskal_test(len ~ dose) #' #' # Grouped data #' df %>% #' group_by(supp) %>% #' kruskal_test(len ~ dose) #'@name kruskal_test #'@export kruskal_test <- function(data, formula, ...){ args <- c(as.list(environment()), list(...)) %>% .add_item(method = "kruskal_test") if(is_grouped_df(data)){ results <- data %>% doo(.kruskal_test, formula, ...) } else{ results <- .kruskal_test(data, formula, ...) } results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "kruskal_test")) } .kruskal_test <- function(data, formula, ...) { outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) term <- statistic <- p <- df <- method <- NULL stats::kruskal.test(formula, data = data, ...) %>% as_tidy_stat() %>% select(statistic, df, p, method) %>% add_column(.y. = outcome, n = nrow(data), .before = "statistic") } rstatix/R/utils-manova.R0000644000176200001440000000030515074310430014706 0ustar liggesusers#' Manova exported from car package #' #' See \code{car::\link[car:Anova]{Manova}} for details. #' #' @name Manova #' @rdname Manova #' @keywords internal #' @export #' @importFrom car Manova NULL rstatix/R/dunn_test.R0000644000176200001440000001304015074310430014272 0ustar liggesusers#' @include utilities.R t_test.R NULL #'Dunn's Test of Multiple Comparisons #' #'@description Performs Dunn's test for pairwise multiple comparisons of the #' ranked data. The mean rank of the different groups is compared. Used for #' post-hoc test following Kruskal-Wallis test. #' #' The default of the \code{rstatix::dunn_test()} function is to perform a #' two-sided Dunn test like the well known commercial softwares, such as SPSS #' and GraphPad. This is not the case for some other R packages #' (\code{dunn.test} and \code{jamovi}), where the default is to perform #' one-sided test. This discrepancy is documented at #' \href{https://github.com/kassambara/rstatix/issues/50}{https://github.com/kassambara/rstatix/issues/50}. #' #'@inheritParams t_test #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y (outcome) variable used in the test. \item #' \code{group1,group2}: the compared groups in the pairwise tests. \item #' \code{n1,n2}: Sample counts. \item \code{estimate}: mean ranks difference. #' \item \code{estimate1, estimate2}: show the mean rank values of the two #' groups, respectively. \item \code{statistic}: Test statistic (z-value) used #' to compute the p-value. \item \code{p}: p-value. \item \code{p.adj}: the #' adjusted p-value. \item \code{method}: the statistical test used to compare #' groups. \item \code{p.signif, p.adj.signif}: the significance level of #' p-values and adjusted p-values, respectively. } #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #'@details DunnTest performs the post hoc pairwise multiple comparisons #' procedure appropriate to follow up a Kruskal-Wallis test, which is a #' non-parametric analog of the one-way ANOVA. The Wilcoxon rank sum test, #' itself a non-parametric analog of the unpaired t-test, is possibly #' intuitive, but inappropriate as a post hoc pairwise test, because (1) it #' fails to retain the dependent ranking that produced the Kruskal-Wallis test #' statistic, and (2) it does not incorporate the pooled variance estimate #' implied by the null hypothesis of the Kruskal-Wallis test. #' #'@references Dunn, O. J. (1964) Multiple comparisons using rank sums #' Technometrics, 6(3):241-252. #' @examples #' # Simple test #' ToothGrowth %>% dunn_test(len ~ dose) #' #' # Grouped data #' ToothGrowth %>% #' group_by(supp) %>% #' dunn_test(len ~ dose) #'@export dunn_test <- function(data, formula, p.adjust.method = "holm", detailed = FALSE){ args <- as.list(environment()) %>% .add_item(method = "dunn_test") if(is_grouped_df(data)){ results <- data %>% doo(.dunn_test, formula, p.adjust.method ) } else{ results <- .dunn_test(data, formula, p.adjust.method) } if(!detailed){ results <- results %>% select(-.data$method, -.data$estimate, -.data$estimate1, -.data$estimate2) } results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "dunn_test")) } .dunn_test <- function(data, formula, p.adjust.method = "holm"){ outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(number.of.groups == 1){ stop("all observations are in the same group") } data <- data %>% select(!!!syms(c(outcome, group))) %>% get_complete_cases() %>% .as_factor(group) x <- data %>% pull(!!outcome) g <- data %>% pull(!!group) group.size <- data %>% get_group_size(group) if (!all(is.finite(g))) stop("all group levels must be finite") x.rank <- rank(x) mean.ranks <- tapply(x.rank, g, mean, na.rm=TRUE) grp.sizes <- tapply(x, g, length) n <- length(x) C <- get_ties(x.rank, n) compare.meanrank <- function(i, j){ mean.ranks[i] - mean.ranks[j] } compare.stats <- function(i,j) { dif <- mean.ranks[i] - mean.ranks[j] A <- n * (n+1) / 12 B <- (1 / grp.sizes[i] + 1 / grp.sizes[j]) zval <- dif / sqrt((A - C) * B) zval } compare.levels <- function(i, j) { dif <- abs(mean.ranks[i] - mean.ranks[j]) A <- n * (n+1) / 12 B <- (1 / grp.sizes[i] + 1 / grp.sizes[j]) zval <- dif / sqrt((A - C) * B) pval <- 2 * stats::pnorm(abs(zval), lower.tail = FALSE) pval } ESTIMATE <- stats::pairwise.table( compare.meanrank, levels(g), p.adjust.method = "none" ) %>% tidy_squared_matrix("diff") PSTAT <- stats::pairwise.table( compare.stats, levels(g), p.adjust.method = "none" ) %>% tidy_squared_matrix("statistic") PVAL <- stats::pairwise.table( compare.levels, levels(g), p.adjust.method = "none" ) %>% tidy_squared_matrix("p") %>% mutate(method = "Dunn Test", .y. = outcome) %>% adjust_pvalue(method = p.adjust.method) %>% add_significance("p.adj") %>% add_column(statistic = PSTAT$statistic, .before = "p") %>% add_column(estimate = ESTIMATE$diff, .before = "group1") %>% select(.data$.y., .data$group1, .data$group2, .data$estimate, everything()) n1 <- group.size[PVAL$group1] n2 <- group.size[PVAL$group2] mean.ranks1 <- mean.ranks[PVAL$group1] mean.ranks2 <- mean.ranks[PVAL$group2] PVAL %>% add_column(n1 = n1, n2 = n2, .after = "group2") %>% add_column(estimate1 = mean.ranks1, estimate2 = mean.ranks2, .after = "estimate") } get_ties <- function(x, n) { x.sorted <- sort(x) pos <- 1 tiesum <- 0 while (pos <= n) { val <- x.sorted[pos] nt <- length(x.sorted[x.sorted == val]) pos <- pos + nt if (nt > 1){ tiesum <- tiesum + nt^3 - nt } } tiesum / (12 * (n - 1)) } rstatix/R/prop_trend_test.R0000644000176200001440000000440515074310430015507 0ustar liggesusers#' @include utilities.R NULL #'Test for Trend in Proportions #'@description Performs chi-squared test for trend in proportion. This test is #' also known as Cochran-Armitage trend test. #' #' Wrappers around the R base function \code{\link[stats]{prop.trend.test}()} but #' returns a data frame for easy data visualization. #'@param xtab a cross-tabulation (or contingency table) with two columns and #' multiple rows (rx2 design). The columns give the counts of successes and #' failures respectively. #' @param score group score. If \code{NULL}, the default is group number. #' #'@return return a data frame with some the following columns: \itemize{ \item #' \code{n}: the number of participants. \item \code{statistic}: the value of #' Chi-squared trend test statistic. \item \code{df}: the degrees of #' freedom. #' \item \code{p}: p-value. \item #' \code{method}: the used statistical test. \item \code{p.signif}: the significance level of p-values and adjusted p-values, #' respectively.} #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' @examples #' # Proportion of renal stone (calculi) across age #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data #' xtab <- as.table(rbind( #' c(384, 536, 335), #' c(951, 869, 438) #' )) #' dimnames(xtab) <- list( #' stone = c("yes", "no"), #' age = c("30-39", "40-49", "50-59") #' ) #' xtab #' # Compare the proportion of survived between groups #' prop_trend_test(xtab) #' @export prop_trend_test <- function(xtab, score = NULL){ args <- as.list(environment()) %>% add_item(method = "chisq_trend_test") if(is.data.frame(xtab)) xtab <- as.matrix(xtab) if(inherits(xtab, c("matrix", "table"))){ if(ncol(xtab) > 2 & nrow(xtab) == 2) xtab <- t(xtab) } total <- sum(xtab) events <- xtab[, 1] trials <- rowSums(xtab) if(is.null(score)) score <- seq_along(events) results <- stats::prop.trend.test(events, trials, score) %>% as_tidy_stat() %>% add_significance("p") %>% mutate(method = "Chi-square trend test") %>% add_columns(n = total, .before = 1) %>% select(.data$n, .data$statistic, .data$p, .data$p.signif, everything()) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "chisq_trend_test")) } rstatix/R/box_m.R0000644000176200001440000000510215074707640013410 0ustar liggesusers#' @include utilities.R #' @importFrom stats cov #' @importFrom stats pchisq NULL #' Box's M-test for Homogeneity of Covariance Matrices #' @description Performs the Box's M-test for homogeneity of covariance matrices #' obtained from multivariate normal data according to one grouping variable. #' The test is based on the chi-square approximation. #' @param data a numeric data.frame or matrix containing n observations of p #' variables; it is expected that n > p. #' @param group a vector of length n containing the class of each #' observation; it is usually a factor. #' @return A data frame containing the following components: #' \item{statistic}{an approximated value of the chi-square distribution.} #' \item{parameter}{the degrees of freedom related of the test statistic in this case that it follows a Chi-square distribution.} #' \item{p.value}{the p-value of the test.} #' \item{method}{the character string "Box's M-test for Homogeneity of Covariance Matrices".} #' @examples #' data(iris) #' box_m(iris[, -5], iris[, 5]) #' @export box_m <-function(data, group) { if (!inherits(data, c("data.frame", "matrix"))) stop("'data' must be a numeric data.frame or matrix!") if (length(group) != nrow(data)) stop("incompatible dimensions!") dname <- deparse(substitute(data)) data <- as.matrix(data) group <- as.factor(as.character(group)) p <- ncol(data) nlev <- nlevels(group) lev <- levels(group) dfs <- tapply(group, group, length) - 1 if (any(dfs < p)) warning("there are one or more levels with less observations than variables!") mats <- aux <- list() for(i in 1:nlev) { mats[[i]] <- cov(data[group == lev[i], , drop = FALSE]) aux[[i]] <- mats[[i]] * dfs[i] } names(mats) <- lev pooled <- Reduce("+", aux) / sum(dfs) logdet <- log(unlist(lapply(mats, det))) minus2logM <- sum(dfs) * log(det(pooled)) - sum(logdet * dfs) sum1 <- sum(1 / dfs) Co <- (((2 * p^2) + (3 * p) - 1) / (6 * (p + 1) * (nlev - 1))) * (sum1 - (1 / sum(dfs))) X2 <- minus2logM * (1 - Co) dfchi <- (choose(p, 2) + p) * (nlev - 1) pval <- pchisq(X2, dfchi, lower.tail = FALSE) out <- structure( list(statistic = c("Chi-Sq (approx.)" = X2), parameter = c(df = dfchi), p.value = pval, cov = mats, pooled = pooled, logDet = logdet, data.name = dname, method = "Box's M-test for Homogeneity of Covariance Matrices" ), class = c("htest", "boxM") ) out <- broom::tidy(out) return(out) } rstatix/R/cohens_d.R0000644000176200001440000002214415074310430014056 0ustar liggesusers#' @include utilities.R utilities_two_sample_test.R #' @importFrom stats sd #' @importFrom stats var NULL #'Compute Cohen's d Measure of Effect Size #' #'@description Compute the effect size for t-test. T-test conventional effect #' sizes, proposed by Cohen, are: 0.2 (small effect), 0.5 (moderate effect) and #' 0.8 (large effect). #' #' Cohen's \code{d} is calculated as the difference between means or mean minus #' \code{mu} divided by the estimated standardized deviation. #' #' For independent samples t-test, there are two possibilities implemented. If #' the t-test did not make a homogeneity of variance assumption, (the Welch #' test), the variance term will mirror the Welch test, otherwise a pooled #' estimate is used. #' #' If a paired samples t-test was requested, then effect size desired is based #' on the standard deviation of the differences. #' #' It can also returns confidence intervals by bootstap. #' #'@inheritParams wilcox_effsize #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{x ~ group} where \code{x} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ cancer_group}. #'@param paired a logical indicating whether you want a paired test. #'@param mu theoretical mean, use for one-sample t-test. Default is 0. #'@param var.equal a logical variable indicating whether to treat the two #' variances as being equal. If TRUE then the pooled variance is used to #' estimate the variance otherwise the Welch (or Satterthwaite) approximation #' to the degrees of freedom is used. Used only for unpaired or independent samples test. #'@param hedges.correction logical indicating whether apply the Hedges #' correction by multiplying the usual value of Cohen's d by #' \code{(N-3)/(N-2.25)} (for unpaired t-test) and by \code{(n1-2)/(n1-1.25)} for paired t-test; #' where \code{N} is the total size of the two groups being compared (N = n1 + #' n2). #'@details Quantification of the effect size magnitude is performed using the #' thresholds defined in Cohen (1992). The magnitude is assessed using the #' thresholds provided in (Cohen 1992), i.e. \code{|d| < 0.2} "negligible", #' \code{|d| < 0.5} "small", \code{|d| < 0.8} "medium", otherwise "large". #'@references \itemize{ \item Cohen, J. (1988). Statistical power analysis for #' the behavioral sciences (2nd ed.). New York:Academic Press. \item Cohen, J. #' (1992). A power primer. Psychological Bulletin, 112, 155-159. \item Hedges, #' Larry & Olkin, Ingram. (1985). Statistical Methods in Meta-Analysis. #' 10.2307/1164953. \item Navarro, Daniel. 2015. Learning Statistics with R: A #' Tutorial for Psychology Students and Other Beginners (Version 0.5). } #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y variable used in the test. \item #' \code{group1,group2}: the compared groups in the pairwise tests. \item #' \code{n,n1,n2}: Sample counts. \item \code{effsize}: estimate of the effect #' size (\code{d} value). \item \code{magnitude}: magnitude of effect size. #' \item \code{conf.low,conf.high}: lower and upper bound of the effect size #' confidence interval.} #' @examples #' # One-sample t test effect size #' ToothGrowth %>% cohens_d(len ~ 1, mu = 0) #' #' # Two indepedent samples t-test effect size #' ToothGrowth %>% cohens_d(len ~ supp, var.equal = TRUE) #' #' # Paired samples effect size #' df <- data.frame( #' id = 1:5, #' pre = c(110, 122, 101, 120, 140), #' post = c(150, 160, 110, 140, 155) #' ) #' df <- df %>% gather(key = "treatment", value = "value", -id) #' head(df) #' #' df %>% cohens_d(value ~ treatment, paired = TRUE) #'@export cohens_d <- function(data, formula, comparisons = NULL, ref.group = NULL, paired = FALSE, mu = 0, var.equal = FALSE, hedges.correction = FALSE, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000){ env <- as.list(environment()) args <- env %>% .add_item(method = "cohens_d") params <- env %>% remove_null_items() %>% add_item(method = "cohens.d", detailed = FALSE) outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(number.of.groups > 2 & !is.null(ref.group)){ if(ref.group %in% c("all", ".all.")){ params$data <- create_data_with_all_ref_group(data, outcome, group) params$ref.group <- "all" } } test.func <- two_sample_test if(number.of.groups > 2) test.func <- pairwise_two_sample_test res <- do.call(test.func, params) %>% select(.data$.y., .data$group1, .data$group2, .data$estimate, everything()) %>% rename(effsize = .data$estimate) %>% mutate(magnitude = get_cohens_magnitude(.data$effsize)) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "cohens_d")) res } # Cohens d core function ------------------------------- cohens.d <- function(x, y = NULL, mu = 0, paired = FALSE, var.equal = FALSE, hedges.correction = FALSE, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ...){ check_two_samples_test_args( x = x, y = y, mu = mu, paired = paired, conf.level = conf.level ) if (!is.null(y)) { DNAME <- paste(deparse(substitute(x)), "and", deparse(substitute(y))) if (paired) { OK <- complete.cases(x, y) x <- x[OK] - y[OK] y <- NULL mu <- 0 METHOD <- "Paired T-test" } else { x <- x[is.finite(x)] y <- y[is.finite(y)] METHOD <- "Independent T-test" } } else { DNAME <- deparse(substitute(x)) METHOD <- "One-sample T-test" x <- x[is.finite(x)] } if(is.null(y)){ formula <- x ~ 1 y <- rep(mu, length(x)) } else{ group <- rep(c("grp1", "grp2"), times = c(length(x), length(y))) %>% factor() x <- c(x, y) y <- group formula <- x ~ y } data <- data.frame(x, y) results <- get_cohens_d( data, formula, paired = paired, var.equal = var.equal, mu = mu, hedges.correction = hedges.correction ) # Confidence interval of the effect size r if (ci == TRUE) { stat.func <- function(data, subset) { get_cohens_d( data, formula = formula, subset = subset, paired = paired, var.equal = var.equal, mu = mu, hedges.correction = hedges.correction )$d } CI <- get_boot_ci( data, stat.func, conf.level = conf.level, type = ci.type, nboot = nboot ) results <- results %>% mutate(conf.low = CI[1], conf.high = CI[2]) } RVAL <- list(statistic = NA, p.value = NA, null.value = mu, method = METHOD, data.name = DNAME, estimate = results$d) if (ci) { attr(CI, "conf.level") <- conf.level RVAL <- c(RVAL, list(conf.int = CI)) } names(RVAL$estimate) <- "Cohen's d" class(RVAL) <- "htest" RVAL } # Helper to compute cohens d ----------------------------------- get_cohens_d <- function(data, formula, subset = NULL, paired = FALSE, mu = 0, var.equal = FALSE, hedges.correction = FALSE){ outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) if(!is.null(subset)) data <- data[subset, ] if(.is_empty(group)) number.of.groups <- 1 # Null model else number.of.groups <- data %>% pull(group) %>% unique() %>% length() unpaired.two.samples <- paired == FALSE & number.of.groups == 2 if(number.of.groups == 1){ x <- data %>% pull(outcome) d <- one_sample_d(x, mu) } else if(number.of.groups == 2){ groups <- data %>% pull(group) data <- data %>% split(groups) x <- data[[1]] %>% pull(outcome) y <- data[[2]] %>% pull(outcome) if(paired){ d <- paired_sample_d(x, y) } else{ d <- two_independent_sample_d(x, y, var.equal) } } else{ stop("The grouping factors contain more than 2 levels.") } # Hedge's correction if(hedges.correction){ if(paired){ n <- length(x) d <- d*(n - 2)/(n - 1.25) } else if (unpaired.two.samples){ n <- length(x) + length(y) d <- d * (n - 3)/(n - 2.25) } else{ stop( "Hedge's Correction for One Sample Test is not supported.\n", "Please use `hedges.correction = FALSE` (default) for one sample test.", call. = FALSE ) } } tibble( d, magnitude = get_cohens_magnitude(d) ) } one_sample_d <- function(x, mu = 0){ (mean(x) - mu)/sd(x) } two_independent_sample_d <- function(x, y, var.equal = TRUE){ if(var.equal){ squared.dev <- (c(x - mean(x), y - mean(y)))^2 n <- length(squared.dev) SD <- sqrt(sum(squared.dev)/(n-2)) } else { SD <- sqrt((var(x) + var(y))/2) } mean.diff <- mean(x) - mean(y) mean.diff/SD } paired_sample_d <- function(x, y){ mean(x-y)/sd(x-y) } get_cohens_magnitude <- function(d){ magnitude.levels = c(0.2,0.5,0.8) magnitude = c("negligible","small","moderate","large") d.index <- findInterval(abs(d), magnitude.levels)+1 magnitude <- factor(magnitude[d.index], levels = magnitude, ordered = TRUE) magnitude } rstatix/R/multinom_test.R0000644000176200001440000000524315074310430015200 0ustar liggesusers#' @include utilities.R NULL #'Exact Multinomial Test #' #'@description Performs an exact multinomial test. Alternative to the chi-square test of goodness-of-fit-test when the sample #' size is small. #' #'@inheritParams binom_test #' #'@seealso \link{binom_test} #'@return return a data frame containing the p-value and its significance. #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' #' @examples #' # Data #' tulip <- c(red = 81, yellow = 50, white = 27) #' #' # Question 1: are the color equally common ? #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # this is a test of homogeneity #' res <- multinom_test(tulip) #' res #' #' attr(res, "descriptives") #' #' # Pairwise comparisons between groups #' pairwise_binom_test(tulip, p.adjust.method = "bonferroni") #' #' #' # Question 2: comparing observed to expected proportions #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # this is a goodness-of-fit test #' expected.p <- c(red = 0.5, yellow = 0.33, white = 0.17) #' res <- multinom_test(tulip, expected.p) #' res #' attr(res, "descriptives") #' #' # Pairwise comparisons against a given probabilities #' pairwise_binom_test_against_p(tulip, expected.p) #' @export multinom_test <- function (x, p = rep(1/length(x), length(x)), detailed = FALSE) { args <- as.list(environment()) %>% add_item(method = "exact_multinom_test") if (!is.vector(x)) { stop("'x' must be a vector") } if (sum(p) != 1) { stop("sum of probabilities must be 1") } if (length(x) != length(p)) { stop("'x' and 'p' lengths differ") } if(is.null(names(x))){ names(x) <- paste0("grp", 1:length(x)) } size <- sum(x) groups <- length(x) numEvents <- choose(size + groups - 1, groups - 1) pObs <- stats::dmultinom(x, size, p) findVectors <- function(groups, size) { if (groups == 1) { mat <- size } else { mat <- matrix(rep(0, groups - 1), nrow = 1) for (i in 1:size) { mat <- rbind(mat, findVectors(groups - 1, i)) } mat <- cbind(mat, size - rowSums(mat)) } mat } eventMat <- findVectors(groups, size) eventProb <- apply(eventMat, 1, function(x) stats::dmultinom(x, size, p)) p.val <- sum(eventProb[eventProb <= pObs]) results <- tibble( p = p.val, method = "Exact multinomial test" ) %>% add_significance() %>% select(.data$p, .data$p.signif, .data$method) descriptives <- tibble( group = names(x), observed = x, expected = p*size ) if(!detailed){ results <- results[, c("p", "p.signif")] } results %>% set_attrs(args = args, descriptives = descriptives) %>% add_class(c("rstatix_test", "exact_multinom_test")) } rstatix/R/outliers.R0000644000176200001440000000713615074310430014146 0ustar liggesusers#' @include utilities.R #' @importFrom stats quantile #' @importFrom stats IQR NULL #'Identify Univariate Outliers Using Boxplot Methods #' #' #'@description Detect outliers using boxplot methods. Boxplots are a popular and #' an easy method for identifying outliers. There are two categories of #' outlier: (1) outliers and (2) extreme points. #' #' Values above \code{Q3 + 1.5xIQR} or below \code{Q1 - 1.5xIQR} are considered #' as outliers. Values above \code{Q3 + 3xIQR} or below \code{Q1 - 3xIQR} are #' considered as extreme points (or extreme outliers). #' #' Q1 and Q3 are the first and third quartile, respectively. IQR is the #' interquartile range (IQR = Q3 - Q1). #' #' Generally speaking, data points that are labelled outliers in boxplots are #' not considered as troublesome as those considered extreme points and might #' even be ignored. Note that, any \code{NA} and \code{NaN} are automatically removed #' before the quantiles are computed. #' #'@return \itemize{ \item \code{identify_outliers()}. Returns the input data #' frame with two additional columns: "is.outlier" and "is.extreme", which hold #' logical values. \item \code{is_outlier() and is_extreme()}. Returns logical #' vectors. } #' #'@param data a data frame #'@param ... One unquoted expressions (or variable name). Used to select a #' variable of interest. Alternative to the argument \code{variable}. #'@param variable variable name for detecting outliers #'@param x a numeric vector #'@param coef coefficient specifying how far the outlier should be from the edge #' of their box. Possible values are 1.5 (for outlier) and 3 (for extreme #' points only). Default is 1.5 #' #' #' @examples #' # Generate a demo data #' set.seed(123) #' demo.data <- data.frame( #' sample = 1:20, #' score = c(rnorm(19, mean = 5, sd = 2), 50), #' gender = rep(c("Male", "Female"), each = 10) #' ) #' #' # Identify outliers according to the variable score #' demo.data %>% #' identify_outliers(score) #' #' # Identify outliers by groups #' demo.data %>% #' group_by(gender) %>% #' identify_outliers("score") #'@describeIn outliers takes a data frame and extract rows suspected as outliers #' according to a numeric column. The following columns are added "is.outlier" #' and "is.extreme". #'@export identify_outliers <- function(data, ..., variable = NULL){ is.outlier <- NULL if(is_grouped_df(data)){ results <- data %>% doo(identify_outliers, ..., variable = variable) if(nrow(results) == 0) results <- as.data.frame(results) return(results) } if(!inherits(data, "data.frame")) stop("data should be a data frame") variable <- data %>% get_selected_vars(..., vars = variable) n.vars <- length(variable) if(n.vars > 1) stop("Specify only one variable") values <- data %>% pull(!!variable) results <- data %>% mutate( is.outlier = is_outlier(values), is.extreme = is_extreme(values) ) %>% filter(is.outlier == TRUE) if(nrow(results) == 0) results <- as.data.frame(results) results } #' @describeIn outliers detect outliers in a numeric vector. Returns logical vector. #' @export is_outlier <- function(x, coef = 1.5){ res <- x Q1 <- quantile(x, 0.25, na.rm = TRUE) Q3 <- quantile(x, 0.75, na.rm = TRUE) .IQR <- IQR(x, na.rm = TRUE) upper.limit <- Q3 + (coef*.IQR) lower.limit <- Q1 - (coef*.IQR) outlier <- ifelse(x < lower.limit | x > upper.limit, TRUE, FALSE ) outlier } #' @describeIn outliers detect extreme points in a numeric vector. An alias of #' \code{is_outlier()}, where coef = 3. Returns logical vector. #' @export is_extreme <- function(x){ is_outlier(x, coef = 3) } rstatix/R/make_clean_names.R0000644000176200001440000000136415074310430015537 0ustar liggesusers#' @include utilities.R NULL #'Make Clean Names #' #' #'@description Pipe-friendly function to make syntactically valid names out of #' character vectors. #' #' @param data a data frame or vector #' @return a data frame or a vector depending on the input data #' #' @examples #' #' # Vector #' make_clean_names(c("a and b", "a-and-b")) #' make_clean_names(1:10) #' #' # data frame #' df <- data.frame( #' `a and b` = 1:4, #' `c and d` = 5:8, #' check.names = FALSE #' ) #' df #' make_clean_names(df) #' #' @export make_clean_names <- function(data){ if(is.vector(data)){ data <- make.names(data) } else if(inherits(data, c("data.frame", "matrix"))){ .colnames <- colnames(data) %>% make.names() colnames(data) <- .colnames } data } rstatix/R/sign_test.R0000644000176200001440000002004515074420216014275 0ustar liggesusers#' @include utilities.R utilities_two_sample_test.R #' @importFrom stats qbinom #' @importFrom stats pbinom NULL #'Sign Test #' #'@description Performs one-sample and two-sample sign tests. Read more: #' \href{https://www.datanovia.com/en/lessons/sign-test-in-r/}{Sign Test in R}. #'@inheritParams t_test #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{x ~ group} where \code{x} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ treatment}. #'@param mu a single number representing the value of the population median #' specified by the null hypothesis. #'@param ref.group a character string specifying the reference group. If #' specified, for a given grouping variable, each of the group levels will be #' compared to the reference group (i.e. control group). #'@param ... other arguments passed to the function \code{sign_test()} #' #'@return return a data frame with some the following columns: \itemize{ \item #' \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the #' compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. #' \item \code{statistic}: Test statistic used to compute the p-value. That is #' the S-statistic (the number of positive differences between the data and the #' hypothesized median), with names attribute \code{"S"}. \item \code{df, #' parameter}: degrees of freedom. Here, the total number of valid differences. #' \item \code{p}: p-value. \item \code{method}: the statistical test used to #' compare groups. \item \code{p.signif, p.adj.signif}: the significance level #' of p-values and adjusted p-values, respectively. \item \code{estimate}: #' estimate of the effect size. It corresponds to the median of the #' differences. \item \code{alternative}: a character string describing the #' alternative hypothesis. \item \code{conf.low,conf.high}: Lower and upper #' bound on a confidence interval of the estimate. } #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #'@note This function is a reimplementation of the function \code{SignTest()} #' from the \code{DescTools} package. #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # One-sample test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% sign_test(len ~ 1, mu = 0) #' #' #' # Two-samples paired test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% sign_test(len ~ supp) #' #' #' # Compare supp levels after grouping the data by "dose" #' #:::::::::::::::::::::::::::::::::::::::: #' df %>% #' group_by(dose) %>% #' sign_test(data =., len ~ supp) %>% #' adjust_pvalue(method = "bonferroni") %>% #' add_significance("p.adj") #' #' # pairwise comparisons #' #:::::::::::::::::::::::::::::::::::::::: #' # As dose contains more than two levels ==> #' # pairwise test is automatically performed. #' df %>% sign_test(len ~ dose) #' #' # Comparison against reference group #' #:::::::::::::::::::::::::::::::::::::::: #' # each level is compared to the ref group #' df %>% sign_test(len ~ dose, ref.group = "0.5") #' #' #'@describeIn sign_test Sign test #'@export sign_test <- function(data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", alternative = "two.sided", mu = 0, conf.level = 0.95, detailed = FALSE){ args <- as.list(environment()) %>% .add_item(method = "sign_test") outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(!is.null(ref.group)){ if(ref.group %in% c("all", ".all.")) stop("ref.group can't be 'all'.") } # Case of one sample test if(number.of.groups == 1){ res <- one_sample_sign_test( data = data, formula = formula, alternative = alternative, mu = mu, conf.level = conf.level, detailed = detailed ) } # Case of two independents or paired groups else if (number.of.groups == 2) { res <- two_sample_sign_test( data = data, formula = formula, alternative = alternative, conf.level = conf.level, ref.group = ref.group, detailed = detailed ) } # Pairwise comparisons else if(number.of.groups > 2){ res <- pairwise_sign_test( data = data, formula = formula, comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, alternative = alternative, conf.level = conf.level, detailed = detailed ) } res %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "sign_test")) } one_sample_sign_test <- function(data, formula, mu = 0, ...){ two_sample_test(data, formula, method = "sign.test", mu = mu, ...) } two_sample_sign_test <- function(data, formula, ...) { two_sample_test(data, formula, method = "sign.test", ...) } #'@describeIn sign_test performs pairwise two sample Wilcoxon test. #'@export pairwise_sign_test <- function( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", detailed = FALSE, ...) { args <- as.list(environment()) %>% .add_item(method = "sign_test") res <- pairwise_two_sample_test( data, formula, method = "sign.test", comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, detailed = detailed, ... ) res %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "sign_test")) } #' @noRd sign.test <- function(x, y = NULL, alternative = c("two.sided", "less", "greater"), mu = 0, conf.level = 0.95, ...) { alternative <- match.arg(alternative) check_two_samples_test_args(x = x, y = y, mu = mu, conf.level = conf.level) if (!is.null(y)) { if (length(x) != length(y)) stop("'x' and 'y' must have the same length") DNAME <- paste(deparse(substitute(x)), "and", deparse(substitute(y))) OK <- complete.cases(x, y) x <- x[OK] y <- y[OK] METHOD <- "Paired-samples Sign-Test" x <- (x - y) } else { DNAME <- deparse(substitute(x)) x <- x[is.finite(x)] METHOD <- "One-sample Sign-Test" } d <- (x - mu) n.valid <- sum(d > 0) + sum(d < 0) if(n.valid > 0) { RVAL <- stats::binom.test(x=sum(d > 0), n=n.valid, p=0.5, alternative = alternative, conf.level = conf.level ) } else { RVAL <- stats::binom.test(x=1, n=1) } RVAL$method <- METHOD RVAL$data.name <- DNAME names(mu) <- if (!is.null(y)) "median difference" else "median" names(RVAL$statistic) <- "S" RVAL$estimate <- median(d + mu, na.rm=TRUE) names(RVAL$parameter) <- "number of differences" mci <- get_median_ci(d + mu, conf.level=conf.level, alternative=alternative) RVAL$conf.int <- mci attr(RVAL$conf.int, "conf.level") = round(attr(mci,"conf.level"), 3) names(RVAL$estimate) <- "median of the differences" RVAL$null.value <- mu class(RVAL) <- "htest" return(RVAL) } get_median_ci <- function( x, conf.level = 0.95, alternative = c("two.sided", "less", "greater")){ # http://www.stat.umn.edu/geyer/old03/5102/notes/rank.pdf # http://de.scribd.com/doc/75941305/Confidence-Interval-for-Median-Based-on-Sign-Test x <- stats::na.omit(x) n <- length(x) switch( match.arg(alternative) , "two.sided" = { k <- qbinom(p = (1 - conf.level) / 2, size=n, prob=0.5, lower.tail=TRUE) ci <- sort(x)[c(k, n - k + 1)] attr(ci, "conf.level") <- 1 - 2 * pbinom(k-1, size=n, prob=0.5) } , "greater" = { k <- qbinom(p = (1 - conf.level), size=n, prob=0.5, lower.tail=TRUE) ci <- c(sort(x)[k], Inf) attr(ci, "conf.level") <- 1 - pbinom(k-1, size=n, prob=0.5) } , "less" = { k <- qbinom(p = conf.level, size=n, prob=0.5, lower.tail=TRUE) ci <- c(-Inf, sort(x)[k]) attr(ci, "conf.level") <- pbinom(k, size=n, prob=0.5) } ) return(ci) } rstatix/R/utilities.R0000644000176200001440000004544415074310430014317 0ustar liggesusers#' @importFrom magrittr %>% #' @importFrom magrittr %<>% #' @importFrom magrittr extract #' @importFrom magrittr set_colnames #' @importFrom dplyr mutate #' @importFrom dplyr mutate_at #' @importFrom dplyr mutate_all #' @importFrom dplyr pull #' @importFrom dplyr select #' @importFrom dplyr rename #' @importFrom dplyr as_data_frame #' @importFrom dplyr bind_rows #' @importFrom dplyr group_by #' @importFrom dplyr summarise #' @importFrom dplyr n #' @importFrom dplyr is_grouped_df #' @importFrom dplyr ungroup #' @importFrom dplyr do #' @importFrom dplyr filter #' @importFrom dplyr tibble #' @importFrom dplyr everything #' @importFrom dplyr left_join #' @importFrom purrr map map2 #' @importFrom broom tidy #' @importFrom stats t.test #' @importFrom rlang sym #' @importFrom rlang !! #' @importFrom rlang := #' @importFrom rlang .data #' @importFrom rlang syms #' @importFrom rlang !!! #' @importFrom rlang quos #' @importFrom rlang quo_name #' @importFrom tibble add_column #' @importFrom tibble as_tibble #' @importFrom tidyr spread #' @importFrom tidyr gather #' @importFrom tidyr nest # Unnesting, adapt to tidyr 1.0.0 unnest <- function(data, cols = "data", ...){ if(is_pkg_version_sup("tidyr", "0.8.3")){ results <- tidyr::unnest(data, cols = cols, ...) } else {results <- tidyr::unnest(data, ...)} results } # Check if an installed package version is superior to a specified version # Version, pkg: character vector is_pkg_version_sup<- function(pkg, version){ vv <- as.character(utils::packageVersion(pkg)) cc <- utils::compareVersion(vv, version) > 0 cc } # Rounding values -------------------------------------- # Round a vector, conditionnaly rounding round_value <- function(x, digits = 0){ sapply( x, function(x, digits){ if(is.na(x)) x else if(abs(x) > 10^-digits) round(x, digits) else signif(x, digits) }, digits ) } # Round a whole data frame or selected columns round_column <- function(data, ..., digits = 0){ dot.vars <- get_existing_dot_vars(data, ...) if(.is_empty(dot.vars)){ data %<>% dplyr::mutate_if(is.numeric, round_value, digits = digits) } data %<>% dplyr::mutate_at(dot.vars, round_value, digits = digits) data } # Extract or replace number from character string extract_number <- function(x){ as.numeric(gsub("[^0-9.-]+", "", as.character(x))) } replace_number <- function(x, replacement = ""){ gsub("[0-9.]", replacement, as.character(x)) } # Add columns into data frame # If specified before or after columns does not exist, columns are appended at the end add_columns <- function(.data, ..., .before = NULL, .after = NULL){ if(is.character(.before)){ if(!(.before %in% colnames(.data))){ .before <- NULL } } if(is.character(.after)){ if(!(.after %in% colnames(.data))){ .after <- NULL } } tibble::add_column(.data, ..., .before = .before, .after = .after) } # Check if required package is installed required_package <- function(pkg){ if (!requireNamespace(pkg, quietly = TRUE)) { stop( pkg, " package needed to be installed before using this function. ", "Type this in R: install.packages('", pkg, "')" ) } } # Check if a given column name is in the data assertthat_column_exists <-function(data, cols){ .diff <- setdiff(cols, colnames(data)) if(!.is_empty(.diff)){ stop("Can't find the following variable(s) in the data: ", paste(col, collapse = ", ")) } } # remove null elements from a list remove_null_items <- function(.list){ Filter(Negate(is.null), .list) } # Count a pattern in a string str_count <- function(x, pattern){ lengths(regmatches(x, gregexpr(pattern, x))) } # Check if all columns in a data frame are numeric is_all_columns_numeric <- function(data){ data %>% map(is.numeric) %>% unlist() %>% all() } is_lm <- function(object){ inherits(object, "lm") } # Check odd and even numbers is_odd_number <- function(x){ x %% 2 != 0 } is_even_number <- function(x){ x %% 2 == 0 } # Set diff that can keep duplicates set_diff <- function(x, y, keep.dup = FALSE){ if(!keep.dup) res <- setdiff(x, y) else{ ins <- x %in% y res <- x[!ins] } res } # NSE #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # Get the value of enquo variables. Usage: #++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ # .args <- rlang::enquos(x = x, y = y, ...) %>% # map(~get_quo_vars(data, .)) get_quo_vars <- function (data, vars) { if(rlang::quo_is_missing(vars)){ return(NULL) } names(data) %>% tidyselect::vars_select(!!vars) %>% magrittr::set_names(NULL) } # .args <- rlang::enquos(x = x, y = y, ...) %>% # get_quo_vars_list(data, .) get_quo_vars_list <- function(data, .enquos){ . <- NULL res <- .enquos %>% map(~get_quo_vars(data, .)) res <- map(res, set_empty_to_null ) res } # pipe friendly alias of get_quo_vars_list select_quo_variables <- function(.enquos, data){ get_quo_vars_list(data, .enquos) } set_empty_to_null <- function(x){ if(.is_empty(x)) x <- NULL x } # Extract variables used in a formula #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: get_formula_left_hand_side <- function(formula){ deparse(formula[[2]]) } get_formula_right_hand_side <- function(formula){ attr(stats::terms(formula), "term.labels") } .extract_formula_variables <- function(formula){ outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) list(outcome = outcome, group = group) } # Get formula error term: len ~ dose*diet + Error(id/diet) # retruns Error(id/diet) get_formula_error_term <- function(formula){ rhs <- get_formula_right_hand_side(formula) error.term <- rhs[grepl("^Error\\(", rhs)] error.term } # Get variables included in the error terms get_formula_error_vars <- function(formula){ error.term <- get_formula_error_term(formula) all.vars(parse(text = error.term)) } is_error_term_in_formula <- function(formula){ error.term <- get_formula_error_term(formula) length(error.term) > 0 } # Grouping variables manipulation #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: guess_number_of_groups <- function(data, group){ if(.is_empty(group)){ number.of.groups <- 1 # Null model } else{ number.of.groups <- data %>% pull(!!group) %>% unique() %>% length() } number.of.groups } get_levels <- function(data, group){ data %>% pull(!!group) %>% levels() } # Convert a group column into a factor if this is not already the case #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # group.col column name containing groups # ref.group: optional reference group # ToothGrowth %>% .as_factor("dose", ref.group = "0.5") %>% pull("dose") .as_factor <- function (data, group.col, ref.group = NULL){ if(.is_empty(group.col)) return(data) group.values <- data %>% pull(group.col) if(!is.factor(group.values)) group.values <- as.factor(group.values) if(!is.null(ref.group)){ if(ref.group != "") group.values <- stats::relevel(group.values, ref.group) } data %>% mutate(!!group.col := group.values) } # Guess p-value column name from a statistical test output #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # transform vector into regular expression as_regexp <- function(x){ . <- NULL gsub(".", "\\.", x, fixed = TRUE) %>% paste(collapse = "$|^") %>% paste("^", ., "$", sep = "") } # Generate all possible pairs of a factor levels #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # if ref.group is specified, then all possible pairs, # against reference group, are generated .possible_pairs <- function(group.levels, ref.group = NULL){ # Ref group should be always the first group if(!is.null(ref.group)) group.levels <- c(ref.group, group.levels) group.levels <- unique(group.levels) # Generate possible pairs possible.pairs <- utils::combn(group.levels, 2) %>% as.data.frame() mate1 <- possible.pairs[1,] # select only comparisons against ref.group (if specified) if(!is.null(ref.group)) possible.pairs <- possible.pairs %>% select(which(mate1 == ref.group)) possible.pairs %>% as.list() } # Create a tidy statistical output #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # Generic function to create a tidy statistical output as_tidy_stat <- function(x, round.p = TRUE, digits = 3, stat.method = NULL){ estimate <- estimate1 <- estimate2 <- p.value <- alternative <- p <- NULL res <- tidy(x) if(!is.null(stat.method)){ res %<>% mutate(method = stat.method) } else if("method" %in% colnames(res)){ stat.method <- get_stat_method(x) res %<>% mutate(method = stat.method) } if("p.value" %in% colnames(res)){ res<- res %>% rename(p = p.value) if(round.p) res <- res %>% mutate(p = signif(p, digits)) } if("parameter" %in% colnames(res)){ res <- res %>% rename(df = .data$parameter) } res } get_stat_method <- function(x){ if(inherits(x, c("aov", "anova"))){ return("Anova") } available.methods <- c( "T-test", "Wilcoxon", "Kruskal-Wallis", "Pearson", "Spearman", "Kendall", "Sign-Test", "Cohen's d", "Chi-squared test" ) used.method <- available.methods %>% map(grepl, x$method, ignore.case = TRUE) %>% unlist() if(sum(used.method) > 0){ results <- available.methods %>% extract(used.method) if(length(results) >= 2) results <- paste(results, collapse = " ") } else results <- x$method results } # Check if en object is empty #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: .is_empty <- function(x){ length(x) == 0 } # Check if is a list #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: .is_list <- function(x){ inherits(x, "list") } # Returns the levels of a factor variable #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: .levels <- function(x){ if(!is.factor(x)) x <- as.factor(x) levels(x) } # Add/remove items in a list #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: add_item <- function(.list, ...){ pms <- list(...) for(pms.names in names(pms)){ .list[[pms.names]] <- pms[[pms.names]] } .list } remove_item <- function(.list, items){ for(item in items) .list[[item]] <- NULL .list } remove_null_items <- function(.list){ Filter(Negate(is.null), .list) } # depreciated .add_item <- function(.list, ...){ add_item(.list, ...) } # First letter uppercase #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: to_uppercase_first_letter <- function(x) { if(is.null(x)) return(x) substr(x, 1, 1) <- toupper(substr(x, 1, 1)) x } # Data conversion #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: as_matrix <- function(x){ if(inherits(x, "tbl_df")){ tibble_to_matrix(x) } else if(inherits(x, "matrix")){ x } else if(is.data.frame(x)){ if("rowname" %in% colnames(x)){ x %>% tibble::remove_rownames() %>% tibble::column_to_rownames("rowname") %>% as_matrix() } else { as.matrix(x) } } else{ as.matrix(x) } } # Convert a tbl to matrix tibble_to_matrix <- function(x){ x <- as.data.frame(x) rownames(x) <- x[, 1] x <- x[, -1] as.matrix(x) } # Convert a matrix to standard data frame matrix_to_dataframe <- function(x){ x <- as.data.frame(x, stringsAsFactors = FALSE) %>% add_column(rowname = rownames(x), .before = 1) rownames(x) <- NULL x } # Convert a matrix to tibble matrix_to_tibble <- function(x){ as_tibble(x, rownames = "rowname") } # Replace empty space as na replace_empty_by <- function(x, replacement = NA){ x %>% keep_only_tbl_df_classes() %>% dplyr::mutate_all( function(x){x[x==""] <- replacement; x} ) } # Correlation analysis #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # Stop if not an object of class cor_mat #+++++++++++++++++++++++++++++++++++++++++++++++++++++++ stop_ifnot_cormat <- function(x){ if(!inherits(x, "cor_mat")){ stop("An object of class cor_mat is required") } } # Subset a correlation matrix, return a tibble #+++++++++++++++++++++++++++++++++++++++++++++++++++++++ subset_matrix <- function(x, vars, row.vars = vars, col.vars = vars){ if(inherits(x, c("tbl_df", "data.frame"))){ . <- NULL x %>% as_matrix() %>% .[row.vars, col.vars, drop = FALSE] %>% as_tibble(rownames = "rowname") } else if(inherits(x, "matrix")){ x[row.vars, col.vars, drop = FALSE] %>% as_tibble(rownames ="rowname") } else{ stop("x should be a data frame or rownames") } } # Tidy Select #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # Collect variables provided by users; get selected variables get_selected_vars <- function(x, ..., vars = NULL){ if(is_grouped_df(x)) x <- x %>% dplyr::ungroup() dot.vars <- rlang::quos(...) if(length(vars) > 0){ return(vars) } if (length(dot.vars) == 0) selected <- colnames(x) else selected <- tidyselect::vars_select(names(x), !!! dot.vars) selected %>% as.character() } # Return dot variables ----------------------- get_dot_vars <- function(...){ rlang::quos(...) %>% map(rlang::quo_text) %>% unlist() } get_existing_dot_vars <- function(data, ...){ tidyselect::vars_select(colnames(data), !!!rlang::quos(...)) } # Select numeric columns #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: select_numeric_columns <- function(data){ if(is_grouped_df(data)) data <- data %>% dplyr::ungroup() data %>% dplyr::select_if(is.numeric) } # Add a class to an object #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: add_class <- function(x, .class){ class(x) <- unique(c(.class, class(x))) x } prepend_class <- function(x, .class){ current.class <- class(x) diff.class <- setdiff(class(x), .class) x <- structure(x, class = c(.class, diff.class)) x } remove_class <- function(x, toremove){ class(x) <- setdiff(class(x), toremove) x } keep_only_tbl_df_classes <- function(x){ toremove <- setdiff(class(x), c("tbl_df", "tbl", "data.frame")) if(length(toremove) > 0){ x <- remove_class(x, toremove) } x } # Add/set attributes #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: set_attrs <- function (x, ...) { attrs <- list(...) attributes(x) <- c(attributes(x), attrs) x } # Correlation analysis #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # Check classes #+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .is_cor_mat <- function(x){ inherits(x, "cor_mat") } .is_cor_test <- function(x){ inherits(x, "cor_test") } # Convert a cor_mat_tri to numeric data as_numeric_triangle <- function(x){ rrowname <- x %>% pull(1) res <- x %>% replace_empty_by(NA) %>% select(-1) %>% mutate_all(as.numeric) %>% add_column(rowname = rrowname, .before = 1) res } # Create label for each row in a grouped data #:::::::::::::::::::::::::::::::::::::::::::::::: # Labels are the combination of the levels of the grouping variables # ex: dose:0.5,supp:VC create_grouped_data_label <- function(data){ if(!is_grouped_df(data)){ stop("data should be a grouped data") } .nested <- nest(data) .vars <- dplyr::group_vars(data) .data <- .nested %>% select(!!!syms(.vars)) for(.var in .vars){ values <- .data %>% pull(!!.var) .data <- .data %>% mutate(!!.var := paste0(.var, ":", values)) } .results <- .data %>% purrr::pmap(paste, sep = ",") %>% unlist() .results } #:::::::::::::::::::::::::::::::::::::::::::::::: # Helper functions to process rstatix test results #:::::::::::::::::::::::::::::::::::::::::::::::: is_rstatix_test <- function(x){ inherits(x, "rstatix_test") } # get rstatix test arguments get_test_arguments <- function(test){ attr(test, "args") } # get test grouping variables # exist when tests are performed on grouped data get_test_grouping_vars <- function(test){ args <- get_test_arguments(test) grouping.vars <- dplyr::group_vars(args$data) if(.is_empty(grouping.vars)) grouping.vars <- NULL grouping.vars } # Get and set the test attributes: class and attr # used to propagate attributes get_test_attributes <- function(test){ .attributes <- attributes(test) .attributes$names <- .attributes$row.names <- NULL .attributes } set_test_attributes <- function(test, .attributes){ class(test) <- .attributes$class .attributes$class <- NULL for (attr.name in names(.attributes)){ attr(test, attr.name ) <- .attributes[[attr.name]] } test } get_group_size <- function(data, group){ result <- data %>% group_by(!!sym(group)) %>% dplyr::count() n <- result$n group.levels <- result %>% pull(1) names(n) <- group.levels n } stop_ifnot_class <- function(x, .class){ object.name <- deparse(substitute(x)) if(!inherits(x, .class)){ stop(object.name, " should be an object of class: ", paste(.class, collapse = ", ")) } } # Allowed pairwise comparison tests get_pairwise_comparison_methods <- function(){ c( t_test = "T test", wilcox_test = "Wilcoxon test", sign_test = "Sign test", dunn_test = "Dunn test", emmeans_test = "Emmeans test", tukey_hsd = "Tukey HSD", games_howell_test = "Games Howell", prop_test = "Z-Prop test", fisher_test = "Fisher's exact test", chisq_test = "Chi-square test", exact_binom_test = "Exact binomial test", mcnemar_test = "McNemar test" ) } # Bootstrap confidence intervals ------------------------- get_boot_ci <- function(data, stat.func, conf.level = 0.95, type = "perc", nboot = 500){ required_package("boot") Boot = boot::boot(data, stat.func, R = nboot) BCI = boot::boot.ci(Boot, conf = conf.level, type = type, parallel = "multicore") type <- switch( type, norm = "normal", perc = "percent", basic = "basic", bca = "bca", stud = "student", type ) CI <- as.vector(BCI[[type]]) %>% utils::tail(2) %>% round_value(digits = 2) CI } get_complete_cases <- function(data){ data %>% filter(complete.cases(data)) } # transform squared matrix into tidy data frame tidy_squared_matrix <- function(data, value = "value"){ data %>% as_tibble(rownames = "group2") %>% gather(key = "group1", value = !!value, -.data$group2) %>% stats::na.omit() %>% as_tibble() %>% select(.data$group1, everything()) } # Binomial proportion confidence interval get_prop_conf_int <- function(x, n, p = 0.5, conf.level = 0.95, alternative = "two.sided"){ .get_conf <- function(x, n, p, alternative, conf.level){ res <- stats::binom.test(x, n, p, alternative, conf.level)$conf.int tibble(conf.low = res[1], conf.high = res[2]) } results <- list(x = x, n = n, p = p) %>% purrr::pmap( .get_conf, conf.level = conf.level, alternative = alternative ) %>% dplyr::bind_rows() } rstatix/R/cor_as_symbols.R0000644000176200001440000000326515074310430015315 0ustar liggesusers#' @include utilities.R NULL #' Replace Correlation Coefficients by Symbols #' #' @description Take a correlation matrix and replace the correlation coefficients by symbols according to the #' level of the correlation. #' @param x a correlation matrix. Particularly, an object of class \code{cor_mat}. #' @param cutpoints numeric vector used for intervals. Default values are #' \code{c(0, 0.25, 0.5, 0.75, 1)}. #' @param symbols character vector, one shorter than cutpoints, used as #' correlation coefficient symbols. Default values are \code{c(" ", ".", "+", #' "*")}. #' @seealso \code{\link{cor_mat}()} #' @examples #' # Compute correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_mat() #' #' # Replace correlation coefficient by symbols #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat %>% #' cor_as_symbols() %>% #' pull_lower_triangle() #' #' @name cor_as_symbols #' @export cor_as_symbols <- function( x, cutpoints = c(0, 0.25, 0.5, 0.75, 1), symbols = c(" ", ".", "+", "*")) { if(inherits(x, "cor_mat_tri")){ cor.mat <- x %>% replace_empty_by(0) %>% as_numeric_triangle() %>% as_matrix() } else{ cor.mat <- as_matrix(x) } res <- stats::symnum( abs(cor.mat), cutpoints = cutpoints, symbols = symbols, abbr.colnames = FALSE ) %>% structure(class = "matrix") %>% # overwrite "noquote" class matrix_to_dataframe() %>% add_class(c("data.frame", "tbl_df")) pvalue <- attr(x, "pvalue") if(!is.null(pvalue)){ res <- res %>% set_attrs(pvalue = pvalue) %>% add_class("cor_mat") } res } rstatix/R/mcnemar_test.R0000644000176200001440000001271515074310430014760 0ustar liggesusers#' @include utilities.R NULL #'McNemar's Chi-squared Test for Count Data #'@description Performs McNemar chi-squared test to compare paired proportions. #' #' Wrappers around the R base function \code{\link[stats]{mcnemar.test}()}, but #' provide pairwise comparisons between multiple groups #'@inheritParams stats::mcnemar.test #'@param data a data frame containing the variables in the formula. #'@param formula a formula of the form \code{a ~ b | c}, where \code{a} is the #' outcome variable name; b is the within-subjects factor variables; and c #' (factor) is the column name containing individuals/subjects identifier. #' Should be unique per individual. #'@param type type of statistical tests used for pairwise comparisons. Allowed #' values are one of \code{c("mcnemar", "exact")}. #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #' #' #'@return return a data frame with the following columns: \itemize{ #' \item \code{n}: the number of participants. #' \item \code{statistic}: the value of McNemar's statistic. \item \code{df} the #' degrees of freedom of the approximate chi-squared distribution of the test #' statistic. \item \code{p}: p-value. \item \code{p.adj}: the adjusted #' p-value. \item \code{method}: the used statistical test. \item #' \code{p.signif}: the significance level of p-values.} #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' @examples #' #' # Comparing two paired proportions #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: frequencies of smokers before and after interventions #' xtab <- as.table( #' rbind(c(25, 6), c(21,10)) #' ) #' dimnames(xtab) <- list( #' before = c("non.smoker", "smoker"), #' after = c("non.smoker", "smoker") #' ) #' xtab #' #' # Compare the proportion of smokers #' mcnemar_test(xtab) #' #' # Comparing multiple related proportions #' # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Generate a demo data #' mydata <- data.frame( #' outcome = c(0,1,1,0,0,1,0,1,1,1,1,1,0,0,1,1,0,1,0,1,1,0,0,1,0,1,1,0,0,1), #' treatment = gl(3,1,30,labels=LETTERS[1:3]), #' participant = gl(10,3,labels=letters[1:10]) #' ) #' mydata$outcome <- factor( #' mydata$outcome, levels = c(1, 0), #' labels = c("success", "failure") #' ) #' # Cross-tabulation #' xtabs(~outcome + treatment, mydata) #' #' # Compare the proportion of success between treatments #' cochran_qtest(mydata, outcome ~ treatment|participant) #' #' # pairwise comparisons between groups #' pairwise_mcnemar_test(mydata, outcome ~ treatment|participant) #' #'@describeIn mcnemar_test performs McNemar's chi-squared test for comparing two #' paired proportions #'@export mcnemar_test <- function(x, y = NULL, correct = TRUE){ args <- as.list(environment()) %>% add_item(method = "mcnemar_test") if(is.data.frame(x)) x <- as.matrix(x) if(inherits(x, c("matrix", "table"))) n <- sum(x) else n <- length(x) results <- stats::mcnemar.test(x, y, correct) %>% as_tidy_stat() %>% add_significance("p") %>% mutate(method = "McNemar test", n = n) results[, c("n", "statistic", "df", "p", "p.signif", "method")] %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "mcnemar_test")) } #'@describeIn mcnemar_test performs pairwise McNemar's chi-squared test between #' multiple groups. Could be used for post-hoc tests following a significant Cochran's Q test. #'@export pairwise_mcnemar_test <- function (data, formula, type = c("mcnemar", "exact"), correct = TRUE, p.adjust.method = "bonferroni") { type <- match.arg(type) test.class <- switch (type, mcnemar = "mcnemar_test", exact = "exact_binom_test" ) data <- data %>% select(!!!syms(all.vars(formula))) colnames(data) <- c("outcome", "groups", "participant") if(length(unique(data$outcome))> 2){ stop("Unique possible outcome values should be 2") } args <- as.list(environment()) %>% add_item(method = test.class) # helper function to compar pairs compare_pair <- function(grps, data, type = "mcnemar"){ grps <- as.character(grps) grps.data <- data[, grps] colnames(grps.data) <- c("grp1", "grp2") xtab <- stats::xtabs(~grp1+grp2, grps.data) if(type == "mcnemar"){ results <- mcnemar_test(xtab, correct = correct) } else if(type == "exact"){ # Get off-diagonal values b <- xtab[2, 1] c <- xtab[1, 2] results <- binom_test(b, (b + c), p = 0.5, detailed = TRUE) } results %>% keep_only_tbl_df_classes() %>% select(.data$p, .data$method) %>% add_columns(group1 = grps[1], group2 = grps[2], .before = "p") } # Convert outcome into factor, then spread. data <- data %>% mutate(outcome = as.factor(.data$outcome)) %>% spread(key = "groups", value = "outcome") # Pairwise comparisons comparisons <- colnames(data)[-1] %>% .possible_pairs() results <- comparisons %>% map(compare_pair, data, type = type) %>% bind_rows() %>% adjust_pvalue("p", method = p.adjust.method) %>% add_significance("p.adj") %>% mutate(p.adj = signif(.data$p.adj, digits = 3)) results [, c("group1", "group2", "p", "p.adj", "p.adj.signif", "method")] %>% set_attrs(args = args) %>% add_class(c("rstatix_test", test.class)) } rstatix/R/factorial_design.R0000644000176200001440000002154215074310430015572 0ustar liggesusers#' @include utilities.R NULL #'Build Factorial Designs for ANOVA #' #' #'@description Provides helper functions to build factorial design for easily #' computing ANOVA using the \code{\link[car]{Anova}()} function. This might be #' very useful for repeated measures ANOVA, which is hard to set up with the #' \code{car} package. #'@inheritParams anova_test #'@param data a data frame containing the variables #'@return a list with the following components: \itemize{ \item \strong{the #' specified arguments}: \code{dv, wid, between, within} \item \strong{data}: #' the original data (long format) or independent ANOVA. The wide format is #' returned for repeated measures ANOVA. \item \strong{idata}: an optional data #' frame giving the levels of factors defining the intra-subject model for #' multivariate repeated-measures data. \item \strong{idesign}: a one-sided #' model formula using the “data” in idata and specifying the intra-subject #' design. \item \strong{repeated}: logical. Value is TRUE when the data is a #' repeated design. \item \strong{lm_formula}: the formula used to build the #' \code{lm} model. \item \strong{lm_data}: the data used to build the \code{lm} #' model. Can be either in a long format (i.e., the original data for #' independent measures ANOVA) or in a wide format (case of repeated measures ANOVA). \item \strong{model}: the \code{lm} model } #'@author Alboukadel Kassambara, \email{alboukadel.kassambara@@gmail.com} #'@seealso \code{\link{anova_test}()}, \code{\link{anova_summary}()} #'@examples #'# Load data #'#::::::::::::::::::::::::::::::::::::::: #'data("ToothGrowth") #'df <- ToothGrowth #' head(df) #' #'# Repeated measures designs #'#::::::::::::::::::::::::::::::::::::::::: #'# Prepare the data #'df$id <- rep(1:10, 6) # Add individuals id #'head(df) #'# Build factorial designs #'design <- factorial_design(df, dv = len, wid = id, within = c(supp, dose)) #'design #'# Easily perform repeated measures ANOVA using the car package #' res.anova <- Anova(design$model, idata = design$idata, idesign = design$idesign, type = 3) #' summary(res.anova, multivariate = FALSE) #' #'# Independent measures designs #'#::::::::::::::::::::::::::::::::::::::::: #'# Build factorial designs #' df$id <- 1:nrow(df) #' design <- factorial_design(df, dv = len, wid = id, between = c(supp, dose)) #' design #' # Perform ANOVA #' Anova(design$model, type = 3) #' #'@rdname factorial_design #'@export factorial_design <- function(data, dv, wid, between, within, covariate){ # Check factorial design %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% . <- NULL .args <- rlang::enquos(dv = dv, between = between, wid = wid, within = within, covariate = covariate) %>% get_quo_vars_list(data, .) %>% remove_null_items() %>% add_item(data = data) %>% check_factorial_design() dv <- .args$dv between <- .args$between within <- .args$within covariate <- .args$covariate data <- .args$data %>% select(!!!syms(c(.args$wid, dv, between, within, covariate))) rhs <- create_formula_right_hand_side(between, covariate) # Repeated measures designs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if(!is.null(within)){ not.within.vars <- setdiff(colnames(data), within) nested <- data %>% group_by(!!!syms(within)) %>% nest() # Get intra-subject factor levels .args$idata <- nested %>% select(-data) %>% dplyr::arrange(!!!syms(within)) %>% as.data.frame() .args$idesign <- paste(within, collapse = "*") %>% paste0('~',.) %>% stats::as.formula() # Unite intra-subject factors into one grouping column, # then spread the data into wide format wide <- nested %>% tidyr::unite(!!!syms(within), col = ".group.", sep = "_") %>% select(.data$.group., data) %>% unnest() %>% spread(key = ".group.", value = dv) %>% as_tibble() .args$lm_data <- wide .args$repeated <- TRUE # Build model formula: orders of wide dv name and data colnames should match # dv are all possible combinations of within-subjects factor levels wide.dv.name <- setdiff(colnames(wide), not.within.vars) %>% paste(collapse = ", ") lm_formula <- paste0("cbind(", wide.dv.name, ") ~ ", rhs) } # Independent measures designs %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% else if(!is.null(between)){ .args$lm_data <- .args$data .args$repeated <- FALSE lm_formula <- paste0(dv, " ~ ", rhs) } # Fit lm lm_formula <- .args$lm_formula <- stats::as.formula(lm_formula) data <- .args$lm_data opt <- options( "contrasts" = c( "contr.sum", "contr.poly" ) ) .args$model <- stats::lm(lm_formula, data) options(opt) .args } create_formula_right_hand_side <- function(between, covariate = NULL){ covariate <- paste(covariate, collapse = "+") between <- paste(between, collapse = "*") bc.sep <- ifelse(covariate != "" & between != "", " + ", "") # Between and covariate vars separator rhs <- paste0(covariate, bc.sep, between) if(rhs == "") rhs <- "1" rhs } # Cheking the design #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% check_factorial_design <- function(.args){ if(!inherits(.args$data, "data.frame")){ stop('data should be a data frame.') } if(is.null(.args$within) & is.null(.args$between)){ stop("Specify at least one of the arguments: 'within' and 'between'") } .args$data <- droplevels(.args$data) %>% as_tibble() .args <- .args %>% remove_missing_values_in_data() %>% assertthat_dv_is_numeric() %>% assertthat_wid_is_specified() %>% asserthat_wid_is_unique() %>% convert_grouping_vars_to_factor() %>% assertthat_iv_has_enough_levels() .args } # Remove missing values remove_missing_values_in_data <- function(.args){ model.variables <- c( .args$dv, .args$wid, .args$between, .args$within, .args$covariate ) complete.rows <- stats::complete.cases(.args$data[, model.variables]) na.rows <- which(!complete.rows) na.exists <- length(na.rows) > 0 if(na.exists){ warning( "NA detected in rows: ", paste(na.rows, collapse = ","), ".", "\nRemoving this rows before the analysis.", call. = FALSE ) .args$data <- .args$data[complete.rows, ] } .args } # Make sure the dependent variable (dv) is numeric assertthat_dv_is_numeric <- function(.args){ if(is.null(.args$dv)){ stop("The dependent variable argument 'dv' is required") } dv.data <- .args$data %>% select(!!!syms(.args$dv)) if(!is_all_columns_numeric(dv.data)){ stop("The dependent variable 'dv' should be numeric") } invisible(.args) } # Make sure that the id is provided, otherwise # Create it in the case of between-Ss ANOVA assertthat_wid_is_specified <- function(.args){ if(is.null(.args$wid)){ if(!is.null(.args$within)){ stop("Specify the argument 'wid'", ", required for repeated measures ANOVA") } else{ .args$wid <- ".id." .args$data$.id. <- factor(1:nrow(.args$data)) } } .args } # Check if individual id is unique in each between groups # otherwise, create unique id accross between groups asserthat_wid_is_unique <- function(.args){ if(is.null(.args$between)) return(.args) if(!is_id_unique_by_between_vars(.args)){ warning("The 'wid' column contains duplicate ids across ", "between-subjects variables. ", "Automatic unique id will be created", immediate. = TRUE, call. = FALSE) wid <- .args$wid .args$data <- .args$data %>% mutate(!!wid := create_uniqueId_by_bteween_vars(.args)) } .args } is_id_unique_by_between_vars <- function(.args){ data <- .args$data wid <- .args$wid between <- .args$between # Split the data by between variables nested <- data %>% group_by(!!!syms(between)) %>% nest() %>% mutate(data = map(.data$data, dplyr::distinct, !!sym(wid), .keep_all = TRUE)) # Check that id is unique accross between groups freq <- nested %>% unnest() %>% group_by(!!!syms(c(wid))) %>% summarise(count = n()) %>% pull(.data$count) all(freq == 1) } create_uniqueId_by_bteween_vars <- function(.args){ data <- .args$data vars <- c(.args$wid, .args$between) data %>% select(!!!syms(vars)) %>% dplyr::mutate_all(as.character) %>% purrr::pmap(paste, sep = ".") %>% unlist() %>% factor() } # Make sure that independent variables (iv) has more than one levels assertthat_iv_has_enough_levels <- function(.args){ vars <- c(.args$within, .args$between) data <- .args$data for(.var in vars){ n.levels <- unique(data[[.var]]) %>% length() if(n.levels == 1){ stop("Variable ", .var, "has only one level. ", "Remove it from the model.") } } .args } # Convert the grouping variables to factor convert_grouping_vars_to_factor <- function(.args){ .args$data <- .args$data %>% convert_as_factor(vars = c(.args$wid, .args$between)) %>% convert_as_factor(vars = .args$within, make.valid.levels = TRUE) .args } rstatix/R/anova_test.R0000644000176200001440000005422715074310430014446 0ustar liggesusers#' @include utilities.R factorial_design.R anova_summary.R NULL #'Anova Test #' #' #'@description Provides a pipe-friendly framework to perform different types of #' ANOVA tests, including: \itemize{ \item #' \strong{\href{https://www.datanovia.com/en/lessons/anova-in-r/}{Independent #' measures ANOVA}}: between-Subjects designs, \item #' \strong{\href{https://www.datanovia.com/en/lessons/repeated-measures-anova-in-r/}{Repeated #' measures ANOVA}}: within-Subjects designs \item #' \strong{\href{https://www.datanovia.com/en/lessons/mixed-anova-in-r/}{Mixed #' ANOVA}}: Mixed within within- and between-Subjects designs, also known as #' split-plot ANOVA and \item #' \strong{\href{https://www.datanovia.com/en/lessons/ancova-in-r/}{ANCOVA: #' Analysis of Covariance}}. } #' #' The function is an easy to use wrapper around \code{\link[car]{Anova}()} and #' \code{\link[stats]{aov}()}. It makes ANOVA computation handy in R and It's #' highly flexible: can support model and formula as input. Variables can be #' also specified as character vector using the arguments \code{dv, wid, #' between, within, covariate}. #' #' The results include ANOVA table, generalized effect size and some assumption #' checks. #' #' #'@param data a data.frame or a model to be analyzed. #'@param formula a formula specifying the ANOVA model similar to #' \link[stats]{aov}. Can be of the form \code{y ~ group} where \code{y} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ cancer_group}. #' #' Examples of supported formula include: \itemize{ \item Between-Ss ANOVA #' (independent measures ANOVA): \code{y ~ b1*b2} \item Within-Ss ANOVA #' (repeated measures ANOVA): \code{y ~ w1*w2 + Error(id/(w1*w2))} \item Mixed #' ANOVA: \code{y ~ b1*b2*w1 + Error(id/w1)} } #' #' If the formula doesn't contain any within vars, a linear model is directly #' fitted and passed to the ANOVA function. For repeated designs, the ANOVA #' variables are parsed from the formula. #' #'@param dv (numeric) dependent variable name. #'@param wid (factor) column name containing individuals/subjects identifier. #' Should be unique per individual. #'@param between (optional) between-subject factor variables. #'@param within (optional) within-subjects factor variables #'@param covariate (optional) covariate names (for ANCOVA) #'@param type the type of sums of squares for ANOVA. Allowed values are either #' 1, 2 or 3. \code{type = 2} is the default because this will yield identical #' ANOVA results as type = 1 when data are balanced but type = 2 will #' additionally yield various assumption tests where appropriate. When the data #' are unbalanced the \code{type = 3} is used by popular commercial softwares #' including SPSS. #'@param effect.size the effect size to compute and to show in the ANOVA #' results. Allowed values can be either "ges" (generalized eta squared) or #' "pes" (partial eta squared) or both. Default is "ges". #'@param white.adjust Default is FALSE. If TRUE, heteroscedasticity correction #' is applied to the coefficient of covariance matrix. Used only for #' independent measures ANOVA. #'@param error (optional) for a linear model, an lm model object from which the #' overall error sum of squares and degrees of freedom are to be calculated. #' Read more in \code{\link[car]{Anova}()} documentation. #'@param observed Variables that are observed (i.e, measured) as compared to #' experimentally manipulated. The default effect size reported (generalized #' eta-squared) requires correct specification of the observed variables. #'@param detailed If TRUE, returns extra information (sums of squares columns, #' intercept row, etc.) in the ANOVA table. #'@param x an object of class \code{anova_test} #'@param correction character. Used only in repeated measures ANOVA test to #' specify which correction of the degrees of freedom should be reported for #' the within-subject factors. Possible values are: \itemize{ \item{"GG"}: #' applies Greenhouse-Geisser correction to all within-subjects factors even if #' the assumption of sphericity is met (i.e., Mauchly's test is not #' significant, p > 0.05). \item{"HF"}: applies Hyunh-Feldt correction to all #' within-subjects factors even if the assumption of sphericity is met, #' \item{"none"}: returns the ANOVA table without any correction and #' \item{"auto"}: apply automatically GG correction to only within-subjects #' factors violating the sphericity assumption (i.e., Mauchly's test p-value is #' significant, p <= 0.05). } #'@seealso \code{\link{anova_summary}()}, \code{\link{factorial_design}()} #'@return return an object of class \code{anova_test} a data frame containing #' the ANOVA table for independent measures ANOVA. #' #' However, for repeated/mixed measures ANOVA, a list containing the following #' components are returned: ANOVA table, Mauchly's Test for Sphericity, #' Sphericity Corrections. These table are described more in the documentation #' of the function \code{\link{anova_summary}()}. #' #' The \strong{returned object has an attribute} called \code{args}, which is a #' list holding the arguments used to fit the ANOVA model, including: data, dv, #' within, between, type, model, etc. #' #'@details The setting in \code{anova_test()} is done in such a way that it #' gives the same results as SPSS, one of the most used commercial software. By #' default, R uses treatment contrasts, where each of the levels is compared to #' the first level used as baseline. The default contrast can be checked using #' \code{options('contrasts')}. In the function \code{anova_test()}, the #' following setting is used #' \code{options(contrasts=c('contr.sum','contr.poly'))}, which gives #' orthogonal contrasts where you compare every level to the overall mean. This #' setting gives the same output as the most commonly used commercial #' softwares, like SPSS. If you want to obtain the same result with the #' function \code{car::Anova()} as the one obtained with #' \code{rstatix::anova_test()}, then don't forget to set #' \code{options(contrasts=c('contr.sum','contr.poly'))}. #'@author Alboukadel Kassambara, \email{alboukadel.kassambara@@gmail.com} #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # One-way ANOVA test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% anova_test(len ~ dose) #' #' # Grouped One-way ANOVA test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% #' group_by(supp) %>% #' anova_test(len ~ dose) #' #' # Two-way ANOVA test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% anova_test(len ~ supp*dose) #' #' # Two-way repeated measures ANOVA #' #::::::::::::::::::::::::::::::::::::::::: #' df$id <- rep(1:10, 6) # Add individuals id #' # Use formula #' \donttest{ #' df %>% anova_test(len ~ supp*dose + Error(id/(supp*dose))) #' } #' #' #' # or use character vector #' df %>% anova_test(dv = len, wid = id, within = c(supp, dose)) #' #' # Extract ANOVA table and apply correction #' #::::::::::::::::::::::::::::::::::::::::: #' res.aov <- df %>% anova_test(dv = len, wid = id, within = c(supp, dose)) #' get_anova_table(res.aov, correction = "GG") #' #' #' # Use model as arguments #' #::::::::::::::::::::::::::::::::::::::::: #' .my.model <- lm(yield ~ block + N*P*K, npk) #' anova_test(.my.model) #' #' #'@describeIn anova_test perform anova test #'@export anova_test <- function(data, formula, dv, wid, between, within, covariate, type = NULL, effect.size = "ges", error = NULL, white.adjust = FALSE, observed = NULL, detailed = FALSE){ .args <- rlang::enquos( dv = dv, wid = wid, between = between, within = within, covariate = covariate) %>% select_quo_variables(data) %>% add_item(type = type, white.adjust = white.adjust, method = "anova_test") if(!missing(formula)) .args$formula <- formula .anova_test <- function(data, .args, effect.size = "ges", error = NULL, observed = NULL, detailed = FALSE){ .args <- .args %>% add_item(data = data) %>% check_anova_arguments() if(.args$type != 1) { if(is.null(error)) res.anova <- car_anova(.args) else res.anova <- car_anova(.args, error = error) } else if(.args$type == 1) res.anova <- stats_aov(.args) else stop("Something is wrong...") results <- res.anova %>% anova_summary( effect.size = effect.size, detailed = detailed, observed = observed ) results } .append_anova_class <- function(x){ class(x) <- c("anova_test", class(x), "rstatix_test") x } if(is_grouped_df(data)){ results <- data %>% doo( ~.anova_test(data = ., .args = .args, effect.size = effect.size, error = error, observed = observed, detailed = detailed), result = "anova" ) if("anova" %in% colnames(results)){ # This happens for repeated measure anova results <- results %>% mutate(anova = map(.data$anova, .append_anova_class)) } results <- results %>% set_attrs(args = list(data = data)) class(results) <- c("grouped_anova_test", class(results), "rstatix_test") } else{ results <- .anova_test( data, .args = .args, effect.size = effect.size, error = error, observed = observed, detailed = detailed ) %>% .append_anova_class() } results } # Extract ANOVA table ----------------------------------------------- #' @describeIn anova_test extract anova table from an object of class #' \code{anova_test}. When within-subject factors are present, either #' sphericity corrected or uncorrected degrees of freedom can be reported. #' @export get_anova_table <- function(x, correction = c("auto", "GG", "HF", "none")){ correction <- match.arg(correction) if(is_grouped_anova_test(x)){ results <- get_anova_table_from_grouped_test(x, correction = correction) } else{ results <- get_anova_table_from_simple_test(x, correction = correction) } results } get_anova_table_from_simple_test <- function(x, correction = "auto"){ correction.method <- method <- correction if(method == "auto") method = "GG" # Independent anova if(!inherits(x, "list")){ return(x) } if(correction.method == "none"){ res.aov <- x$ANOVA attr(res.aov, "args") <- attr(x, "args") class(res.aov) <- c("anova_test", class(res.aov), "rstatix_test") return(res.aov) } # repeated/mixed design # Get correction table from anova_test .args <- attr(x, "args") get_corrections_table <- function(x, method = c("GG", "HF")){ method <- match.arg(method) pattern <- paste0("Effect|", method) corrections <- x$`Sphericity Corrections` %>% select(tidyselect::matches(pattern)) colnames(corrections) <- c("Effect", "epsilon", "df", "p", "p<.05") corrections <- corrections %>% tidyr::separate(col = "df", into = c("DFn", "DFd"), sep = ", ", convert = TRUE) %>% mutate(method = method) corrections } res.aov <- x$ANOVA sphericity <- x$`Mauchly's Test for Sphericity` corrections <- get_corrections_table(x, method) # If auto apply correction only when sphericity is not assumed (Mauchly p < 0.05) if(correction.method == "auto"){ corrections %<>% filter(sphericity$p <= 0.05) } if(nrow(corrections) > 0){ rownames(res.aov) <- res.aov$Effect rownames(corrections) <- corrections$Effect cols.to.update <- c("DFn", "DFd", "p", "p<.05") rows.to.update <- rownames(corrections) res.aov[rows.to.update, cols.to.update] <- corrections[rows.to.update, cols.to.update] rownames(res.aov) <- 1:nrow(res.aov) } res.aov <- res.aov %>% set_attrs(args = .args) class(res.aov) <- c("anova_test", class(res.aov), "rstatix_test") res.aov } get_anova_table_from_grouped_test <- function(x, correction = "auto"){ if(!is_grouped_anova_test(x)){ return(x) } extract_table <- function(x, correction){ get_anova_table_from_simple_test(x, correction = correction) %>% remove_class(c("anova_test", "rstatix_test")) } x %>% keep_only_tbl_df_classes() %>% mutate(anova = map(.data$anova, extract_table, correction = correction)) %>% unnest(cols = "anova") } is_anova_test <- function(x){ inherits(x, "anova_test") } is_grouped_anova_test <- function(x){ answer <- FALSE if(("anova" %in% colnames(x))){ if(inherits(x$anova, "list")){ answer <- inherits(x$anova[[1]], "anova_test") } } answer } # Printing anova and plotting model diagnostic ----------------------------------------------- #' @rdname anova_test #' @method print anova_test #' @param ... additional arguments #' @export print.anova_test <- function(x, ...) { .args <- attr(x, "args") type <- switch(.args$type, `1` = "I", `2` = "II", `3` = "III") cat("ANOVA Table (type", type, "tests)\n\n") if(inherits(x, "data.frame")) print.data.frame(x) else if(inherits(x, "list")){ attr(x, "args") <- NULL class(x) <- "list" print(x) } } #' @rdname anova_test #' @method plot anova_test #' @export plot.anova_test <- function(x, ...) { .args <- attr(x, "args") graphics::plot(.args$model, ...) } # Check arguments ----------------------------------------------- # Check the arguments of ANOVA # .args is a list check_anova_arguments <- function(.args){ if(!is.null(.args$formula)){ .args <- get_anova_vars_from_formula(.args) if(is.null(.args$within)) .args$model <- fit_lm(.args) } if(inherits(.args$data, "aovlist")){ stop("A model of class aovlist is not supported.") } else if(has_model(.args)){ if(is.null(.args$type)) .args$type <- 2 return(.args) } .args <- .args %>% check_factorial_design() %>% check_anova_type() .args } get_anova_vars_from_formula <- function(.args){ formula <- .args$formula data <- .args$data vars <- all.vars(formula) stop_if_multiple_error_terms(formula) # Detect transformed responses: lhs <- all.names(formula[[2]]) transf <- setdiff(lhs, all.vars(formula[[2]])) if (length(transf) == 0) transf = NULL if (!is.null(transf)) { origdv <- setdiff(lhs, transf) dv <- paste0(transf[1], ".", origdv) data[[dv]] <- eval(formula[[2]], envir = data) # add transformed version vars <- vars[!(vars %in% lhs)] }else { dv <- vars[1] vars <- vars[-1] } error.vars <- get_formula_error_vars(formula) id <- error.vars[1] within <- error.vars[-1] between <- vars[!(vars %in% c(id, within))] if(length(within) == 0) within <- NULL if(length(between) == 0) between <- NULL if(is.na(id)) id <- NULL .args <- .args %>% .add_item(data = data, dv = dv, wid = id, between = between, within = within) .args } stop_if_multiple_error_terms <- function(formula){ .terms <- stats::terms(formula, "Error") .error.terms <- attr(.terms, "specials")$Error if (length(.error.terms) > 1L) stop(sprintf("there are %d Error terms: only 1 is allowed", length(.error.terms))) } # stop if ancova with repeated variables stop_if_repeated_ancova <- function(.args){ if(is_repeated_ancova(.args) | is_mixed_ancova(.args)){ stop("Don't support ANCOVA with repeated measures") } .args } # Check anova design and type is_design_balanced <- function(.args){ res <- .args$data %>% group_by(!!!syms(.args$between)) %>% summarise(count = n()) length(unique(res$count)) == 1 } is_repeated_anova <- function(.args){ is.null(.args$between) & !is.null(.args$within) & is.null(.args$covariate) } is_independent_anova <- function(.args){ !is.null(.args$between) & is.null(.args$within) & is.null(.args$covariate) } is_mixed_anova <- function(.args){ !is.null(.args$between) & !is.null(.args$within) & is.null(.args$covariate) } is_repeated_ancova <- function(.args){ !is.null(.args$within) & !is.null(.args$covariate) & is.null(.args$between) } is_independent_ancova <- function(.args){ is.null(.args$within) & !is.null(.args$covariate) & !is.null(.args$between) } is_mixed_ancova <- function(.args){ !is.null(.args$between) & !is.null(.args$within) & !is.null(.args$covariate) } # Check anova type check_anova_type <- function(.args){ n.vars <- length(c(.args$between, .args$within)) if(is.null(.args$type)){ .args$type <- 2 if(is_repeated_anova(.args)) .args$type <- 3 else if(!is.null(.args$between)) { if(!is_design_balanced(.args) & n.vars > 1) .args$type <- 3 } } else if (.args$type == 1){ if(!is_design_balanced(.args) & n.vars > 1){ warning("Your data are unbalanced and there are more than one variable. ", "In this case, using 'type = 1' is not recommended. ", "Consider using type 3 ANOVA.", immediate.=TRUE, call.=FALSE) } } .args } is_model <- function(object){ models <- c("lm", "aov", "glm", "multinom", "polr", "mlm", "manova") inherits(object, models) } # Get anova model from the list of arguments get_anova_model <- function(.args){ if(!is.null(.args$model)) return(.args$model) else if(is_model(.args$data)) return(.args$data) else stop("No model detected in ANOVA arguments") } # Check if ANOVA arguments contain model has_model <- function(.args){ !is.null(.args$model) | is_model(.args$data) } # Fit lm from formula and data ------------------------------------ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% fit_lm <- function(.args){ .args <- remove_missing_values_in_data(.args) lm_data <- droplevels(.args$data) lm_formula <- .args$formula opt <- options( "contrasts" = c( "contr.sum", "contr.poly" ) ) results <- stats::lm(lm_formula, lm_data) options(opt) results } # Compute the different types of ANOVA ----------------------------- #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% car_anova <- function(.args, ...){ if(has_model(.args)){ .model <- get_anova_model(.args) res.anova <- suppressMessages(car::Anova( .model, type = .args$type, white.adjust = .args$white.adjust, ... )) .args$model <- .model } else{ design <- factorial_design( data = .args$data, dv = .args$dv, wid = .args$wid, between = .args$between, within = .args$within, covariate = .args$covariate ) if(is_independent_anova(.args)){ res.anova <- suppressMessages(Anova( design$model, type = .args$type, white.adjust = .args$white.adjust, ... )) } else{ res.anova <- suppressMessages(Anova( design$model, idata = design$idata, idesign = design$idesign, type = .args$type, ... )) } .args$model <- design$model } attr(res.anova, "args") <- .args res.anova } # R stats aov stats_aov <- function(.args){ if(has_model(.args)){ .model <- get_anova_model(.args) res.anova <- stats::aov(.model) } else{ aov.formula <- create_aov_formula(.args) data <- .args$data res.anova <- .model <- stats::aov(aov.formula, data) } .args$model <- .model attr(res.anova, "args") <- .args res.anova } create_aov_formula <- function(.args){ between <- paste(.args$between, collapse = "*") within <- paste(.args$within, collapse = "*") covariate <- paste(.args$covariate, collapse = "+") error <- ifelse( within != "", error <- paste0("+Error(", .args$wid, "/(", within, "))"), "" ) bw.sep <- ifelse(between != "" & within != "", "*", "") # Between and Within vars separator bc.sep <- ifelse(covariate != "", "+", "") # Between and covariate vars separator .formula <- paste0(.args$dv, " ~ ", covariate, bc.sep, between, bw.sep, within, error) %>% stats::as.formula() .formula } # Check assumptions (Not used helpers)------------------------- check_anova_assumptions <- function(data, dv, between){ . <- NULL outliers <- data %>% group_by(!!!syms(between)) %>% identify_outliers(!!dv) groups.normality <- data %>% group_by(!!!syms(between)) %>% shapiro_test(vars = dv) formula <- paste(between, collapse = "*") %>% paste(dv, ., sep = " ~ ") %>% stats::as.formula() model <- stats::lm(formula, data) .residuals <- stats::residuals(model) variance.homogeneity <- levene_test(data, formula) arguments <- list( dv = dv, between = between) results <- list( outliers = outliers, residuals.normality = shapiro_test(.residuals), groups.normality = groups.normality, variance.homogeneity = variance.homogeneity ) %>% set_attrs(arguments = arguments) results } check_repeated_anova_assumptions <- function(data, dv, wid, within){ . <- NULL results <- check_anova_assumptions(data, dv, within) results$variance.homogeneity <- NULL arguments <- list( dv = dv, wid = wid, within = within) results <- results %>% set_attrs(arguments = arguments) within <- paste(within, collapse = ", ") %>% paste0("c(", ., ")") data.name <- deparse(substitute(data)) anova.formula <- paste0( "anova_test(", data.name, ", dv = ", dv, ", wid = ", wid, ", within = ", within, ")" ) res.anova <- eval(parse(text = anova.formula)) results <- results %>% .add_item(sphericity = res.anova$`Mauchly's Test for Sphericity`) results } check_mixed_anova_assumptions <- function(data, dv, wid , between, within){ . <- NULL arguments <- list( dv = dv, wid = wid, between = between, within = within) grouping <- c(between, within) outliers <- data %>% group_by(!!!syms(grouping)) %>% identify_outliers(!!dv) groups.normality <- data %>% group_by(!!!syms(grouping)) %>% shapiro_test(vars = dv) formula <- paste(between, collapse = "*") %>% paste(dv, ., sep = " ~ ") %>% stats::as.formula() variance.homogeneity <- data %>% group_by(!!!syms(within)) %>% levene_test(formula) results <- list( outliers = outliers, groups.normality = groups.normality, variance.homogeneity = variance.homogeneity ) %>% set_attrs(arguments = arguments) within <- paste(within, collapse = ", ") %>% paste0("c(", ., ")") between <- paste(between, collapse = ", ") %>% paste0("c(", ., ")") data.name <- deparse(substitute(data)) anova.formula <- paste0( "anova_test(", data.name, ", dv = ", dv, ", wid = ", wid, ", within = ", within, ", between = ", between, ")" ) res.anova <- eval(parse(text = anova.formula)) results <- results %>% .add_item(sphericity = res.anova$`Mauchly's Test for Sphericity`) results } rstatix/R/get_test_label.R0000644000176200001440000004170115074310430015251 0ustar liggesusers#' @include utilities.R NULL #' Extract Label Information from Statistical Tests #' @description Extracts label information from statistical tests. Useful for #' labelling plots with test outputs. #' @param stat.test statistical test results returned by \code{rstatix} #' functions. #' @param description the test description used as the prefix of the label. #' Examples of description are "ANOVA", "Two Way ANOVA". To remove the default #' description, specify \code{description = NULL}. If missing, we'll try to #' guess the statistical test default description. #' @param p.col character specifying the column containing the p-value. Default #' is \code{"p"}, can be \code{"p.adj"}. #' @param type the label type. Can be one of "text" and "expression". Partial #' match allowed. If you want to add the label onto a ggplot, it might be #' useful to specify \code{type = "expresion"}. #' @param correction character, considered only in the case of ANOVA test. Which sphericity #' correction of the degrees of freedom should be reported for the #' within-subject factors (repeated measures). The default is set to #' \code{"GG"} corresponding to the Greenhouse-Geisser correction. Possible #' values are \code{"GG"}, \code{"HF"} (i.e., Hyunh-Feldt correction), #' \code{"none"} (i.e., no correction) and \code{"auto"} (apply automatically #' GG correction if the sphericity assumption is not for within-subject #' design. #' @param row numeric, the row index to be considered. If NULL, the last row is #' automatically considered for ANOVA test. #' @param statistic.text character specifying the test statistic. For example #' \code{statistic.text = "F"} (for ANOVA test ); \code{statistic.text = "t"} #' (for t-test ). #' @param statistic the numeric value of a statistic. #' @param p the p-value of the test. #' @param parameter string containing the degree of freedom (if exists). Default #' is \code{NA} to accommodate non-parametric tests. For example #' \code{parameter = "1,9"} (for ANOVA test. Two parameters exist: DFn and #' DFd); \code{sparameter = "9"} (for t-test ). #' @param n sample count, example: \code{n = 10}. #' @param effect.size the effect size value #' @param effect.size.text a character specifying the relevant effect size. For #' example, for \code{Cohens d} statistic, \code{effect.size.text = "d"}. You #' can also use plotmath expression as follow \code{quote(italic("d"))}. #' @param detailed logical value. If TRUE, returns detailed label. #' @return a text label or an expression to pass to a plotting function. #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # One-way ANOVA test #' #::::::::::::::::::::::::::::::::::::::::: #' anov <- df %>% anova_test(len ~ dose) #' get_test_label(anov, detailed = TRUE, type = "text") #' #' # Two-way ANOVA test #' #::::::::::::::::::::::::::::::::::::::::: #' anov <- df %>% anova_test(len ~ supp*dose) #' get_test_label(anov, detailed = TRUE, type = "text", #' description = "Two Way ANOVA") #' #' #' # Kruskal-Wallis test #' #::::::::::::::::::::::::::::::::::::::::: #' kruskal<- df %>% kruskal_test(len ~ dose) #' get_test_label(kruskal, detailed = TRUE, type = "text") #' #' # Wilcoxon test #' #::::::::::::::::::::::::::::::::::::::::: #' # Unpaired test #' wilcox <- df %>% wilcox_test(len ~ supp) #' get_test_label(wilcox, detailed = TRUE, type = "text") #'# Paired test #' wilcox <- df %>% wilcox_test(len ~ supp, paired = TRUE) #' get_test_label(wilcox, detailed = TRUE, type = "text") #' #' # T test #' #::::::::::::::::::::::::::::::::::::::::: #' ttest <- df %>% t_test(len ~ dose) #' get_test_label(ttest, detailed = TRUE, type = "text") #' #' #' # Pairwise comparisons labels #' #::::::::::::::::::::::::::::::::::::::::: #' get_pwc_label(ttest, type = "text") #' #' #' # Create test labels #' #::::::::::::::::::::::::::::::::::::::::: #' create_test_label( #' statistic.text = "F", statistic = 71.82, #' parameter = "4, 294", #' p = "<0.0001", #' description = "ANOVA", #' type = "text" #' ) #' #' #' # Extract infos #' #::::::::::::::::::::::::::::::::::::::::: #' stat.test <- df %>% t_test(len ~ dose) #' get_n(stat.test) #' get_description(stat.test) #' #' #' @describeIn get_test_label Extract label from pairwise comparisons. #' @export get_pwc_label <- function(stat.test, type = c("expression", "text")){ methods <- get_pairwise_comparison_methods() stat.test %>% stop_ifnot_class(names(methods)) type <- match.arg(type) args <- attr(stat.test, "args") stat.method <- methods[args$method] p.adjust.method <- args$p.adjust.method %>% to_uppercase_first_letter() if(! "p.adj" %in% colnames(stat.test)){ p.adjust.method <- "None" } if(type == "text"){ paste0("pwc: ", stat.method, "; p.adjust: ", p.adjust.method) } else if(type == "expression"){ substitute( expr = paste( "pwc: ", bold(stat.method), "; p.adjust: ", bold(p.adjust.method) ), env = list(stat.method = stat.method, p.adjust.method = p.adjust.method) ) } } #' @describeIn get_test_label Extract labels for statistical tests. #' @export get_test_label <- function(stat.test, description = NULL, p.col = "p", type = c("expression", "text"), correction = c("auto", "GG", "HF", "none"), row = NULL, detailed = FALSE){ type = match.arg(type) allowed.tests <- c( get_pairwise_comparison_methods(), kruskal_test = "Kruskal-Wallis", friedman_test = "Friedman test", anova_test = "Anova", welch_anova_test = "Welch ANOVA", chisq_test = "Chi-square test", exact_multinom_test = "Exact multinomial test", exact_binom_test = "Exact binomial test", cochran_qtest = "Cochran Q test", chisq_trend_test = "Chi-square trend test" ) stop_ifnot_class(stat.test, .class = names(allowed.tests)) is_anova_test <- inherits(stat.test, "anova_test") if(is_anova_test){ stat.test <- get_anova_table(stat.test, correction = correction) if(is.null(row)) row <- nrow(stat.test) # consider the last row } if(!is.null(row)) { stat.test <- stat.test %>% keep_only_tbl_df_classes() %>% dplyr::slice(row) } statistic.text <- get_statistic_text(stat.test, type = type) statistic <- get_statistic(stat.test) df <- get_df(stat.test) n <- get_n(stat.test) effect <- get_effect_size(stat.test, type) effect.size <- effect$value effect.size.text <- effect$text if(missing(description)){ description <- get_description(stat.test) } if(!is.null(description)){ if(description != ""){ description <- paste0(description, ", ") } } if(!(p.col %in% colnames(stat.test))){ # automatic detection of p.col p.col <- p_detect(stat.test) } stat.test <- stat.test %>% keep_only_tbl_df_classes() %>% select(!!sym(p.col)) %>% rename(p = p.col) %>% mutate( row.id = 1:nrow(stat.test), n = n, statistic = statistic, parameter = df, effect.size = effect.size ) if(is.numeric(stat.test$p)){ stat.test$p <- p_format(stat.test$p, 3) } get_label_func <- switch ( type, expression = create_test_label.expression, text = create_test_label.text ) get_label_func_df <- function(df){ get_label_func( description, statistic.text = statistic.text, statistic = df$statistic, parameter = df$parameter, p = df$p, n = df$n, effect.size = df$effect.size, effect.size.text = effect.size.text, detailed = detailed ) } if(nrow(stat.test) > 1){ results <- stat.test %>% group_by(.data$row.id) %>% doo(get_label_func_df) %>% pull(.data$.results.) } else{ results <- get_label_func_df(stat.test) } results } #' @describeIn get_test_label Create labels from user specified test results. #' @export create_test_label <- function( statistic.text, statistic, p, parameter = NA, description = NULL, n = NA, effect.size = NA, effect.size.text = NA, type = c("expression", "text"), detailed = FALSE) { type <- match.arg(type) if(!is.null(description)){ if(description != ""){ description <- paste0(description, ", ") } } else description <- "" label_func <- switch( type, text = create_test_label.text, expression = create_test_label.expression, create_test_label.text ) label_func( description = description, statistic.text = statistic.text, statistic = statistic, parameter = parameter, p = p, n = n, effect.size = effect.size, effect.size.text = effect.size.text, detailed = detailed ) } # Build test labeles #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # description: stat test description, e.g "T test" # statistic.text: statistic text, example: "t", # statistic: statistic value, example: 10 # parameter: string containing the degree of freedom, # ex: "9" for t-test or "1,9" for ANOVA (DFn = 1 and DFd = 9) # p: p value # n: sample count create_test_label.expression <- function( description, statistic.text, statistic, parameter, p, n = NA, effect.size = NA, effect.size.text = NA, detailed = FALSE) { if(is.na(parameter)) parameter <- "" else parameter <- paste0("(", parameter, ")") # Sample count if(is.na(n)) { n <- "" } else{ n <- substitute( expr = paste(", ", italic("n"), " = ", n), env = list(n = n) ) } # Effect size if(is.na(effect.size)){ effect.size <- "" } else{ effect.size <- round_value(effect.size, 2) effect.size <- substitute( expr = paste(", ", effect.size.text, " = ", effect.size), env = list(effect.size.text = effect.size.text, effect.size = effect.size) ) } # Create label statistic <- round_value(statistic, 2) equal <- " = " if(is.na(statistic)) statistic.text <- equal <- statistic <- "" else statistic <- paste0(statistic, ", ") env <- as.list(environment()) if(detailed){ substitute( expr = paste( description, statistic.text, parameter, equal, statistic, italic("p"), " = ", p, effect.size, n ), env = env ) } else{ substitute( expr = paste(description, italic("p"), " = ", p), env = env ) } } create_test_label.text <- function(description, statistic.text, statistic, parameter, p, n = NA, effect.size = NA, effect.size.text = NA, detailed = FALSE){ if(is.na(parameter)) parameter <- "" else parameter <- paste0("(", parameter, ")") if(is.na(effect.size)) effect.size <- "" else effect.size <- paste0(", ", effect.size.text, " = ", effect.size) if(is.na(n)) n <- "" else n <- paste0(", ", "n", " = ", n) if(!is.na(statistic)){ statistics <- paste0(statistic.text, parameter, " = ", round_value(statistic, 2), ", ") } else statistics <- "" if(detailed){ paste0( description, statistics, "p", " = ", p, effect.size, n ) } else{ paste0(description, "p = ", p) } } # Get label parameters # %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Statical test text: F, t, W, V, X2, ------------------------------------------- get_statistic_text <- function(stat.test, type = c("expression", "text")){ type <- match.arg(type) args <- attr(stat.test, "args") stat.method <- args$method is.paired <- args$paired if(!is.null(is.paired)){ if(is.paired & stat.method == "wilcox_test"){ stat.method = "wilcox_test_paired" } } if(is.null(is.paired)) is.paired <- FALSE if(type == "expression"){ statistic.text <- switch( stat.method, t_test = quote(italic("t")), wilcox_test = quote(italic("W")), wilcox_test_paired = quote(italic("V")), sign_test = quote(italic("S")), dunn_test = quote(italic("Z")), emmeans_test = quote(italic("t")), tukey_hsd = quote(italic("t")), games_howell_test = quote(italic("t")), kruskal_test = quote(italic(chi)^2), friedman_test = quote(italic(chi)^2), anova_test = quote(italic("F")), welch_anova_test = quote(italic("F")), chisq_test = quote(italic(chi)^2), mcnemar_test = quote(italic(chi)^2), prop_test = quote(italic(chi)^2), cochran_qtest = quote(italic(chi)^2), chisq_trend_test = quote(italic(chi)^2), quote(italic("Stat")) ) } else{ statistic.text <- switch( stat.method, t_test = "t", wilcox_test = "W", wilcox_test_paired = "V", sign_test = "S", dunn_test = "Z", emmeans_test = "t", tukey_hsd = "t", games_howell_test = "t", kruskal_test = "X2", friedman_test = "X2", anova_test = "F", welch_anova_test = "F", chisq_test = "X2", mcnemar_test = "X2", prop_test = "X2", cochran_qtest = "X2", chisq_trend_test = "X2", "Stat" ) } statistic.text } # Statistic values ------------------------------------------------- get_statistic <- function(stat.test){ stat.cols <- colnames(stat.test) if("statistic" %in% stat.cols){ result <- stat.test$statistic } else if ("F" %in% stat.cols){ result <- stat.test$F } else{ # statistic column not found result <- rep(NA, nrow(stat.test)) } result } # Degree of freedom------------------------------------------------- get_df <- function(stat.test){ args <- attr(stat.test, "args") df.cols <- c("df", "DFn", "DFd") if(!any(df.cols %in% colnames(stat.test))){ return(NA) } if(all(c("DFn", "DFd") %in% colnames(stat.test))){ dfn <- round_value(stat.test$DFn, 2) dfd <- round_value(stat.test$DFd, 2) df <- paste(dfn, dfd, sep = ",") } else{ df <- round_value(stat.test$df, 2) } df } # Sample count------------------------------------------------- #' @describeIn get_test_label Extracts sample counts (n) from an rstatix test outputs. Returns a numeric vector. #' @export get_n <- function(stat.test){ if(inherits(stat.test, "anova_test")){ .args <- attr(stat.test, "args") wid <- .args$wid if(is.null(wid)) n <- nrow(.args$data) else n <- .args$data %>% pull(!!wid) %>% unique() %>% length() stat.test$n <- n } else if(inherits(stat.test, "grouped_anova_test")){ # compute sample size of data subsets .args <- attr(stat.test, "args") stat.test$n <- .args$data %>% dplyr::summarise(n = dplyr::n()) %>% pull(.data$n) } n.cols <- c("n", "n1", "n2") if(!any(n.cols %in% colnames(stat.test))){ return(NA) } if("n" %in% colnames(stat.test)){ n <- stat.test$n } else if(all(c("n1", "n2") %in% colnames(stat.test))){ if(is_paired(stat.test)) n <- stat.test$n1 else n <- stat.test$n1 + stat.test$n2 } n } # Statistical test description --------------------------------- #' @describeIn get_test_label Extracts the description of an rstatix test outputs. Returns a character vector. #' @export get_description <- function(stat.test){ tests <- c( t_test = "T test", wilcox_test = "Wilcoxon test", sign_test = "Sign test", dunn_test = "Dunn test", emmeans_test = "Emmeans test", tukey_hsd = "Tukey HSD", anova_test = "Anova", welch_anova_test = "Welch Anova", kruskal_test = "Kruskal-Wallis", friedman_test = "Friedman test", cor_test = "Correlation", prop_test = "Z-Prop test", fisher_test = "Fisher's exact test", chisq_test = "Chi-square test", exact_multinom_test = "Exact multinomial test", exact_binom_test = "Exact binomial test", mcnemar_test = "McNemar test", cochran_qtest = "Cochran Q test", chisq_trend_test = "Chi-square trend test" ) args <- attr(stat.test, "args") if(is.null(args)) return("") stat.method <- args$method if(stat.method %in% names(tests)){ description <- tests[stat.method] } else{ description <- stat.method } as.character(description) } # Efect size --------------------------------- get_effect_size <- function(stat.test, type = "text"){ stat.method <- attr(stat.test, "args")$method value <- text <- NA if("ges" %in% colnames(stat.test)) { value <- stat.test$ges if(type == "expression") text <- quote(eta["g"]^2) else text <- "eta2[g]" } else if("pes" %in% colnames(stat.test)) { if(type == "expression") text <- quote(eta["p"]^2) else text <- "eta2[p]" value <- stat.test$pes } else if("effsize" %in% colnames(stat.test)){ value <- stat.test$effsize if(type == "expression"){ text <- switch( stat.method, t_test = quote(italic("d")), wilcox_test = quote(italic("r")), kruskal_test = quote(eta["H"]^2), friedman_test = quote(italic("W")["Kendall"]), quote(italic("effsize")) ) } else{ text <- switch( stat.method, t_test = "d", wilcox_test = "r", kruskal_test = "eta2[H]", friedman_test = "W[Kendall]", "effsize" ) } } list(value = value, text = text) } # Check if paired stat test-------------------------------------------- is_paired <- function(stat.test){ args <- attr(stat.test, "args") is.paired <- args$paired if(is.null(is.paired)) is.paired <- FALSE is.paired } rstatix/R/p_value.R0000644000176200001440000002142715074310430013732 0ustar liggesusers#' @include utilities.R NULL #'Rounding and Formatting p-values #' #'@description Round and format p-values. Can also mark significant p-values with stars. #'@param x a numeric vector of p-values or a data frame containing a p value #' column. If data frame, the p-value column(s) will be automatically detected. #' Known p-value column names can be obtained using the functions #' \code{p_names()} and \code{p_adj_names()} #'@param digits the number of significant digits to be used. #'@param accuracy number to round to, that is the threshold value above wich the #' function will replace the pvalue by "<0.0xxx". #'@param decimal.mark the character to be used to indicate the numeric decimal #' point. #'@param leading.zero logical. If FALSE, remove the leading zero. #'@param trailing.zero logical. If FALSE (default), remove the training extra #' zero. #'@param space logical. If TRUE (default) use space as separator between #' different elements and symbols. #'@param cutpoints numeric vector used for intervals #'@param symbols character vector, one shorter than cutpoints, used as #' significance symbols. #'@param add.p logical value. If TRUE, add "p=" before the value. #'@param ... column names to manipulate in the case where \code{x} is a data #' frame. P value columns are automatically detected if not specified. #'@param new.col logical, used only when \code{x} is a data frame. If TRUE, add #' a new column to hold the results. The new column name is created by adding, #' to the p column, the suffix "format" (for \code{p_format()}), "signif" (for #' \code{p_mak_significant()}). #'@return a vector or a data frame containing the rounded/formatted p-values. #' @examples #' #' # Round and format a vector of p-values #' # :::::::::::::::::::::::::::::::::::::::::::: #' # Format #' p <- c(0.5678, 0.127, 0.045, 0.011, 0.009, 0.00002, NA) #' p_format(p) #' #'# Specify the accuracy #' p_format(p, accuracy = 0.01) #' #' # Add p and remove the leading zero #' p_format(p, add.p = TRUE, leading.zero = FALSE) #' #' # Remove space before and after "=" or "<". #' p_format(p, add.p = TRUE, leading.zero = FALSE, space = FALSE) #' #' # Mark significant p-values #' # :::::::::::::::::::::::::::::::::::::::::::: #' p_mark_significant(p) #' #' # Round, the mark significant #' p %>% p_round(digits = 2) %>% p_mark_significant() #' #' # Format, then mark significant #' p %>% p_format(digits = 2) %>% p_mark_significant() #' #' # Perform stat test, format p and mark significant #' # :::::::::::::::::::::::::::::::::::::::::::: #' ToothGrowth %>% #' group_by(dose) %>% #' t_test(len ~ supp) %>% #' p_format(digits = 2, leading.zero = FALSE) %>% #' p_mark_significant() #' #'@describeIn p_value round p-values #'@export p_round <- function(x, ..., digits = 3){ if(is.numeric(x)){ round_value(x, digits = digits) } else if(is.data.frame(x)){ p_round_at(x, ..., digits = digits) } else{ stop("x should be a numeric vector or a data frame") } } #' @describeIn p_value format p-values. Add a symbol "<" for small p-values. #' @export p_format <- function(x, ..., new.col = FALSE, digits = 2, accuracy = 0.0001, decimal.mark = ".", leading.zero = TRUE, trailing.zero = FALSE, add.p = FALSE, space = FALSE){ if(is.data.frame(x)){ .attributes <- attributes(x) res <- x %>% keep_only_tbl_df_classes() %>% p_format_at( ..., new.col = new.col, digits = digits, accuracy = accuracy, decimal.mark = decimal.mark, leading.zero = leading.zero, trailing.zero = trailing.zero, add.p = add.p, space = space ) .attributes$names <- colnames(res) attributes(res) <- .attributes return(res) } res <- format.pval( pv = x, digits = digits, eps = accuracy, # nsmall = how much tails 0 to keep if digits of # original value < to digits defined nsmall = 0 ) res <- gsub(pattern = " ", replacement = "", res, fixed = TRUE) res <- gsub("<1e-04", "<0.0001", res) if(!leading.zero) res <- remove_leading_zero(res) if(!trailing.zero) res <- remove_trailing_zero(res) if(!missing(decimal.mark)) res <- gsub("\\.", decimal.mark, res) if(add.p){ contain.inf.symbol <- grepl("<", res) res2 <- paste0("p", "=", res) if(sum(contain.inf.symbol) > 0){ # no need to add = res2[contain.inf.symbol] <- paste0("p", res[contain.inf.symbol]) } res <- res2 } if(space){ if(add.p) res <- gsub(pattern = "(=|<)", replacement = " \\1 ", x = res) else res <- gsub(pattern = "(=|<)", replacement = "\\1 ", x = res) } res } #' @describeIn p_value mark p-values with significance levels #' @export p_mark_significant <- function(x, ..., new.col = FALSE, cutpoints = c(0, 1e-04, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "")){ if(is.data.frame(x)){ .attributes <- attributes(x) res <- x %>% keep_only_tbl_df_classes() %>% p_mark_significant_at( ..., new.col = new.col, cutpoints = cutpoints, symbols = symbols ) attributes(res) <- .attributes return(res) } contains.leading.zero <- TRUE is.char.x <- is.character(x) if(is.char.x){ contains.leading.zero <- p_contains_leading_zero(x) leading.character <- replace_number(x, "") leading.character <- gsub("NA", "", leading.character) x <- extract_number(x) } x <- tibble(p = x) %>% add_significance("p", cutpoints = cutpoints, symbols = symbols) %>% mutate(.signif = paste0(.data$p, .data$p.signif)) %>% pull(".signif") if(!contains.leading.zero) x <- remove_leading_zero(x) if(is.char.x) x <- paste(leading.character, x, sep = "") x <- gsub("NA?", "NA", x, fixed = TRUE) x <- gsub("<1e-04", "<0.0001", x, fixed = TRUE) x } #' @describeIn p_value detects and returns p-value column names in a data frame. #' @param data a data frame #' @param type the type of p-value to detect. Can be one of \code{c("all", "p", "p.adj")}. #' @export p_detect <- function(data, type = c("all", "p", "p.adj")){ type <- match.arg(type) p.cols <- switch (type, all = c(p_adj_names(), p_names()), p = p_names(), p.adj = p_adj_names() ) existing.p.cols <- intersect(p.cols, colnames(data)) if(.is_empty(existing.p.cols)) existing.p.cols <- NULL existing.p.cols } #' @describeIn p_value returns known p-value column names #' @export p_names <- function(){ c("p", "pval", "pvalue", "p.val", "p.value") } #' @describeIn p_value returns known adjust p-value column names #' @export p_adj_names <- function(){ p_names() %>% paste0(".adj") } # Rounding specified columns p_round_at <- function(data, ..., digits = 3){ p.cols <- p_select(data, ...) if(!is.null(p.cols)){ data %<>% dplyr::mutate_at(rlang::quos(p.cols), round_value, digits = digits) } data } # Formatting (specified) p value columns p_format_at <- function(data, ..., new.col = FALSE, digits = 2, accuracy = 0.0001, decimal.mark = ".", leading.zero = TRUE, trailing.zero = FALSE, add.p = FALSE, space = TRUE){ mutate_func <- dplyr::mutate_at if(new.col) mutate_func <- dplyr::transmute_at results <- data p.cols <- p_select(data, ...) if(!is.null(p.cols)){ results <- results %>% mutate_func( p.cols, p_format, digits = digits, accuracy = accuracy, decimal.mark = decimal.mark, leading.zero = leading.zero, trailing.zero = trailing.zero, add.p = add.p, space = space ) if(new.col){ colnames(results) <- paste0(p.cols, ".format") results <- dplyr::bind_cols(data, results) } } results } # Mark significant at a specified column p_mark_significant_at <- function(data, ..., new.col = FALSE, cutpoints = c(0, 1e-04, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "")){ mutate_func <- dplyr::mutate_at if(new.col) mutate_func <- dplyr::transmute_at results <- data p.cols <- p_select(data, ...) if(!is.null(p.cols)){ results %<>% mutate_func( p.cols, p_mark_significant, cutpoints = cutpoints, symbols = symbols ) if(new.col){ colnames(results) <- paste0(p.cols, ".signif") results <- dplyr::bind_cols(data, results) } } results } # Manipulating leading zero----------------------------- # Check if formatted p-values contain leading zero p_contains_leading_zero <- function(p){ any(grepl(pattern = "0.", p, fixed = TRUE)) } remove_leading_zero <- function(x){ sapply(x, function(x){ sub("^([-|<|=|>]?)0[.]", "\\1.", x)}) %>% as.character() } remove_trailing_zero <- function(x){ gsub("\\.?0+$", "", x) } # Select p-value columns: p and p.adj ----------------------- p_select <- function(data, ...){ p.col <- get_existing_dot_vars(data, ...) if(is.null(p.col) | .is_empty(p.col)){ p.col <- p_detect(data, type = "all") } p.col } rstatix/R/get_comparisons.R0000644000176200001440000000357115074310430015473 0ustar liggesusers#' @include utilities.R NULL #'Create a List of Possible Comparisons Between Groups #'@description Create a list of possible pairwise comparisons between groups. If #' a reference group is specified, only comparisons against reference will be #' kept. #'@param data a data frame #'@param variable the grouping variable name. Can be unquoted. #'@param ref.group a character string specifying the reference group. Can be #' unquoted. If numeric, then it should be quoted. If specified, for a #' given grouping variable, each of the group levels will be compared to the #' reference group (i.e. control group). #' #' If \code{ref.group = "all"}, pairwise comparisons are performed between each #' grouping variable levels against all (i.e. basemean). #'@return a list of all possible pairwise comparisons. #'@examples #' # All possible pairwise comparisons #' ToothGrowth %>% #' get_comparisons("dose") #' #' # Comparisons against reference groups #' ToothGrowth %>% #' get_comparisons("dose", ref.group = "0.5") #' #' # Comparisons against all (basemean) #' ToothGrowth %>% #' get_comparisons("dose", ref.group = "all") #'@export get_comparisons <- function(data, variable, ref.group = NULL){ data <- droplevels(data) group <- rlang::enquo(variable) %>% rlang::as_name() ref.group <- rlang::enquo(ref.group) if(rlang::quo_is_null(ref.group)) ref.group <- NULL else ref.group <- rlang::as_name(ref.group) group.levels <- data %>% .as_factor(group) %>% get_levels(group) asserttat_ref_group_iscorrect(group.levels, ref.group) comparisons <- c(ref.group, group.levels) %>% unique() %>% .possible_pairs(ref.group = ref.group) %>% map(as.character) comparisons } asserttat_ref_group_iscorrect <- function(.levels, .ref){ if(!is.null(.ref)){ .diff <- setdiff(.ref, c("all", ".all.", .levels)) if(!.is_empty(.diff)) stop("ref.group is incorrect") } } rstatix/R/friedman_test.R0000644000176200001440000000555115074310430015123 0ustar liggesusers#' @include utilities.R NULL #'Friedman Rank Sum Test #' #' #'@description Provides a pipe-friendly framework to perform a Friedman rank sum #' test, which is the non-parametric alternative to the one-way repeated #' measures ANOVA test. Wrapper around the function #' \code{\link[stats]{friedman.test}()}. Read more: #' \href{https://www.datanovia.com/en/lessons/friedman-test-in-r/}{Friedman #' test in R}. #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{a ~ b | c}, where \code{a} #' (numeric) is the dependent variable name; \code{b} is the within-subjects #' factor variables; and \code{c} (factor) is the column name containing #' individuals/subjects identifier. Should be unique per individual. #'@param ... other arguments to be passed to the function #' \code{\link[stats]{friedman.test}}. #' #'@return return a data frame with the following columns: \itemize{ \item #' \code{.y.}: the y (dependent) variable used in the test. \item \code{n}: #' sample count. \item \code{statistic}: the value of Friedman's chi-squared #' statistic, used to compute the p-value. \item \code{p}: p-value. \item #' \code{method}: the statistical test used to compare groups.} #' #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth %>% #' filter(supp == "VC") %>% #' mutate(id = rep(1:10, 3)) #' head(df) #' #' # Friedman rank sum test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% friedman_test(len ~ dose | id) #' #'@name friedman_test #'@export friedman_test <- function(data, formula, ...){ args <- c(as.list(environment()), list(...)) %>% add_item(method = "friedman_test") vars <- get_friedman_vars(formula) args <- args %>% add_item(dv = vars$dv, wid = vars$wid, within = args$within) if(is_grouped_df(data)){ results <- data %>% doo(.friedman_test, formula, ...) } else{ results <- .friedman_test(data, formula, ...) } results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "friedman_test")) } .friedman_test <- function(data, formula, ...){ vars <- get_friedman_vars(formula) term <- statistic <- p <- df <- method <- NULL sample.size <- data %>% pull(vars$wid) %>% unique() %>% length() res <- stats::friedman.test(formula, data = data, ...) %>% tidy() %>% rename(p = .data$p.value, df = .data$parameter) %>% mutate(method = "Friedman test") %>% select(.data$statistic, .data$df, .data$p, .data$method) %>% add_columns(.y. = vars$dv, n = sample.size, .before = "statistic") res } get_friedman_vars <- function(formula){ outcome <- get_formula_left_hand_side(formula) rhs <- get_formula_right_hand_side(formula) rhs <- gsub(pattern = " ", replacement = "", rhs) rhs <- strsplit(rhs, "|", fixed = TRUE) %>% unlist() list(dv = outcome, within = rhs[1], wid = rhs[2]) } rstatix/R/adjust_pvalue.R0000644000176200001440000000332715074310430015144 0ustar liggesusers#' @include utilities.R NULL #' Adjust P-values for Multiple Comparisons #' @description A pipe-friendly function to add an adjusted p-value column into #' a data frame. Supports grouped data. #' @param data a data frame containing a p-value column #' @param p.col column name containing p-values #' @param output.col the output column name to hold the adjusted p-values #' @param method method for adjusting p values (see #' \code{\link[stats]{p.adjust}}). Allowed values include "holm", "hochberg", #' "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to #' adjust the p value (not recommended), use p.adjust.method = "none". #' @return a data frame #' #' @examples #' # Perform pairwise comparisons and adjust p-values #' ToothGrowth %>% #' t_test(len ~ dose) %>% #' adjust_pvalue() #' #' @rdname adjust_pvalue #' @export adjust_pvalue <- function(data, p.col = NULL, output.col = NULL, method = "holm"){ if (is_grouped_df(data)) { res <- data %>% doo(adjust_pvalue, p.col, output.col, method = method) return(res) } .attributes <- get_test_attributes(data) if(!is.null(.attributes$args)){ .attributes$args$p.adjust.method = method } p.adjust <- stats::p.adjust p.adjust.method <- method # Guess p-value columns if missing if(is.null(p.col)) p.col <- data %>% p_detect("p") if(is.null(p.col)) return(data) else if(!(p.col %in% colnames(data))) stop("The column ", p.col, "does not exist in the data") if(is.null(output.col)) output.col <- paste0(p.col, ".adj") # Adjust p-value data %>% keep_only_tbl_df_classes() %>% mutate( !!output.col := p.adjust(!!sym(p.col), method = p.adjust.method) ) %>% set_test_attributes(.attributes) } rstatix/R/cor_mat.R0000644000176200001440000000641515074310430013723 0ustar liggesusers#' @include utilities.R as_cor_mat.R NULL #'Compute Correlation Matrix with P-values #'@description Compute correlation matrix with p-values. Numeric columns in the #' data are detected and automatically selected for the analysis. You can also #' specify variables of interest to be used in the correlation analysis. #'@inheritParams cor_test #'@param x an object of class \code{cor_mat} #'@param vars a character vector containing the variable names of interest. #'@param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to select a variable of interest. #'@return a data frame #'@seealso \code{\link{cor_test}()}, \code{\link{cor_reorder}()}, #' \code{\link{cor_gather}()}, \code{\link{cor_select}()}, #' \code{\link{cor_as_symbols}()}, \code{\link{pull_triangle}()}, #' \code{\link{replace_triangle}()} #' @examples #' # Data preparation #' #::::::::::::::::::::::::::::::::::::::::::: #' mydata <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) #' head(mydata, 3) #' #' # Compute correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' # Correlation matrix between all variables #' cor.mat <- mydata %>% cor_mat() #' cor.mat #' #' # Specify some variables of interest #' mydata %>% cor_mat(mpg, hp, wt) #' #' # Or remove some variables in the data #' # before the analysis #' mydata %>% cor_mat(-mpg, -hp) #' #' # Significance levels #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat %>% cor_get_pval() #' #' #' # Visualize #' #:::::::::::::::::::::::::::::::::::::::::: #' # Insignificant correlations are marked by crosses #' cor.mat %>% #' cor_reorder() %>% #' pull_lower_triangle() %>% #' cor_plot(label = TRUE) #' #' # Gather/collapse correlation matrix into long format #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat %>% cor_gather() #' #' #'@describeIn cor_mat compute correlation matrix with p-values. Returns a data #' frame containing the matrix of the correlation coefficients. The output has #' an attribute named "pvalue", which contains the matrix of the correlation #' test p-values. #'@export cor_mat <- function(data, ..., vars = NULL, method = "pearson", alternative = "two.sided", conf.level = 0.95){ vars <- data %>% get_selected_vars(..., vars = vars) n.vars <- length(vars) if(n.vars > 1 & n.vars <= 2){ stop("At least, 3 variables are required for a correlation matrix. ", "Use the function cor_test() for 2 or less variables.", call. = FALSE) } cor_test( data, vars = vars, method = method, alternative = alternative, conf.level = conf.level ) %>% as_cor_mat() } #' @describeIn cor_mat compute the correlation matrix but returns only the p-values of the tests. #' @export cor_pmat <- function(data, ..., vars = NULL, method = "pearson", alternative = "two.sided", conf.level = 0.95){ cor_mat( data = data, ..., vars = vars, method = method, alternative = alternative, conf.level = conf.level ) %>% cor_get_pval() } #' @describeIn cor_mat extract a correlation matrix p-values from an object of #' class \code{cor_mat()}. P-values are not adjusted. #' @export cor_get_pval <- function(x){ res <- x %>% attr("pvalue") if(is.null(res)) warning("Can't find p-value attributes.", call.= FALSE) res } rstatix/R/binom_test.R0000644000176200001440000001505515074310430014442 0ustar liggesusers#' @include utilities.R NULL #'Exact Binomial Test #' #'@description Performs exact binomial test and pairwise comparisons following a #' significant exact multinomial test. Wrapper around the R base function #' \code{link[stats]{binom.test}()} that returns a data frame as a result. #' #'@inheritParams stats::binom.test #'@param x numeric vector containing the counts. #'@param p a vector of probabilities of success. The length of p must be the #' same as the number of groups specified by x, and its elements must be #' greater than 0 and less than 1. #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #'@param detailed logical value. Default is FALSE. If TRUE, a detailed result is #' shown. #'@seealso \link{multinom_test} #'@return return a data frame containing the p-value and its significance. with #' some the following columns: \itemize{ \item \code{group, group1, group2}: #' the categories or groups being compared. \item \code{statistic}: the number #' of successes. \item \code{parameter}: the number of trials. \item \code{p}: #' p-value of the test. \item \code{p.adj}: the adjusted p-value. \item #' \code{method}: the used statistical test. \item \code{p.signif, #' p.adj.signif}: the significance level of p-values and adjusted p-values, #' respectively. \item \code{estimate}: the estimated probability of success. #' \item \code{alternative}: a character string describing the alternative #' hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a #' confidence interval for the probability of success.} #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' #' @examples #' # Exact binomial test #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: 160 mice with cancer including 95 male and 65 female #' # Q1: Does cancer affect more males than females? #' binom_test(x = 95, n = 160) #' # => yes, there are a significant difference #' #' #' # Q2: compare the observed proportion of males #' # to an expected proportion (p = 3/5) #' binom_test(x = 95, n = 160, p = 3/5) #' # => there are no significant difference #' #' # Multinomial test #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data #' tulip <- c(red = 81, yellow = 50, white = 27) #' # Question 1: are the color equally common ? #' # this is a test of homogeneity #' res <- multinom_test(tulip) #' res #' attr(res, "descriptives") #' #' # Pairwise comparisons between groups #' pairwise_binom_test(tulip, p.adjust.method = "bonferroni") #' #' #' # Question 2: comparing observed to expected proportions #' # this is a goodness-of-fit test #' expected.p <- c(red = 0.5, yellow = 0.33, white = 0.17) #' res <- multinom_test(tulip, expected.p) #' res #' attr(res, "descriptives") #' #' # Pairwise comparisons against a given probabilities #' pairwise_binom_test_against_p(tulip, expected.p) #' @describeIn binom_test performs exact binomial test. Wrapper around the R #' base function \code{\link[stats]{binom.test}} that returns a dataframe as a #' result. #' @export binom_test <- function(x, n, p = 0.5, alternative = "two.sided", conf.level = 0.95, detailed = FALSE){ args <- as.list(environment()) %>% add_item(method = "exact_binom_test") if(length(x) == 2) n <- sum(x) results <- stats::binom.test(x, n, p, alternative, conf.level) %>% tidy() %>% rename(p = .data$p.value) %>% add_significance("p") %>% add_columns(n = n, .before = 1) if(!detailed){ to.keep <- c("n", "estimate", "conf.low", "conf.high", "p", "p.signif") results <- results[, to.keep] } results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "exact_binom_test")) } #' @describeIn binom_test performs pairwise comparisons (binomial test) #' following a significant exact multinomial test. #' @export pairwise_binom_test <- function(x, p.adjust.method = "holm", alternative = "two.sided", conf.level = 0.95){ if(is.null(names(x))){ names(x) <- paste0("grp", 1:length(x)) } compare_pair <- function(levs, x){ levs <- as.character(levs) lev1 <- levs[1] lev2 <- levs[2] binom_test( x[lev1], x[lev1] + x[lev2], p = 0.5, alternative = alternative, conf.level = conf.level ) %>% add_columns(group1 = levs[1], group2 = levs[2], .before = 1) } args <- as.list(environment()) %>% add_item(method = "exact_binom_test") comparisons <- names(x) %>% .possible_pairs() results <- comparisons %>% map(compare_pair, x) results <- comparisons %>% map(compare_pair, x) %>% map(keep_only_tbl_df_classes) %>% bind_rows() %>% adjust_pvalue("p", method = p.adjust.method) %>% add_significance("p.adj") %>% mutate(p.adj = signif(.data$p.adj, digits = 3)) %>% select(-.data$p.signif) # select(.data$group1, .data$group2, .data$p, .data$p.adj, .data$p.adj.signif) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "exact_binom_test")) } #' @describeIn binom_test performs pairwise comparisons (binomial test) #' following a significant exact multinomial test for given probabilities. #' @export pairwise_binom_test_against_p <- function(x, p = rep(1/length(x), length(x)), p.adjust.method = "holm", alternative = "two.sided", conf.level = 0.95){ if (sum(p) != 1) { stop("sum of probabilities must be 1") } if (length(x) != length(p)) { stop("'x' and 'p' lengths differ") } groups <- names(x) if(is.null(groups)) { names(groups) <- paste0("grp", 1:length(x)) } if(inherits(x, "table")){ x <- as.vector(x) } names(x) <- groups args <- as.list(environment()) %>% add_item(method = "exact_binom_test") input <- data.frame(x = x, n = sum(x), p = p) results <- purrr::pmap( input, binom_test, alternative = alternative, conf.level = conf.level ) %>% map(keep_only_tbl_df_classes) %>% bind_rows() %>% adjust_pvalue("p", method = p.adjust.method) %>% add_significance("p.adj") %>% mutate(p.adj = signif(.data$p.adj, digits = 3)) %>% select(-.data$p.signif) %>% # select(.data$p, .data$p.adj, .data$p.adj.signif) %>% add_columns(group = groups, observed = x, expected = p*sum(x), .before = 1) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "exact_binom_test")) } rstatix/R/wilcox_test.R0000644000176200001440000001677015074375345014670 0ustar liggesusers#' @include utilities.R utilities_two_sample_test.R #' @importFrom stats wilcox.test NULL #'Wilcoxon Tests #' #' #'@description Provides a pipe-friendly framework to performs one and two sample #' Wilcoxon tests. Read more: #' \href{https://www.datanovia.com/en/lessons/wilcoxon-test-in-r/}{Wilcoxon in #' R}. #'@inheritParams stats::wilcox.test #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{x ~ group} where \code{x} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ cancer_group}. #'@param paired a logical indicating whether you want a paired test. #'@param ref.group a character string specifying the reference group. If #' specified, for a given grouping variable, each of the group levels will be #' compared to the reference group (i.e. control group). #' #' If \code{ref.group = "all"}, pairwise two sample tests are performed for #' comparing each grouping variable levels against all (i.e. basemean). #'@param mu a number specifying an optional parameter used to form the null #' hypothesis. #'@param comparisons A list of length-2 vectors specifying the groups of #' interest to be compared. For example to compare groups "A" vs "B" and "B" vs #' "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", #' "C"))} #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #' #'@param detailed logical value. Default is FALSE. If TRUE, a detailed result is #' shown. #'@param ... other arguments to be passed to the function #' \code{\link[stats]{wilcox.test}}. #' #'@details - \code{pairwise_wilcox_test()} applies the standard two sample #' Wilcoxon test to all possible pairs of groups. This method calls the #' \code{\link[stats]{wilcox.test}()}, so extra arguments are accepted. #' #' #' - If a list of comparisons is specified, the result of the pairwise tests is #' filtered to keep only the comparisons of interest.The p-value is adjusted #' after filtering. #' #' - For a grouped data, if pairwise test is performed, then the p-values are #' adjusted for each group level independently. #' #' #' - a nonparametric confidence interval and an estimator for the pseudomedian #' (one-sample case) or for the difference of the location parameters #' \code{x-y} is computed, where x and y are the compared samples or groups. #' The column \code{estimate} and the confidence intervals are displayed in the #' test result when the option \code{detailed = TRUE} is specified in the #' \code{wilcox_test()} and \code{pairwise_wilcox_test()} functions. Read more #' about the calculation of the estimate in the details section of the R base #' function \code{wilcox.test()} documentation by typing \code{?wilcox.test} in #' the R console. #' #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y variable used in the test. \item #' \code{group1,group2}: the compared groups in the pairwise tests. \item #' \code{n,n1,n2}: Sample counts. \item \code{statistic}: Test statistic used #' to compute the p-value. \item \code{p}: p-value. \item \code{p.adj}: the #' adjusted p-value. \item \code{method}: the statistical test used to compare #' groups. \item \code{p.signif, p.adj.signif}: the significance level of #' p-values and adjusted p-values, respectively. \item \code{estimate}: an #' estimate of the location parameter (Only present if argument \code{detailed #' = TRUE}). This corresponds to the pseudomedian (for one-sample case) or to #' the difference of the location parameter (for two-samples case). \itemize{ #' \item The pseudomedian of a distribution \code{F} is the median of the #' distribution of \code{(u+v)/2}, where \code{u} and \code{v} are independent, each #' with distribution \code{F}. If \code{F} is symmetric, then the pseudomedian #' and median coincide. \item Note that in the two-sample case the estimator #' for the difference in location parameters does not estimate the difference #' in medians (a common misconception) but rather the median of the difference #' between a sample from x and a sample from y. } \item \code{conf.low, #' conf.high}: a confidence interval for the location parameter. (Only present #' if argument conf.int = TRUE.) } #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # One-sample test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% wilcox_test(len ~ 1, mu = 0) #' #' #' # Two-samples unpaired test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% wilcox_test(len ~ supp) #' #' # Two-samples paired test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% wilcox_test (len ~ supp, paired = TRUE) #' #' # Compare supp levels after grouping the data by "dose" #' #:::::::::::::::::::::::::::::::::::::::: #' df %>% #' group_by(dose) %>% #' wilcox_test(data =., len ~ supp) %>% #' adjust_pvalue(method = "bonferroni") %>% #' add_significance("p.adj") #' #' # pairwise comparisons #' #:::::::::::::::::::::::::::::::::::::::: #' # As dose contains more than two levels ==> #' # pairwise test is automatically performed. #' df %>% wilcox_test(len ~ dose) #' #' # Comparison against reference group #' #:::::::::::::::::::::::::::::::::::::::: #' # each level is compared to the ref group #' df %>% wilcox_test(len ~ dose, ref.group = "0.5") #' #' # Comparison against all #' #:::::::::::::::::::::::::::::::::::::::: #' df %>% wilcox_test(len ~ dose, ref.group = "all") #' #'@describeIn wilcox_test Wilcoxon test #'@export wilcox_test <- function( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", paired = FALSE, exact = NULL, alternative = "two.sided", mu = 0, conf.level = 0.95, detailed = FALSE ) { env <- as.list(environment()) args <- env %>% add_item(method = "wilcox_test") params <- env %>% remove_null_items() %>% add_item(conf.int = TRUE, method = "wilcox.test") outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(number.of.groups > 2 & !is.null(ref.group)){ if(ref.group %in% c("all", ".all.")){ params$data <- create_data_with_all_ref_group(data, outcome, group) params$ref.group <- "all" } } test.func <- two_sample_test if(number.of.groups > 2) test.func <- pairwise_two_sample_test do.call(test.func, params) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "wilcox_test")) } #'@describeIn wilcox_test performs pairwise two sample Wilcoxon test. #'@export pairwise_wilcox_test <- function( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", detailed = FALSE, ...) { args <- as.list(environment()) %>% .add_item(method = "wilcox_test") res <- pairwise_two_sample_test( data, formula, method = "wilcox.test", comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, detailed = detailed, conf.int = TRUE, ... ) res %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "wilcox_test")) } rstatix/R/remove_ns.R0000644000176200001440000000446015074310430014272 0ustar liggesusers#' @include utilities.R NULL #' Remove Non-Significant from Statistical Tests #' @description Filter out non-significant (NS) p-values from a statistical #' test. Can detect automatically p-value columns #' @param stat.test statistical test results returned by \code{rstatix} #' functions or any data frame containing a p-value column. #' @param col (optional) character specifying the column containing the p-value #' or the significance information, to be used for the filtering step. #' Possible values include: \code{"p"}, \code{"p.adj"}, \code{"p.signif"}, #' \code{"p.adj.signif"}. If missing, the function will automatically look for #' p.adj.signif, p.adj, p.signif, p in this order. #' @param signif.cutoff the significance cutoff; default is 0.05. Significance #' is declared at \code{p-value <= signif.cutoff} #' @return a data frame #' @examples #' # Statistical test #' stat.test <- PlantGrowth %>% wilcox_test(weight ~ group) #' # Remove ns: automatic detection of p-value columns #' stat.test %>% remove_ns() #' # Remove ns by the column p #' stat.test %>% remove_ns(col ="p") #' @export remove_ns <- function(stat.test, col = NULL, signif.cutoff = 0.05){ if(is.null(col)) col <- "any" else if(is.na(col)) col <- "any" else if(is.logical(col) ){ if(is.na(col)) col <- "any" else if(col == TRUE) col <- "any" else if(col == FALSE) return(stat.test) } if(col == "any"){ p.adj <- p_adj_names() p.adj.signif <- paste0(p.adj, ".signif") p <- p_names() p.signif <- paste0(p, ".signif") possible.cols <- c(p.adj.signif, p.adj, p.signif, p) if(!missing(signif.cutoff)) { # numeric columns are checked first possible.cols <- c(p.adj, p, p.adj.signif, p.signif) } col <- intersect(possible.cols, colnames(stat.test)) if(length(col) > 1) col <- col[1] else if(length(col) == 0) { warning("Specify a column for filtering out ns.", "Can't found any automatically", call. = FALSE) } } if(col %in% colnames(stat.test)){ .value <- stat.test[[col]] if(is.numeric(.value)) stat.test <- filter(stat.test, .value <= signif.cutoff) else if(is.character(.value)) stat.test <- filter(stat.test, !(.value %in% c("ns", "NS"))) } else{ stop("Can't find the column `", col, ", in the data", call. = FALSE) } stat.test } rstatix/R/get_manova_table.R0000644000176200001440000000506315074310430015564 0ustar liggesusers#' @include utilities.R NULL # Helper function to get MANOVA table # The codes is from: getAnywhere("print.Anova.mlm") # # x a manova test result get_manova_table <- function (x) { if ((!is.null(x$singular)) && x$singular) stop( "singular error SSP matrix; multivariate tests unavailable\n", "try summary(object, multivariate=FALSE)" ) test <- x$test repeated <- x$repeated ntests <- length(x$terms) tests <- matrix(NA, ntests, 4) . <- NULL if (!repeated) SSPE.qr <- qr(x$SSPE) for (term in 1:ntests) { eigs <- qr.coef( if (repeated) qr(x$SSPE[[term]]) else SSPE.qr, x$SSP[[term]] ) %>% eigen(symmetric = FALSE) %>% .$values %>% Re() tests[term, 1:4] <- switch( test, Pillai = Pillai(eigs, x$df[term], x$error.df), Wilks = Wilks(eigs, x$df[term], x$error.df), `Hotelling-Lawley` = HL(eigs, x$df[term], x$error.df), Roy = Roy(eigs, x$df[term], x$error.df) ) } ok <- tests[, 2] >= 0 & tests[, 3] > 0 & tests[, 4] > 0 ok <- !is.na(ok) & ok tests <- cbind( x$df, tests, stats::pf(tests[ok, 2], tests[ok, 3], tests[ok, 4], lower.tail = FALSE) ) rownames(tests) <- x$terms colnames(tests) <- c("Df", "test stat", "approx F", "num Df", "den Df", "Pr(>F)") heading <- paste( "\nType ", x$type, if (repeated) " Repeated Measures", " MANOVA Tests: ", test, " test statistic",sep = "" ) tests <- structure( as.data.frame(tests), heading = heading, class = c("anova", "data.frame") ) tests } Pillai <- function (eig, q, df.res) { test <- sum(eig/(1 + eig)) p <- length(eig) s <- min(p, q) n <- 0.5 * (df.res - p - 1) m <- 0.5 * (abs(p - q) - 1) tmp1 <- 2 * m + s + 1 tmp2 <- 2 * n + s + 1 c(test, (tmp2/tmp1 * test)/(s - test), s * tmp1, s * tmp2) } Wilks <- function (eig, q, df.res) { test <- prod(1/(1 + eig)) p <- length(eig) tmp1 <- df.res - 0.5 * (p - q + 1) tmp2 <- (p * q - 2)/4 tmp3 <- p^2 + q^2 - 5 tmp3 <- if (tmp3 > 0) sqrt(((p * q)^2 - 4)/tmp3) else 1 c(test, ((test^(-1/tmp3) - 1) * (tmp1 * tmp3 - 2 * tmp2))/p/q, p * q, tmp1 * tmp3 - 2 * tmp2) } HL <- function (eig, q, df.res) { test <- sum(eig) p <- length(eig) m <- 0.5 * (abs(p - q) - 1) n <- 0.5 * (df.res - p - 1) s <- min(p, q) tmp1 <- 2 * m + s + 1 tmp2 <- 2 * (s * n + 1) c(test, (tmp2 * test)/s/s/tmp1, s * tmp1, tmp2) } Roy <- function (eig, q, df.res) { p <- length(eig) test <- max(eig) tmp1 <- max(p, q) tmp2 <- df.res - tmp1 + q c(test, (tmp2 * test)/tmp1, tmp1, tmp2) } rstatix/R/fisher_test.R0000644000176200001440000001755115074310430014621 0ustar liggesusers#' @include utilities.R NULL #'Fisher's Exact Test for Count Data #'@description Performs Fisher's exact test for testing the null of independence #' of rows and columns in a contingency table. #' #' Wrappers around the R base function \code{\link[stats]{fisher.test}()} but #' have the advantage of performing pairwise and row-wise fisher tests, the #' post-hoc tests following a significant chi-square test of homogeneity for 2xc #' and rx2 contingency tables. #'@inheritParams stats::fisher.test #'@param xtab a contingency table in a matrix form. #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #'@param detailed logical value. Default is FALSE. If TRUE, a detailed result is #' shown. #'@param ... Other arguments passed to the function \code{fisher_test()}. #' #'@return return a data frame with some the following columns: \itemize{ \item #' \code{group}: the categories in the row-wise proportion tests. \item #' \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item #' \code{method}: the used statistical test. \item \code{p.signif, #' p.adj.signif}: the significance level of p-values and adjusted p-values, #' respectively. \item \code{estimate}: an estimate of the odds ratio. Only #' present in the 2 by 2 case. \item \code{alternative}: a character string #' describing the alternative hypothesis. \item \code{conf.low,conf.high}: a #' confidence interval for the odds ratio. Only present in the 2 by 2 case and #' if argument conf.int = TRUE.} #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' @examples #' #' # Comparing two proportions #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: frequencies of smokers between two groups #' xtab <- as.table(rbind(c(490, 10), c(400, 100))) #' dimnames(xtab) <- list( #' group = c("grp1", "grp2"), #' smoker = c("yes", "no") #' ) #' xtab #' # compare the proportion of smokers #' fisher_test(xtab, detailed = TRUE) #' #' # Homogeneity of proportions between groups #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # H0: the proportion of smokers is similar in the four groups #' # Ha: this proportion is different in at least one of the populations. #' # #' # Data preparation #' grp.size <- c( 106, 113, 156, 102 ) #' smokers <- c( 50, 100, 139, 80 ) #' no.smokers <- grp.size - smokers #' xtab <- as.table(rbind( #' smokers, #' no.smokers #' )) #' dimnames(xtab) <- list( #' Smokers = c("Yes", "No"), #' Groups = c("grp1", "grp2", "grp3", "grp4") #' ) #' xtab #' #' # Compare the proportions of smokers between groups #' fisher_test(xtab, detailed = TRUE) #' #' # Pairwise comparison between groups #' pairwise_fisher_test(xtab) #' #' #' # Pairwise proportion tests #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: Titanic #' xtab <- as.table(rbind( #' c(122, 167, 528, 673), #' c(203, 118, 178, 212) #' )) #' dimnames(xtab) <- list( #' Survived = c("No", "Yes"), #' Class = c("1st", "2nd", "3rd", "Crew") #' ) #' xtab #' # Compare the proportion of survived between groups #' pairwise_fisher_test(xtab) #' #' # Row-wise proportion tests #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: Titanic #' xtab <- as.table(rbind( #' c(180, 145), c(179, 106), #' c(510, 196), c(862, 23) #' )) #' dimnames(xtab) <- list( #' Class = c("1st", "2nd", "3rd", "Crew"), #' Gender = c("Male", "Female") #' ) #' xtab #' # Compare the proportion of males and females in each category #' row_wise_fisher_test(xtab) #' #' # A r x c table Agresti (2002, p. 57) Job Satisfaction #' Job <- matrix(c(1,2,1,0, 3,3,6,1, 10,10,14,9, 6,7,12,11), 4, 4, #' dimnames = list(income = c("< 15k", "15-25k", "25-40k", "> 40k"), #' satisfaction = c("VeryD", "LittleD", "ModerateS", "VeryS"))) #' fisher_test(Job) #' fisher_test(Job, simulate.p.value = TRUE, B = 1e5) #' @describeIn fisher_test performs Fisher's exact test for testing the null of #' independence of rows and columns in a contingency table with fixed #' marginals. Wrapper around the function \code{\link[stats]{fisher.test}()}. #' @export fisher_test <- function(xtab, workspace = 200000, alternative = "two.sided", conf.int = TRUE, conf.level = 0.95, simulate.p.value = FALSE, B = 2000, detailed = FALSE, ...){ if(is.data.frame(xtab)) xtab <- as.matrix(xtab) args <- as.list(environment()) %>% add_item(method = "fisher_test") results <- stats::fisher.test( xtab, workspace = workspace, alternative = alternative, conf.int = conf.int, conf.level = conf.level, simulate.p.value = simulate.p.value, B = B, ... ) %>% as_tidy_stat() %>% add_significance("p") %>% add_columns(n = sum(xtab), .before = 1) %>% mutate(method = "Fisher's Exact test") if(!detailed) results <- remove_details(results, method = "prop.test") results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "fisher_test")) } #' @describeIn fisher_test pairwise comparisons between proportions, a post-hoc #' tests following a significant Fisher's exact test of homogeneity for 2xc #' design. #' @export pairwise_fisher_test <- function(xtab, p.adjust.method = "holm", detailed = FALSE, ...){ if(is.data.frame(xtab)) xtab <- as.matrix(xtab) if(ncol(xtab) > 2 & nrow(xtab) == 2) xtab <- t(xtab) if (is.null(colnames(xtab)) | any(0 %in% nchar(colnames(xtab)))) { colnames(xtab) <- paste0("col", 1:ncol(xtab)) } if (is.null(rownames(xtab)) | any(0 %in% nchar(rownames(xtab)))) { rownames(xtab) <- paste0("row", 1:nrow(xtab)) } if(ncol(xtab) > 2){ stop("A two-dimensionnal contingency table required.") } compare_pair <- function(rows, xtab, ...){ rows <- as.character(rows) fisher_test(xtab[rows, ], detailed = detailed, ...) %>% add_columns(group1 = rows[1], group2 = rows[2], .before = 1) %>% keep_only_tbl_df_classes() } args <- c(as.list(environment()), list(...)) %>% add_item(method = "fisher_test") comparisons <- rownames(xtab) %>% .possible_pairs() results <- comparisons %>% map(compare_pair, xtab, ...) %>% bind_rows() %>% adjust_pvalue("p", method = p.adjust.method) %>% add_significance("p.adj") %>% mutate(p.adj = signif(.data$p.adj, digits = 3)) %>% select(-.data$p.signif) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "fisher_test")) } #' @describeIn fisher_test performs row-wise Fisher's exact test of count data, a post-hoc tests following a significant chi-square test #' of homogeneity for rx2 contingency table. The test is conducted for each category (row). #' @export row_wise_fisher_test <- function(xtab, p.adjust.method = "holm", detailed = FALSE, ...){ if(is.data.frame(xtab)) xtab <- as.matrix(xtab) if(!inherits(xtab, c("matrix", "table"))){ stop("An object of class 'matrix' or 'table' required") } if(ncol(xtab) !=2){ stop("A cross-tabulation with two columns required") } args <- c(as.list(environment()), list(...)) %>% add_item(method = "fisher_test") # Create xtab for each category (row) columns.total <- margin.table(xtab, 2) create_xtab <- function(x, n){ as.data.frame(rbind(x, n-x)) } xtab.list <- apply(xtab, 1, create_xtab, columns.total ) results <- xtab.list %>% map(fisher_test, detailed = detailed, ...) %>% map(keep_only_tbl_df_classes) %>% bind_rows(.id = "group") %>% adjust_pvalue(method = p.adjust.method) %>% add_significance("p.adj") %>% mutate( p = signif(.data$p, digits = 3), p.adj = signif(.data$p.adj, digits = 3) ) %>% select(-.data$p.signif) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "fisher_test")) } rstatix/R/kruskal_effesize.R0000644000176200001440000000700215074310430015624 0ustar liggesusers#' @include utilities.R NULL #'Kruskal-Wallis Effect Size #' #'@description Compute the effect size for Kruskal-Wallis test as the eta #' squared based on the H-statistic: \code{eta2[H] = (H - k + 1)/(n - k)}; #' where \code{H} is the value obtained in the Kruskal-Wallis test; \code{k} is #' the number of groups; \code{n} is the total number of observations. #' #' #' The eta-squared estimate assumes values from 0 to 1 and multiplied by 100% #' indicates the percentage of variance in the dependent variable explained by #' the independent variable. The interpretation values commonly in published #' litterature are: \code{0.01- < 0.06} (small effect), \code{0.06 - < 0.14} #' (moderate effect) and \code{>= 0.14} (large effect). #' #' Confidence intervals are calculated by bootstap. #' #'@inheritParams wilcox_effsize #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y variable used in the test. \item \code{n}: Sample #' counts. \item \code{effsize}: estimate of the effect size. \item #' \code{magnitude}: magnitude of effect size. \item \code{conf.low,conf.high}: #' lower and upper bound of the effect size confidence interval.} #' #'@references Maciej Tomczak and Ewa Tomczak. The need to report effect size #' estimates revisited. An overview of some recommended measures of effect #' size. Trends in Sport Sciences. 2014; 1(21):19-25. #' #' http://imaging.mrc-cbu.cam.ac.uk/statswiki/FAQ/effectSize #' #' http://www.psy.gla.ac.uk/~steve/best/effect.html #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # Kruskal-wallis rank sum test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% kruskal_effsize(len ~ dose) #' #' # Grouped data #' df %>% #' group_by(supp) %>% #' kruskal_effsize(len ~ dose) #' @export kruskal_effsize <- function(data, formula, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000){ args <- as.list(environment()) %>% .add_item(method = "kruskal_effsize") data %>% doo( .kruskal_effsize, formula, ci = ci, conf.level = conf.level, ci.type = ci.type, nboot = nboot ) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "kruskal_effsize")) } .kruskal_effsize <- function(data, formula, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000){ results <- eta_squared_h(data, formula) # Confidence interval of the effect size r if (ci == TRUE) { stat.func <- function(data, subset) { eta_squared_h(data, formula, subset = subset)$effsize } CI <- get_boot_ci( data, stat.func, conf.level = conf.level, type = ci.type, nboot = nboot ) results <- results %>% add_columns(conf.low = CI[1], conf.high = CI[2], .after = "effsize") } results %>% mutate(magnitude = get_eta_squared_magnitude(.data$effsize)) } eta_squared_h <- function(data, formula, subset = NULL, ...){ if(!is.null(subset)) data <- data[subset, ] res.kw <- kruskal_test(data, formula, ...) nb.groups <- res.kw$df + 1 nb.samples <- res.kw$n etasq <- (res.kw$statistic - nb.groups + 1) / (nb.samples - nb.groups) tibble( .y. = get_formula_left_hand_side(formula), n = nb.samples, effsize = etasq, method = "eta2[H]" ) } get_eta_squared_magnitude <- function(d){ magnitude.levels = c(0.06, 0.14, Inf) magnitude = c("small","moderate","large") d.index <- findInterval(abs(d), magnitude.levels)+1 magnitude <- factor(magnitude[d.index], levels = magnitude, ordered = TRUE) magnitude } rstatix/R/t_test.R0000644000176200001440000002212515074310430013575 0ustar liggesusers#' @include utilities.R utilities_two_sample_test.R NULL #'T-test #' #' #'@description Provides a pipe-friendly framework to performs one and two sample #' t-tests. Read more: \href{https://www.datanovia.com/en/lessons/t-test-in-r/}{T-test in R}. #'@inheritParams stats::t.test #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{x ~ group} where \code{x} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ cancer_group}. #'@param paired a logical indicating whether you want a paired test. #'@param ref.group a character string specifying the reference group. If #' specified, for a given grouping variable, each of the group levels will be #' compared to the reference group (i.e. control group). #' #' If \code{ref.group = "all"}, pairwise two sample tests are performed for #' comparing each grouping variable levels against all (i.e. basemean). #'@param mu a number specifying an optional parameter used to form the null hypothesis. #'@param comparisons A list of length-2 vectors specifying the groups of #' interest to be compared. For example to compare groups "A" vs "B" and "B" vs #' "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", #' "C"))} #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #'@param pool.sd logical value used in the function \code{pairwise_t_test()}. #' Switch to allow/disallow the use of a pooled SD. #' #' The \code{pool.sd = TRUE} (default) calculates a common SD for all groups #' and uses that for all comparisons (this can be useful if some groups are #' small). This method does not actually call t.test, so extra arguments are #' ignored. Pooling does not generalize to paired tests so pool.sd and paired #' cannot both be TRUE. #' #' If \code{pool.sd = FALSE} the standard two sample t-test is applied to all #' possible pairs of groups. This method calls the \code{t.test()}, so extra #' arguments, such as \code{var.equal} are accepted. #' #'@param detailed logical value. Default is FALSE. If TRUE, a detailed result is #' shown. #'@param ... other arguments to be passed to the function #' \code{\link[stats]{t.test}}. #' #'@details #' #'- If a list of comparisons is specified, the result of the pairwise tests is #'filtered to keep only the comparisons of interest. The p-value is adjusted #'after filtering. #' #'- For a grouped data, if pairwise test is performed, then the p-values are #'adjusted for each group level independently. #' #'@return return a data frame with some the following columns: \itemize{ \item #' \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the #' compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. #' \item \code{statistic}: Test statistic used to compute the p-value. \item #' \code{df}: degrees of freedom. \item \code{p}: p-value. \item \code{p.adj}: #' the adjusted p-value. \item \code{method}: the statistical test used to #' compare groups. \item \code{p.signif, p.adj.signif}: the significance level #' of p-values and adjusted p-values, respectively. \item \code{estimate}: #' estimate of the effect size. It corresponds to the estimated mean or #' difference in means depending on whether it was a one-sample test or a #' two-sample test. \item \code{estimate1, estimate2}: show the mean values of #' the two groups, respectively, for independent samples t-tests. \item #' \code{alternative}: a character string describing the alternative #' hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a #' confidence interval. } #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' #' # One-sample test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% t_test(len ~ 1, mu = 0) #' #' #' # Two-samples unpaired test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% t_test(len ~ supp) #' #' # Two-samples paired test #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% t_test (len ~ supp, paired = TRUE) #' #' # Compare supp levels after grouping the data by "dose" #' #:::::::::::::::::::::::::::::::::::::::: #' df %>% #' group_by(dose) %>% #' t_test(data =., len ~ supp) %>% #' adjust_pvalue(method = "bonferroni") %>% #' add_significance("p.adj") #' #' # pairwise comparisons #' #:::::::::::::::::::::::::::::::::::::::: #' # As dose contains more than two levels ==> #' # pairwise test is automatically performed. #' df %>% t_test(len ~ dose) #' #' # Comparison against reference group #' #:::::::::::::::::::::::::::::::::::::::: #' # each level is compared to the ref group #' df %>% t_test(len ~ dose, ref.group = "0.5") #' #' # Comparison against all #' #:::::::::::::::::::::::::::::::::::::::: #' df %>% t_test(len ~ dose, ref.group = "all") #' #'@describeIn t_test t test #'@export t_test <- function( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", paired = FALSE, var.equal = FALSE, alternative = "two.sided", mu = 0, conf.level = 0.95, detailed = FALSE ) { env <- as.list(environment()) args <- env %>% .add_item(method = "t_test") params <- env %>% remove_null_items() %>% add_item(method = "t.test") outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(number.of.groups > 2 & !is.null(ref.group)){ if(ref.group %in% c("all", ".all.")){ params$data <- create_data_with_all_ref_group(data, outcome, group) params$ref.group <- "all" } } test.func <- two_sample_test if(number.of.groups > 2) test.func <- pairwise_two_sample_test do.call(test.func, params) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "t_test")) } #'@describeIn t_test performs pairwise two sample t-test. Wrapper around the R #' base function \code{\link[stats]{pairwise.t.test}}. #'@export pairwise_t_test <- function( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", paired = FALSE, pool.sd = !paired, detailed = FALSE, ...) { args <- c(as.list(environment()), list(...)) %>% .add_item(method = "t_test") if(paired) pool.sd <- FALSE if(pool.sd){ res <- pairwise_t_test_psd( data, formula, comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, detailed = detailed, ... ) } else{ res <- pairwise_two_sample_test( data, formula, method = "t.test", comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, paired = paired, detailed = detailed, ... ) } res %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "t_test")) } pairwise_t_test_psd <- function( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", alternative = "two.sided", detailed = FALSE ) { . <- NULL if(is_grouped_df(data)){ results <- data %>% doo(pairwise_t_test_psd, formula, comparisons, ref.group, p.adjust.method, alternative = alternative, detailed = detailed) return(results) } outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) # Convert group into factor if this is not already the case data <- data %>% .as_factor(group, ref.group = ref.group) outcome.values <- data %>% pull(!!outcome) group.values <- data %>% pull(!!group) group.size <- data %>% get_group_size(group) # Compute pairwise t-test group1 <- group2 <- p.value <- NULL results <- stats::pairwise.t.test( outcome.values, group.values, p.adjust.method = "none", pool.sd = TRUE, alternative = alternative ) %>% tidy() %>% select(group2, group1, p.value) colnames(results) <- c("group1", "group2", "p") n1 <- group.size[results$group1] n2 <- group.size[results$group2] results <- results %>% mutate(method = "T-test") %>% add_column(.y. = outcome, .before = 1) %>% add_column(n1 = n1, n2 = n2, .after = "group2") # If ref.group specified, keep only comparisons against reference if(!is.null(ref.group)){ results <- results %>% filter(group1 == ref.group) } # If a comparison list is provided, extract the comparisons of interest if(!is.null(comparisons)){ results <- comparisons %>% purrr::map_dfr(~ results %>% filter(group1 %in% .x & group2 %in% .x) ) } p <- p.adj <- NULL results <- results %>% adjust_pvalue(method = p.adjust.method) %>% add_significance("p") %>% add_significance("p.adj") %>% mutate( p = signif(p, digits = 3), p.adj = signif(p.adj, digits = 3) ) if(!detailed) results <- remove_details(results, method = "t.test") results } rstatix/R/df.R0000644000176200001440000002464315074310430012673 0ustar liggesusers#' @include utilities.R NULL #' Select Columns in a Data Frame #' #' @description A wrapper around the \code{\link[dplyr]{select}()} function for #' selection data frame columns. Supports standard and non standard #' evaluations. Usefull to easily program with \code{dplyr} #' @param data a data frame #' @param vars a character vector containing the variable names of interest. #' @param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to select a variable of interest. #' #' @return a data frame #' @examples #' df <- head(ToothGrowth) #' df #' #' # Select column using standard evaluation #' df %>% df_select(vars = c("dose", "len")) #' #' # Select column using non-standard evaluation #' df %>% df_select(dose, len) #' @rdname df_select #' @export df_select <- function(data, ..., vars = NULL){ if(is.null(vars)){ results <- data %>% select(...) } else{ results <- data %>% select(!!!syms(vars)) } results } #' Arrange Rows by Column Values #' #' @description Order the rows of a data frame by values of specified columns. #' Wrapper arround the \code{\link[dplyr]{arrange}()} function. Supports #' standard and non standard evaluation. #' @param data a data frame #' @param vars a character vector containing the variable names of interest. #' @param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to select a variable of interest. Use #' \code{\link[dplyr]{desc}()} to sort a variable in descending order. #' @param .by_group If TRUE, will sort first by grouping variable. Applies to #' grouped data frames only. #' #' @return a data frame #' @examples #' df <- head(ToothGrowth) #' df #' #' # Select column using standard evaluation #' df %>% df_arrange(vars = c("dose", "len")) #' #' # Select column using non-standard evaluation #' df %>% df_arrange(dose, desc(len)) #' @rdname df_arrange #' @export df_arrange <- function(data, ..., vars = NULL, .by_group = FALSE ){ if(is.null(vars)){ results <- data %>% dplyr::arrange(..., .by_group = .by_group) } else{ results <- data %>% dplyr::arrange(!!!syms(vars), .by_group = .by_group) } results } #' Group a Data Frame by One or more Variables #' #' @description Group a data frame by one or more variables. Supports standard #' and non standard evaluation. #' @inheritParams df_select #' @examples #' #' # Non standard evaluation #' by_dose <- head(ToothGrowth) %>% #' df_group_by(dose) #' by_dose #' #' # Standard evaluation #' head(ToothGrowth) %>% #' df_group_by(vars = c("dose", "supp")) #' @rdname df_group_by #' @export df_group_by <- function(data, ..., vars = NULL){ if(is.null(vars)){ results <- data %>% group_by(...) } else{ results <- data %>% group_by(!!!syms(vars)) } results } #' Nest a Tibble By Groups #' #' @description Nest a tibble data frame using grouping specification. Supports standard and non standard evaluation. #' @param data a data frame #' @param ... One or more unquoted expressions (or variable names) separated by #' commas. Used as grouping variables. #' @param vars a character vector containing the grouping variables of interest. #' #' @return A tbl with one row per unique combination of the grouping variables. #' The first columns are the grouping variables, followed by a list column of #' tibbles with matching rows of the remaining columns. #' @examples #' #' # Non standard evaluation #' ToothGrowth %>% #' df_nest_by(dose, supp) #' #' # Standard evaluation #' ToothGrowth %>% #' df_nest_by(vars = c("dose", "supp")) #' #' @rdname df_nest_by #' @export df_nest_by <- function(data, ..., vars = NULL){ data %>% df_group_by(..., vars = vars) %>% nest() %>% ungroup() } #' Split a Data Frame into Subset #' #' @description Split a data frame by groups into subsets or data panel. Very #' similar to the function \code{\link{df_nest_by}()}. The only difference is #' that, it adds label to each data subset. Labels are the combination of the #' grouping variable levels. The column holding labels are named "label". #' @inheritParams df_nest_by #' @inheritParams df_label_both #' @param labeller A function that takes a data frame, the grouping variables, #' label_col and label_sep arguments, and add labels into the data frame. #' Example of possible values are: \code{\link{df_label_both}()} and #' \code{\link{df_label_value}()}. #' #' @return A tbl with one row per unique combination of the grouping variables. #' The first columns are the grouping variables, followed by a list column of #' tibbles with matching rows of the remaining columns, and a column named #' label, containing labels. #' @examples #' #' # Split a data frame #' # ::::::::::::::::::::::::::::::::::::::::::::::::: #' # Create a grouped data #' res <- ToothGrowth %>% #' df_split_by(dose, supp) #' res #' #' # Show subsets #' res$data #' #' # Add panel/subset labels #' res <- ToothGrowth %>% #' df_split_by(dose, supp) #' res #' @rdname df_split_by #' @export df_split_by <- function(data, ..., vars = NULL, label_col = "label", labeller = df_label_both, sep = c(", ", ":")){ groups <- df_get_var_names(data, ..., vars = vars) data %>% df_nest_by(vars = groups) %>% labeller(vars = groups, label_col = label_col, sep = sep) %>% mutate(data = map2(.data$data, .data[[label_col]], add_panel_name, col = label_col)) } #' Functions to Label Data Frames by Grouping Variables #' #' @description Functions to label data frame rows by one or multiple grouping #' variables. #' #' @inheritParams df_nest_by #' @param label_col column to hold the label of the data subsets. Default column #' name is "label". #' @param sep String separating labelling variables and values. Should be of #' length 2 in the function \code{df_label_both()}. 1) One sep is used to #' separate groups, for example ','; 2) The other sep between group name and #' levels; for example ':'. #' @return a modified data frame with a column containing row labels. #' @examples #' # Data preparation #' df <- head(ToothGrowth) #' #' # Labelling: Non standard evaluation #' df %>% #' df_label_both(dose, supp) #' #' # Standard evaluation #' df %>% #' df_label_both(dose, supp) #' #' # Nesting the data then label each subset by groups #' ToothGrowth %>% #' df_nest_by(dose, supp) %>% #' df_label_both(supp, dose) #' #' @describeIn df_label_value Displays both the variable name and the factor value. #' @export df_label_both <- function(data, ..., vars = NULL, label_col = "label", sep = c(", ", ":")){ vars <- df_get_var_names(data, ..., vars = vars) if(length(sep) < 2){ warning( "Argument sep sould be of length 2, otherwise it will be ignored; example: sep = c(', ', ':', )\n", " 2. One sep is used to separate groups, for example ','\n", " 1. The other sep between group name and levels; for example ':'", call. = FALSE ) sep <- c(":", ", ") } label <- data %>% df_select(vars = vars) %>% concat_groupname_to_levels(vars, sep = sep[2]) %>% df_unite_factors(col = label_col, vars = vars, sep = sep[1]) %>% pull(!!label_col) data %>% mutate(!!label_col := label) } #' @describeIn df_label_value Displays only the value of a factor. #' @export df_label_value <- function(data, ..., vars = NULL, label_col = "label", sep = ", "){ vars <- df_get_var_names(data, ..., vars = vars) label <- data %>% df_select(vars = vars) %>% df_unite_factors(col = label_col, vars = vars, sep = sep[1]) %>% pull(!!label_col) data %>% mutate(!!label_col := label) } # Add panel label to a data # Labels are the combination of the grouping variable labels add_panel_label <- function(data, groups, col = "label") { label <- data %>% df_select(vars = groups) %>% concat_groupname_to_levels(groups, sep = ":") %>% df_unite_factors(col = col, vars = groups, sep = ", ") %>% pull(!!col) data %>% mutate(!!col := label) } # Add a column containing panel name add_panel_name <- function(data, panel, col = "label") { data %>% mutate(!!col := !!panel) } concat_groupname_to_levels <- function(group.data, groups, sep = ":"){ purrr::map2( group.data, groups, function(x, name) {paste(name, x, sep = sep)} ) %>% as_tibble() } #' Unite Multiple Columns into One #' #' @description Paste together multiple columns into one. Wrapper arround #' \code{\link[tidyr]{unite}()} that supports standard and non standard #' evaluation. #' @inheritParams tidyr::unite #' @param data a data frame #' @param col the name of the new column as a string or a symbol. #' @param ... a selection of columns. One or more unquoted expressions (or variable names) separated by #' commas. #' @param vars a character vector containing the column names of interest. #' @examples #' # Non standard evaluation #' head(ToothGrowth) %>% #' df_unite(col = "dose_supp", dose, supp) #' #' # Standard evaluation #' head(ToothGrowth) %>% #' df_unite(col = "dose_supp", vars = c("dose", "supp")) #' @describeIn df_unite Unite multiple columns into one. #' @export df_unite <- function(data, col, ..., vars = NULL, sep = "_", remove = TRUE, na.rm = FALSE){ if(is.null(vars)){ results <- data %>% tidyr::unite( col = !!col, ..., sep = sep, remove = remove, na.rm = na.rm ) } else{ results <- data %>% tidyr::unite( col = !!col, !!!syms(vars), sep = sep, remove = remove, na.rm = na.rm ) } results } #' @export #' @describeIn df_unite Unite factor columns. First, order factors levels then #' merge them into one column. The output column is a factor. df_unite_factors <- function(data, col, ..., vars = NULL, sep = "_", remove = TRUE, na.rm = FALSE){ vars <- df_get_var_names(data, ..., vars = vars) data %>% dplyr::arrange(!!!syms(vars)) %>% df_unite(col = col, vars = vars, sep = sep, remove = remove, na.rm = na.rm) %>% dplyr::mutate_at(col, function(x){factor(x, levels = unique(x))}) } #' Get User Specified Variable Names #' #' @description Returns user specified variable names. Supports standard and non standard evaluation. #' @inheritParams df_select #' @return a character vector #' @examples #' #' # Non standard evaluation #' ToothGrowth %>% #' df_get_var_names(dose, len) #' #' # Standard evaluation #' ToothGrowth %>% #' df_get_var_names(vars = c("len", "dose")) #' @rdname df_get_var_names #' @export df_get_var_names <- function(data, ..., vars = NULL){ dot_vars <- tidyselect::vars_select(colnames(data), !!!rlang::quos(...)) unique(c(vars, dot_vars)) } rstatix/R/cor_select.R0000644000176200001440000000256315074310430014421 0ustar liggesusers#' @include utilities.R NULL #' Subset Correlation Matrix #' @name cor_select #' @param x a correlation matrix. Particularly, an object of class \code{cor_mat}. #' @param vars a character vector containing the variable names of interest. #' @param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to select variables of interest. #'@return a data frame #'@seealso \code{\link{cor_mat}()}, \code{\link{pull_triangle}()}, \code{\link{replace_triangle}()} #' @examples #' # Compute correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_mat() #' #' # Subsetting correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' #' # Select some variables of interest #' cor.mat %>% #' cor_select(mpg, drat, wt) #' #' # Remove variables #' cor.mat %>% #' cor_select(-mpg, -wt) #' #' @export cor_select <- function(x, ..., vars = NULL){ vars <- x %>% get_selected_vars(..., vars = vars) %>% setdiff("rowname") if(!.is_empty(vars)){ # Filter the correlation matrix vars <- unique(vars) x <- x %>% subset_matrix(vars) # Filter p-values pvalue <- x %>% attr("pvalue") if(!is.null(pvalue)){ pvalue <- pvalue %>% subset_matrix(vars) x <- x %>% set_attrs(pvalue = pvalue) %>% add_class("cor_mat") } } x } rstatix/R/tukey_hsd.R0000644000176200001440000001203115074310430014265 0ustar liggesusers#' @include utilities.R #' @importFrom stats TukeyHSD #' @importFrom dplyr everything #' @importFrom tidyr separate NULL #'Tukey Honest Significant Differences #' #' #'@description Provides a pipe-friendly framework to performs Tukey post-hoc #' tests. Wrapper around the function \code{\link[stats]{TukeyHSD}()}. It is #' essentially a t-test that corrects for multiple testing. #' #' Can handle different inputs formats: aov, lm, formula. #'@param x an object of class \code{aov}, \code{lm} or \code{data.frame} #' containing the variables used in the formula. #'@param data a data.frame containing the variables in the formula. #'@param formula a formula of the form \code{x ~ group} where \code{x} is a #' numeric variable giving the data values and \code{group} is a factor with #' one or multiple levels giving the corresponding groups. For example, #' \code{formula = TP53 ~ cancer_group}. #'@param ... other arguments passed to the function #' \code{\link[stats]{TukeyHSD}()}. These include: \itemize{ \item #' \strong{which}: A character vector listing terms in the fitted model for #' which the intervals should be calculated. Defaults to all the terms. \item #' \strong{ordered}: A logical value indicating if the levels of the factor #' should be ordered according to increasing average in the sample before #' taking differences. If ordered is true then the calculated differences in #' the means will all be positive. The significant differences will be those #' for which the lwr end point is positive. } #'@return a tibble data frame containing the results of the different #' comparisons. #' @examples #' # Data preparation #' df <- ToothGrowth #' df$dose <- as.factor(df$dose) #' # Tukey HSD from ANOVA results #' aov(len ~ dose, data = df) %>% tukey_hsd() #' #' # two-way anova with interaction #' aov(len ~ dose*supp, data = df) %>% tukey_hsd() #' #' # Tukey HSD from lm() results #' lm(len ~ dose, data = df) %>% tukey_hsd() #' #' # Tukey HSD from data frame and formula #' tukey_hsd(df, len ~ dose) #' #' # Tukey HSD using grouped data #' df %>% #' group_by(supp) %>% #' tukey_hsd(len ~ dose) #' #'@export tukey_hsd <- function(x, ...){ UseMethod("tukey_hsd", x) } #' @export #' @describeIn tukey_hsd performs tukey post-hoc test from \code{aov()} results. tukey_hsd.default <- function(x, ...) { tukey_hsd_of_model(x, ...) %>% set_attrs(args = list(x = x, p.adjust.method = "Tukey", method = "tukey_hsd")) %>% add_class(c("rstatix_test", "tukey_hsd")) } #' @export #' @describeIn tukey_hsd performs tukey post-hoc test from \code{lm()} model. tukey_hsd.lm <- function(x, ...) { stats::aov(x) %>% tukey_hsd.default(...) } #' @describeIn tukey_hsd performs tukey post-hoc tests using data and formula as #' inputs. ANOVA will be automatically performed using the function #' \code{\link[stats]{aov}()} #' @export tukey_hsd.data.frame <- function(x, formula, ...){ args <- list( data = x, formula = formula, method = "tukey_hsd", p.adjust.method = "Tukey" ) if(is_grouped_df(x)){ results <- x %>% doo(tukey_hsd_core, formula, ...) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "tukey_hsd")) return(results) } tukey_hsd_core (x, formula) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "tukey_hsd")) } tukey_hsd_core <- function(x, formula, ...){ stats::aov(formula, x) %>% tukey_hsd_of_model(...) } tukey_hsd_of_model <- function(model, ...){ comparison <- adj.p.value <- p.adj <- term <- group1 <- group2 <- NULL magic.text <- "_XX.MAGIC.XX_" model %>% replace_eventual_minus_symbols_in_factors(by = magic.text) %>% TukeyHSD( ...) %>% broom::tidy() %>% replace_contrast_colname_by_comparison() %>% separate(comparison, into= c("group2", "group1"), sep = "-") %>% revert_back_eventual_minus_symbols(magic.text) %>% rename(p.adj = adj.p.value) %>% mutate(p.adj = signif(p.adj, 3)) %>% select(term, group1, group2, everything()) %>% add_significance("p.adj") } # Handling possible minus symbols in factor levels replace_eventual_minus_symbols_in_factors <- function(res.aov, by = "_XX.MAGIC.XX_"){ res.aov$model <- res.aov$model %>% dplyr::mutate_if(is.factor, fct_replace_minus, by = by) res.aov } revert_back_eventual_minus_symbols <- function(res.tukey.df, magic.text = "_XX.MAGIC.XX_" ){ res.tukey.df %>% mutate( group1 = gsub(magic.text, replacement = "-", .data$group1, fixed = TRUE), group2 = gsub(magic.text, replacement = "-", .data$group2, fixed = TRUE) ) } fct_replace_minus <- function(.factor, by = "_XX.MAGIC.XX_"){ new.levels <- gsub( pattern = "-", replacement = by, x = levels(.factor), fixed = TRUE ) levels(.factor) <- new.levels .factor } # in broom v>= 0.7.0; contrast is used instead of comparison # so this helper function ensures that "comparison" is used as # column name no matter the version of broom replace_contrast_colname_by_comparison <- function(data){ if("contrast" %in% colnames(data)){ data <- data %>% rename(comparison = .data$contrast) } data } rstatix/R/factors.R0000644000176200001440000000565015074310430013740 0ustar liggesusers#' @include utilities.R NULL #'Factors #' #'@description Provides pipe-friendly functions to convert simultaneously #' multiple variables into a factor variable. #' #' Helper functions are also available to set the reference level and the #' levels order. #' #'@param data a data frame #'@param ... one unquoted expressions (or variable name) specifying the name of #' the variables you want to convert into factor. Alternative to the argument #' \code{vars}. #'@param vars a character vector specifying the variables to convert into #' factor. #'@param name a factor variable name. Can be unquoted. For example, use #' \code{group} or \code{"group"}. #'@param ref the reference level. #'@param order a character vector specifying the order of the factor levels #'@param make.valid.levels logical. Default is FALSE. If TRUE, converts the #' variable to factor and add a leading character (x) if starting with a digit. #'@examples #' # Create a demo data #' df <- tibble( #' group = c("a", "a", "b", "b", "c", "c"), #' time = c("t1", "t2", "t1", "t2", "t1", "t2"), #' value = c(5, 6, 1, 3, 4, 5) #' ) #' df #' # Convert group and time into factor variable #' result <- df %>% convert_as_factor(group, time) #' result #' # Show group levels #' levels(result$group) #' #' # Set c as the reference level (the first one) #' result <- result %>% #' set_ref_level("group", ref = "c") #' levels(result$group) #' #' # Set the order of levels #' result <- result %>% #' reorder_levels("group", order = c("b", "c", "a")) #' levels(result$group) #' #' @describeIn factors Convert one or multiple variables into factor. #' @export convert_as_factor <- function(data, ..., vars = NULL, make.valid.levels = FALSE){ vars <- c(get_dot_vars(...), vars) %>% unique() if(.is_empty(vars)){ return(data) } if(make.valid.levels){ for(variable in vars) { data <- make_valid_levels(data, variable) } } else{ data <- data %>% dplyr::mutate_at(vars, as.factor) } data } #' @describeIn factors Change a factor reference level or group. #' @export set_ref_level <- function(data, name, ref){ .args <- rlang::enquos(name = name) %>% select_quo_variables(data) data[[.args$name]] <- stats::relevel(data[[.args$name]], ref) data } #' @describeIn factors Change the order of a factor levels #' @export reorder_levels <- function(data, name, order){ .args <- rlang::enquos(name = name) %>% select_quo_variables(data) data[[.args$name]] <- factor(data[[.args$name]], levels = order) data } make_valid_levels <- function(data, name){ .args <- rlang::enquos(name = name) %>% select_quo_variables(data) name <- .args$name value <- data %>% pull(!!name) if(is.factor(value)){ levels(value) <- make.names(levels(value), unique = TRUE) } else{ value <- as.character(value) lab <- make.names(unique(value),unique=TRUE) value <- factor(value, levels = unique(value), labels = lab) } data[[name]] <- value data } rstatix/R/cor_test.R0000644000176200001440000001475415074310430014126 0ustar liggesusers#' @include utilities.R #' @importFrom stats as.formula #' @importFrom stats cor.test #' NULL #'Correlation Test #' #' #'@description Provides a pipe-friendly framework to perform correlation test #' between paired samples, using Pearson, Kendall or Spearman method. Wrapper #' around the function \code{\link[stats]{cor.test}()}. #' #' Can also performs multiple pairwise correlation analyses between more than #' two variables or between two different vectors of variables. Using this #' function, you can also compute, for example, the correlation between one #' variable vs many. #' #' #'@inheritParams stats::cor.test #'@inheritParams stats::cor #'@param data a data.frame containing the variables. #'@param vars optional character vector containing variable names for #' correlation analysis. Ignored when dot vars are specified. \itemize{ \item #' If \code{vars} is NULL, multiple pairwise correlation tests is performed #' between all variables in the data. \item If \code{vars} contain only one #' variable, a pairwise correlation analysis is performed between the specified #' variable vs either all the remaining numeric variables in the data or #' variables in \code{vars2} (if specified). \item If \code{vars} contain two #' or more variables: i) if \code{vars2} is not specified, a pairwise #' correlation analysis is performed between all possible combinations of #' variables. ii) if \code{vars2} is specified, each element in \code{vars} is #' tested against all elements in \code{vars2}}. Accept unquoted #' variable names: \code{c(var1, var2)}. #'@param vars2 optional character vector. If specified, each element in #' \code{vars} is tested against all elements in \code{vars2}. Accept unquoted #' variable names: \code{c(var1, var2)}. #'@param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to select a variable of interest. Alternative to the argument #' \code{vars}. #' #'@return return a data frame with the following columns: \itemize{ \item #' \code{var1, var2}: the variables used in the correlation test. \item #' \code{cor}: the correlation coefficient. \item \code{statistic}: Test #' statistic used to compute the p-value. \item \code{p}: p-value. \item #' \code{conf.low,conf.high}: Lower and upper bounds on a confidence interval. #' \item \code{method}: the method used to compute the statistic.} #'@seealso \code{\link{cor_mat}()}, \code{\link{as_cor_mat}()} #' @examples #' #' # Correlation between the specified variable vs #' # the remaining numeric variables in the data #' #::::::::::::::::::::::::::::::::::::::::: #' mtcars %>% cor_test(mpg) #' #' # Correlation test between two variables #' #::::::::::::::::::::::::::::::::::::::::: #' mtcars %>% cor_test(wt, mpg) #' #' # Pairwise correlation between multiple variables #' #::::::::::::::::::::::::::::::::::::::::: #' mtcars %>% cor_test(wt, mpg, disp) #' #' # Grouped data #' #::::::::::::::::::::::::::::::::::::::::: #' iris %>% #' group_by(Species) %>% #' cor_test(Sepal.Width, Sepal.Length) #' #' # Multiple correlation test #' #::::::::::::::::::::::::::::::::::::::::: #' # Correlation between one variable vs many #' mtcars %>% cor_test( #' vars = "mpg", #' vars2 = c("disp", "hp", "drat") #' ) #' #' # Correlation between two vectors of variables #' # Each element in vars is tested against all elements in vars2 #' mtcars %>% cor_test( #' vars = c("mpg", "wt"), #' vars2 = c("disp", "hp", "drat") #' ) #' #' #'@describeIn cor_test correlation test between two or more variables. #'@export cor_test <- function( data, ..., vars = NULL, vars2 = NULL, alternative = "two.sided", method = "pearson", conf.level = 0.95, use = "pairwise.complete.obs" ) { . <- NULL # Accept unquoted variables .args <- rlang::enquos(vars = vars, vars2 = vars2) %>% get_quo_vars_list(data, .) vars <- .args$vars vars2 <- .args$vars2 vars <- data %>% get_selected_vars(..., vars = vars) n.vars <- length(vars) # Select only numeric columns data.numeric <- data %>% select_numeric_columns() if(is.null(vars2)){ if(is.null(vars)){ # Pairwise correlation test between all vars in data vars <- vars2 <- colnames(data.numeric) } else if(n.vars == 1){ # Correlation between the specified variable vs # all numeric vars in the data vars2 <- colnames( data.numeric) %>% setdiff(vars) } else if(n.vars == 2){ # Correlation test between two variables vars2 <- vars[2] vars <- vars[1] } # Multiple pairwise correlation between multiple variables else if(n.vars >2){ vars2 <- vars } } else if(is.null(vars)){ stop("You should specify the argument vars in addition to vars2") } # Multiple correlation tests between two vectors of variables. expand.grid(y = vars2, x = vars, stringsAsFactors = FALSE) %>% as.list() %>% purrr::pmap_dfr( cor_test_xy, data = data, alternative = alternative, method = method, conf.level = conf.level, use = use ) %>% add_class("cor_test") } #::::::::::::::::::::::::::::::::::::::::::::::::::: # Helper functions #::::::::::::::::::::::::::::::::::::::::::::::::::: # Correlation test between two variables x and y #++++++++++++++++++++++++++++++++++++++++++++++++++++ cor_test_xy <- function( data, x, y, method = "pearson", use = "pairwise.complete.obs", ... ) { if(is_grouped_df(data)){ results <- data %>% doo(cor_test_xy, x, y, method = method, use = use, ...) return(results) } # Correlation test, supress the warning when method = "spearman" or "kendall". suppressWarnings(cor.test(data[[x]], data[[y]], method = method, use = use, ...)) %>% as_tidy_cor() %>% add_column(var1 = x, var2 = y, .before = "cor") } # Multiple correlation tests between two vectors of variables. #++++++++++++++++++++++++++++++++++++++++++++++++++++ # x,y character vectors containing variable names to be used in the # correlation analysis. mcor_test <- function(data, x, y, ...){ expand.grid(y = y, x = x, stringsAsFactors = FALSE) %>% as.list() %>% purrr::pmap_dfr(cor_test_xy, data = data, ...) %>% add_class("cor_test") } # Tidy output for correlation test as_tidy_cor <- function(x){ estimate <- cor <- statistic <- p <- conf.low <- conf.high <- method <- NULL res <- x %>% as_tidy_stat() %>% rename(cor = estimate) %>% mutate(cor = signif(cor, 2)) if(res$method == "Pearson"){ res %>% select(cor, statistic, p, conf.low, conf.high, method) } else { res %>% select(cor, statistic, p, method) } } rstatix/R/welch_anova_test.R0000644000176200001440000000423015074310430015615 0ustar liggesusers#' @include utilities.R NULL #' Welch One-Way ANOVA Test #' #' @description Tests for equal means in a one-way design (not assuming equal #' variance). A wrapper around the base function #' \code{\link[stats]{oneway.test}()}. This is is an alternative to the #' standard one-way ANOVA in the situation where the homogeneity of variance #' assumption is violated. #' @param data a data frame containing the variables in the formula. #' @param formula a formula specifying the ANOVA model similar to aov. Can be of #' the form y ~ group where y is a numeric variable giving the data values and #' group is a factor with one or multiple levels giving the corresponding #' groups. For example, formula = TP53 ~ cancer_group. #' @return return a data frame with the following columns: \itemize{ \item #' \code{.y.}: the y variable used in the test. \item \code{n}: sample count. #' \item \code{statistic}: the value of the test statistic. \item \code{p}: #' p-value. \item \code{method}: the statistical test used to compare groups.} #' @examples #' # Load data #' #::::::::::::::::::::::::::::::::::::::: #' data("ToothGrowth") #' df <- ToothGrowth #' df$dose <- as.factor(df$dose) #' #' # Welch one-way ANOVA test (not assuming equal variance) #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% welch_anova_test(len ~ dose) #' #' # Grouped data #' #::::::::::::::::::::::::::::::::::::::::: #' df %>% #' group_by(supp) %>% #' welch_anova_test(len ~ dose) #' @name welch_anova_test #' @export welch_anova_test <- function(data, formula){ args <- as.list(environment()) %>% .add_item(method = "welch_anova_test") data %>% doo(oneway_test, formula) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "welch_anova_test")) } oneway_test <- function(data, formula){ outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) res <- stats::oneway.test(formula, data = data, var.equal = FALSE) tibble( .y. = outcome, n = nrow(data), statistic = round_value(res$statistic, 2), DFn = res$parameter[1], DFd = res$parameter[2], p = round_value(res$p.value, 3), method = "Welch ANOVA" ) } rstatix/R/as_cor_mat.R0000644000176200001440000000240715074310430014403 0ustar liggesusers#' @include utilities.R NULL #' Convert a Correlation Test Data Frame into a Correlation Matrix #' #' @description Convert a correlation test data frame, returned by the #' \code{\link{cor_test}()}, into a correlation matrix format. #' #' @param x an object of class \code{cor_test}. #' @return Returns a data frame containing the matrix of the correlation #' coefficients. The output has an attribute named "pvalue", which contains #' the matrix of the correlation test p-values. #' @seealso \code{\link{cor_mat}()}, \code{\link{cor_test}()} #' @examples #' # Pairwise correlation tests between variables #' #::::::::::::::::::::::::::::::::::::::::::::::: #' res.cor.test <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_test() #' res.cor.test #' #' # Convert the correlation test into a correlation matrix #' #::::::::::::::::::::::::::::::::::::::::::::::: #' res.cor.test %>% as_cor_mat() #' #' @export as_cor_mat <- function(x){ if(!inherits(x, "cor_test")){ stop("x should be an object of class cor_test") } x <- keep_only_tbl_df_classes(x) p.mat <- x %>% cor_spread(value = "p") %>% add_class("pvalue") cor.mat <- x %>% cor_spread(value = "cor") %>% add_class("cor_mat") %>% set_attrs(pvalue = p.mat) cor.mat } rstatix/R/doo.R0000644000176200001440000000631215074310430013054 0ustar liggesusers#' @include utilities.R NULL #'Alternative to dplyr::do for Doing Anything #' #' #'@description Provides a flexible alternative to the \code{dplyr:do()} function. #' Technically it uses \code{nest() + mutate() + map()} to apply arbitrary #' computation to a grouped data frame. #' #' The output is a data frame. If the applied function returns a data frame, #' then the output will be automatically unnested. Otherwise, the output includes the grouping #' variables and a column named ".results." (by default), which is a "list-columns" #' containing the results for group combinations. #' #'@param data a (grouped) data frame #'@param .f A function, formula, or atomic vector. For example #' \code{~t.test(len ~ supp, data = .)}. #' @param ... Additional arguments passed on to .f #' @param result the column name to hold the results. Default is ".results.". #' @return a data frame #' @examples #' # Custom function #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' stat_test <- function(data, formula){ #' t.test(formula, data) %>% #' tidy() #' } #' # Example 1: pipe-friendly stat_test(). #' # Two possibilities of usage are available #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Use this #' ToothGrowth %>% #' group_by(dose) %>% #' doo(~stat_test(data =., len ~ supp)) #' #' # Or this #' ToothGrowth %>% #' group_by(dose) %>% #' doo(stat_test, len ~ supp) #' #' # Example 2: R base function t.test() (not pipe friendly) #' # One possibility of usage #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' comparisons <- ToothGrowth %>% #' group_by(dose) %>% #' doo(~t.test(len ~ supp, data =.)) #' comparisons #' comparisons$.results. #' #' # Example 3: R base function combined with tidy() #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' ToothGrowth %>% #' group_by(dose) %>% #' doo(~t.test(len ~ supp, data =.) %>% tidy()) #'@export doo <- function(data, .f, ..., result = ".results."){ if(is_grouped_df(data)){ .results <- data %>% nest() } else{ .results <- data %>% nest(data = everything()) } .results <- .results %>% dplyr::ungroup() %>% mutate(data = map(.data$data, droplevels)) %>% mutate(data = map(.data$data, .f, ...)) if(inherits(.results$data[[1]], c("data.frame", "tbl_df"))){ # Suppress warning such as: # Binding character and factor vector, coercing into character vector .results <- suppressWarnings(unnest(.results)) } else{ colnames(.results)[ncol(.results)] <- result } if(is_grouped_df(data)){ .groups <- dplyr::group_vars(data) .results <- dplyr::arrange(.results, !!!syms(.groups)) } .results } # To be removed doo_old_version <- function(data, .f, ..., result = ".results."){ .nested <- data %>% nest() %>% dplyr::ungroup() %>% mutate(data = map(data, droplevels)) .computed <- .nested$data %>% map(.f, ...) .results <- .nested %>% select(-data) %>% mutate(!!result := .computed) if(inherits(.computed[[1]], c("data.frame", "tbl_df"))){ # Suppress warning such as: # Binding character and factor vector, coercing into character vector .results <- suppressWarnings(unnest(.results)) } if(is_grouped_df(data)){ .groups <- dplyr::group_vars(data) .results <- dplyr::arrange(.results, !!!syms(.groups)) } .results } rstatix/R/pull_triangle.R0000644000176200001440000000404515074310430015135 0ustar liggesusers#' @include utilities.R replace_triangle.R NULL #' Pull Lower and Upper Triangular Part of a Matrix #' @description Returns the lower or the upper triangular part of a #' (correlation) matrix. #' @param x a (correlation) matrix #' @param diagonal logical. Default is FALSE. If TRUE, the matrix diagonal is #' included. #' @param triangle the triangle to pull. Allowed values are one of #' "upper" and "lower". #' @return an object of class \code{cor_mat_tri}, which is a data frame #' @seealso \code{\link{replace_triangle}()} #' @examples #' #' # Data preparation #' #:::::::::::::::::::::::::::::::::::::::::: #' mydata <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) #' head(mydata, 3) #' #' # Compute correlation matrix and pull triangles #' #:::::::::::::::::::::::::::::::::::::::::: #' # Correlation matrix #' cor.mat <- cor_mat(mydata) #' cor.mat #' #' # Pull lower triangular part #' cor.mat %>% pull_lower_triangle() #' #' # Pull upper triangular part #' cor.mat %>% pull_upper_triangle() #' #' #' @describeIn pull_triangle returns either the lower or upper triangular part of a matrix. #' @export pull_triangle <- function(x, triangle = c("lower", "upper"), diagonal = FALSE){ triangle.to.pull <- match.arg(triangle) triangle.to.replace <- ifelse( triangle.to.pull == "lower", "upper", "lower" ) triangle.class <- paste0(triangle.to.pull, "_tri") res <- x %>% replace_triangle(triangle.to.replace, by = "", diagonal = diagonal) %>% add_class(triangle.class) res } #' @describeIn pull_triangle returns an object of class \code{upper_tri}, which #' is a data frame containing the upper triangular part of a matrix. #' @export pull_upper_triangle <- function(x, diagonal = FALSE){ x %>% pull_triangle("upper", diagonal = diagonal) } #' @describeIn pull_triangle returns an object of class \code{lower_tri}, which #' is a data frame containing the lower triangular part of a matrix. #' @export pull_lower_triangle <- function(x, diagonal = FALSE){ x %>% pull_triangle("lower", diagonal = diagonal) } rstatix/R/prop_test.R0000644000176200001440000002005615074310430014313 0ustar liggesusers#' @include utilities.R NULL #'Proportion Test #'@description Performs proportion tests to either evaluate the homogeneity of #' proportions (probabilities of success) in several groups or to test that the #' proportions are equal to certain given values. #' #' Wrappers around the R base function \code{\link[stats]{prop.test}()} but have #' the advantage of performing pairwise and row-wise z-test of two proportions, #' the post-hoc tests following a significant chi-square test of homogeneity #' for 2xc and rx2 contingency tables. #'@inheritParams stats::prop.test #'@param xtab a cross-tabulation (or contingency table) with two columns and #' multiple rows (rx2 design). The columns give the counts of successes and #' failures respectively. #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #'@param detailed logical value. Default is FALSE. If TRUE, a detailed result is #' shown. #'@param ... Other arguments passed to the function \code{prop_test()}. #' #'@return return a data frame with some the following columns: \itemize{ #' \item \code{n}: the number of participants. #'\item \code{group}: the categories in the row-wise proportion tests. \item #' \code{statistic}: the value of Pearson's chi-squared test statistic. \item #' \code{df}: the degrees of freedom of the approximate chi-squared #' distribution of the test statistic. \item \code{p}: p-value. \item #' \code{p.adj}: the adjusted p-value. \item \code{method}: the used #' statistical test. \item \code{p.signif, p.adj.signif}: the significance #' level of p-values and adjusted p-values, respectively. \item #' \code{estimate}: a vector with the sample proportions x/n. \item #' \code{estimate1, estimate2}: the proportion in each of the two populations. #' \item \code{alternative}: a character string describing the alternative #' hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a #' confidence interval. a confidence interval for the true proportion if there #' is one group, or for the difference in proportions if there are 2 groups and #' p is not given, or NULL otherwise. In the cases where it is not NULL, the #' returned confidence interval has an asymptotic confidence level as specified #' by conf.level, and is appropriate to the specified alternative hypothesis.} #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' @examples #' # Comparing an observed proportion to an expected proportion #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' prop_test(x = 95, n = 160, p = 0.5, detailed = TRUE) #' #' # Comparing two proportions #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: frequencies of smokers between two groups #' xtab <- as.table(rbind(c(490, 10), c(400, 100))) #' dimnames(xtab) <- list( #' group = c("grp1", "grp2"), #' smoker = c("yes", "no") #' ) #' xtab #' # compare the proportion of smokers #' prop_test(xtab, detailed = TRUE) #' #' # Homogeneity of proportions between groups #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # H0: the proportion of smokers is similar in the four groups #' # Ha: this proportion is different in at least one of the populations. #' # #' # Data preparation #' grp.size <- c( 106, 113, 156, 102 ) #' smokers <- c( 50, 100, 139, 80 ) #' no.smokers <- grp.size - smokers #' xtab <- as.table(rbind( #' smokers, #' no.smokers #' )) #' dimnames(xtab) <- list( #' Smokers = c("Yes", "No"), #' Groups = c("grp1", "grp2", "grp3", "grp4") #' ) #' xtab #' #' # Compare the proportions of smokers between groups #' prop_test(xtab, detailed = TRUE) #' #' # Pairwise comparison between groups #' pairwise_prop_test(xtab) #' #' #' # Pairwise proportion tests #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: Titanic #' xtab <- as.table(rbind( #' c(122, 167, 528, 673), #' c(203, 118, 178, 212) #' )) #' dimnames(xtab) <- list( #' Survived = c("No", "Yes"), #' Class = c("1st", "2nd", "3rd", "Crew") #' ) #' xtab #' # Compare the proportion of survived between groups #' pairwise_prop_test(xtab) #' #' # Row-wise proportion tests #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: Titanic #' xtab <- as.table(rbind( #' c(180, 145), c(179, 106), #' c(510, 196), c(862, 23) #' )) #' dimnames(xtab) <- list( #' Class = c("1st", "2nd", "3rd", "Crew"), #' Gender = c("Male", "Female") #' ) #' xtab #' # Compare the proportion of males and females in each category #' row_wise_prop_test(xtab) #' @describeIn prop_test performs one-sample and two-samples z-test of #' proportions. Wrapper around the function \code{\link[stats]{prop.test}()}. #' @export prop_test <- function(x, n, p = NULL, alternative = c("two.sided", "less", "greater"), correct = TRUE, conf.level = 0.95, detailed = FALSE){ args <- as.list(environment()) %>% add_item(method = "prop_test") if(is.data.frame(x)) x <- as.matrix(x) if(inherits(x, c("matrix", "table"))){ if(ncol(x) > 2 & nrow(x) == 2) x <- t(x) nb.grp <- nrow(x) row.sums <- rowSums(x) n <- sum(x) Ns <- matrix(c(n, row.sums), nrow = 1, ncol = nb.grp+1) colnames(Ns) <- c("n", paste0("n", 1:nb.grp)) } else{ row.sums <- x nb.grp <- length(x) Ns <- matrix(c(sum(n), row.sums), nrow = 1, ncol = nb.grp+1) colnames(Ns) <- c("n", paste0("n", 1:nb.grp)) } Ns <- as_tibble(Ns) results <- stats::prop.test(x, n, p, alternative, conf.level, correct) %>% as_tidy_stat() %>% add_significance("p") %>% mutate(method = "Prop test") results <- dplyr::bind_cols(Ns, results) if(!detailed) results <- remove_details(results, method = "prop.test") results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "prop_test")) } #' @describeIn prop_test pairwise comparisons between proportions, a post-hoc #' tests following a significant chi-square test of homogeneity for 2xc #' design. Wrapper around \code{\link[stats]{pairwise.prop.test}()} #' @export pairwise_prop_test <- function(xtab, p.adjust.method = "holm", ...){ if(is.data.frame(xtab)) xtab <- as.matrix(xtab) if(ncol(xtab) > 2 & nrow(xtab) == 2) xtab <- t(xtab) args <- c(as.list(environment()), list(...)) %>% add_item(method = "prop_test") results <- stats::pairwise.prop.test( xtab, p.adjust.method = "none", ... ) %>% tidy() %>% select(.data$group2, .data$group1, .data$p.value) colnames(results) <- c("group1", "group2", "p") results <- results %>% adjust_pvalue(method = p.adjust.method) %>% add_significance("p.adj") %>% mutate( p = signif(.data$p, digits = 3), p.adj = signif(.data$p.adj, digits = 3) ) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "prop_test")) } #' @describeIn prop_test performs row-wise z-test of two proportions, a post-hoc tests following a significant chi-square test #' of homogeneity for rx2 contingency table. The z-test of two proportions is calculated for each category (row). #' @export row_wise_prop_test <- function(xtab, p.adjust.method = "holm", detailed = FALSE, ...){ if(is.data.frame(xtab)) xtab <- as.matrix(xtab) if(!inherits(xtab, c("matrix", "table"))){ stop("An object of class 'matrix' or 'table' required") } if(ncol(xtab) !=2){ stop("A cross-tabulation with two columns required") } args <- c(as.list(environment()), list(...)) %>% add_item(method = "prop_test") columns.total <- margin.table(xtab, 2) results <- apply( xtab, MARGIN = 1, FUN = prop_test, n = columns.total, detailed = detailed, ... ) %>% map(keep_only_tbl_df_classes) %>% bind_rows(.id = "group") %>% adjust_pvalue(method = p.adjust.method) %>% add_significance("p.adj") %>% mutate( p = signif(.data$p, digits = 3), p.adj = signif(.data$p.adj, digits = 3) ) %>% select(-.data$p.signif) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "prop_test")) } rstatix/R/sample_n_by.R0000644000176200001440000000114115074310430014556 0ustar liggesusers#' @include utilities.R NULL #' Sample n Rows By Group From a Table #' #' @description sample n rows by group from a table using the \code{\link[dplyr]{sample_n}()} function. #' #' @param data a data frame #' @param ... Variables to group by #' @param size the number of rows to select #' @param replace with or without replacement? #' #' @examples #' ToothGrowth %>% sample_n_by(dose, supp, size = 2) #' @name sample_n_by #' @export sample_n_by <- function(data, ..., size = 1, replace = FALSE){ data %>% group_by(...) %>% dplyr::sample_n(size = size, replace = replace) %>% dplyr::ungroup() } rstatix/R/cor_mark_significant.R0000644000176200001440000000230115074310430016440 0ustar liggesusers#' @include utilities.R add_significance.R pull_triangle.R NULL #' Add Significance Levels To a Correlation Matrix #' @description Combines correlation coefficients and significance levels in a #' correlation matrix data. #' @inheritParams add_significance #' @param x an object of class \code{\link{cor_mat}()}. #' @return a data frame containing the lower triangular part of the correlation #' matrix marked by significance symbols. #' @examples #' mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_mat() %>% #' cor_mark_significant() #' @export cor_mark_significant <- function(x, cutpoints = c(0, 0.0001, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "")) { if(!inherits(x, c("cor_mat", "cor_mat_tri"))) stop("x should be an object of class cor_mat or cor_mat_tri.") cor <- p.signif <- var1 <- var2 <- NULL res <- x %>% cor_gather (drop.na = FALSE) %>% add_significance(cutpoints = cutpoints, symbols = symbols) %>% mutate(cor = paste0(cor, p.signif)) %>% select(var1, var2, cor) %>% cor_spread() if(inherits(x, "upper_tri")) res %>% pull_upper_triangle() else res %>% pull_lower_triangle() } rstatix/R/shapiro_test.R0000644000176200001440000000627415074310430015006 0ustar liggesusers#' @include utilities.R #' @importFrom stats shapiro.test #' @importFrom stats complete.cases NULL #' Shapiro-Wilk Normality Test #' #' @description Provides a pipe-friendly framework to performs Shapiro-Wilk test #' of normality. Support grouped data and multiple variables for multivariate #' normality tests. Wrapper around the R base function #' \code{\link[stats]{shapiro.test}()}. Can handle grouped data. Read more: #' \href{https://www.datanovia.com/en/lessons/normality-test-in-r/}{Normality #' Test in R}. #' @param data a data frame. Columns are variables. #' @param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to select a variable of interest. #' @param vars optional character vector containing variable names. Ignored when #' dot vars are specified. #' @return a data frame containing the value of the Shapiro-Wilk statistic and #' the corresponding p.value. #' @examples #' #' # Shapiro Wilk normality test for one variable #' iris %>% shapiro_test(Sepal.Length) #' #' # Shapiro Wilk normality test for two variables #' iris %>% shapiro_test(Sepal.Length, Petal.Width) #' #' # Multivariate normality test #' mshapiro_test(iris[, 1:3]) #' #' @describeIn shapiro_test univariate Shapiro-Wilk normality test #' @export shapiro_test <- function(data, ..., vars = NULL){ if(is_grouped_df(data)){ results <- data %>% doo(shapiro_test, ..., vars = vars) return(results) } else if(is.numeric(data)){ results <- shapiro.test(data) data.name <- deparse(substitute(data)) results <- tidy(results) %>% add_column(variable = data.name, .before = 1) %>% select(-.data$method) return(results) } vars <- c(get_dot_vars(...), vars) %>% unique() n.vars <- length(vars) if(.is_empty(vars)){ stop("Specify one or more variables...") } data <- data %>% select(!!!syms(vars)) variable <- value <- method <- NULL data <- data %>% tidyr::pivot_longer(everything(), names_to = "variable", values_to = "value") %>% filter(!is.na(value)) data %>% group_by(variable) %>% doo(~tidy(shapiro.test(.$value))) %>% select(-.data$method) %>% rename(p = .data$p.value) } #' @describeIn shapiro_test multivariate Shapiro-Wilk normality test. This is a #' modified copy of the \code{mshapiro.test()} function of the package #' mvnormtest, for internal convenience. #' @export mshapiro_test <- function(data) { if(is_grouped_df(data)){ results <- data %>% doo(~shapiro.test(.)) } x <- data if (!is.matrix(x)) { x <- as.matrix(x) } x <- x[complete.cases(x), ] x <- t(x) n <- ncol(x) if (n < 3 || n > 5000) { stop("sample size must be between 3 and 5000") } rng <- range(x) rng <- rng[2] - rng[1] if (rng == 0) { stop("all `x[]' are identical") } Us <- apply(x, 1, mean) R <- x - Us M.1 <- solve(R %*% t(R), tol = 1e-18) Rmax <- diag(t(R) %*% M.1 %*% R) C <- M.1 %*% R[, which.max(Rmax)] Z <- t(C) %*% x result <- shapiro.test(Z) result$method <- "Multivariate Shapiro-Wilk normality test" result$data.name <- paste("(", paste(rownames(x), collapse = ","), ")", sep = "") tidy(result) %>% select(-.data$method) } rstatix/R/get_pvalue_position.R0000644000176200001440000004013015074310430016346 0ustar liggesusers#' @include utilities.R NULL #'Autocompute P-value Positions For Plotting Significance #'@description Compute p-value x and y positions for plotting significance #' levels. Many examples are provided at : \itemize{ \item #' \href{https://www.datanovia.com/en/blog/how-to-add-p-values-onto-a-grouped-ggplot-using-the-ggpubr-r-package/}{How #' to Add P-Values onto a Grouped GGPLOT using the GGPUBR R Package} \item #' \href{https://www.datanovia.com/en/blog/ggpubr-how-to-add-adjusted-p-values-to-a-multi-panel-ggplot/}{How #' to Add Adjusted P-values to a Multi-Panel GGPlot} \item #' \href{https://www.datanovia.com/en/blog/ggpubr-how-to-add-p-values-generated-elsewhere-to-a-ggplot/}{How #' to Add P-Values Generated Elsewhere to a GGPLOT} } #'@inheritParams t_test #'@param ref.group a character string specifying the reference group. If #' specified, for a given grouping variable, each of the group levels will be #' compared to the reference group (i.e. control group). #'@param fun summary statistics functions used to compute automatically suitable #' y positions of p-value labels and brackets. Possible values include: #' \code{"max", "mean", "mean_sd", "mean_se", "mean_ci", "median", #' "median_iqr", "median_mad"}. #' #' For example, if \code{fun = "max"}, the y positions are guessed as follow: #' \itemize{ \item 1. Compute the maximum of each group (groups.maximum) \item #' 2. Use the highest groups maximum as the first bracket y position \item 3. #' Add successively a step increase for remaining bracket y positions. } #' #' When the main plot is a boxplot, you need the option \code{fun = "max"}, to #' have the p-value bracket displayed at the maximum point of the group. #' #' In some situations the main plot is a line plot or a barplot showing the #' \code{mean+/-error bars} of the groups, where error can be SE (standard #' error), SD (standard deviation) or CI (confidence interval). In this case, #' to correctly compute the bracket y position you need the option \code{fun = #' "mean_se"}, etc. #'@param step.increase numeric vector with the increase in fraction of total #' height for every additional comparison to minimize overlap. #'@param y.trans a function for transforming y axis scale. Value can be #' \code{log2}, \code{log10} and \code{sqrt}. Can be also any custom function #' that can take a numeric vector as input and returns a numeric vector, #' example: \code{y.trans = function(x){log2(x+1)}} #'@param test an object of class \code{rstatix_test} as returned by #' \code{\link{t_test}()}, \code{\link{wilcox_test}()}, #' \code{\link{sign_test}()}, \code{\link{tukey_hsd}()}, #' \code{\link{dunn_test}()}. #'@param x variable on x axis. #'@param group group variable (legend variable). #'@param dodge dodge width for grouped ggplot/test. Default is 0.8. Used only #' when \code{x} specified. #'@param stack logical. If TRUE, computes y position for a stacked plot. Useful #' when dealing with stacked bar plots. #'@param scales Should scales be fixed (\code{"fixed"}, the default), free #' (\code{"free"}), or free in one dimension (\code{"free_y"})?. This option is #' considered only when determining the y position. If the specified value is #' \code{"free"} or \code{"free_y"}, then the step increase of y positions will #' be calculated by plot panels. Note that, using \code{"free"} or #' \code{"free_y"} gives the same result. A global step increase is computed #' when \code{scales = "fixed"}. #' @examples #' # Data preparation #' #:::::::::::::::::::::::::::::::::::: #' df <- ToothGrowth #' df$dose <- as.factor(df$dose) #' df$group <- factor(rep(c(1, 2), 30)) #' head(df) #' #' # Stat tests #' #:::::::::::::::::::::::::::::::::::: #' stat.test <- df %>% #' t_test(len ~ dose) #' stat.test #' #' # Add the test into box plots #' #:::::::::::::::::::::::::::::::::::: #' stat.test <- stat.test %>% #' add_y_position() #' \donttest{ #' if(require("ggpubr")){ #' ggboxplot(df, x = "dose", y = "len") + #' stat_pvalue_manual(stat.test, label = "p.adj.signif", tip.length = 0.01) #' } #' } #'@describeIn get_pvalue_position compute the p-value y positions #'@export get_y_position <- function(data, formula, fun = "max", ref.group = NULL, comparisons = NULL, step.increase = 0.12, y.trans = NULL, stack = FALSE, scales = c("fixed", "free", "free_y")){ # Estimate step increase # 1. Get groups y scale outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) if(.is_empty(group)) group <- NULL if(is_grouped_df(data)) group <- c(group , dplyr::group_vars(data)) yscale <- get_y_scale(data, outcome, group, fun, stack = stack) # 2. Step increase # If fixed scales, then a global step increase is computed, # otherwise step.increase is estimated by panel in get_y_position_core(). scales <- match.arg(scales) if(scales == "fixed"){ step.increase <- step.increase*(yscale$max - yscale$min) } get_y_position_core( data = data, formula = formula, fun = fun, ref.group = ref.group, comparisons = comparisons, step.increase = step.increase, y.trans = y.trans, stack = stack, scales = scales ) } get_y_position_core <- function(data, formula, fun = "max", ref.group = NULL, comparisons = NULL, step.increase = 0.12, y.trans = NULL, stack = FALSE, scales = "fixed"){ if(is_grouped_df(data)){ results <- data %>% doo( get_y_position_core, formula = formula, fun = fun, ref.group = ref.group, comparisons = comparisons, step.increase = step.increase, y.trans = y.trans, stack = stack, scales = scales ) return(results) } outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) # Possible comparisons between groups if(is.null(comparisons)){ if(.is_empty(group)){ comparisons <- list(c("1", "null model")) } else{ comparisons <- data %>% get_comparisons(!!group, !!ref.group) } } ncomparisons <- length(comparisons) group1 <- comparisons %>% get_group(1) group2 <- comparisons %>% get_group(2) k <- 1.08 # Estimate y axis scale yscale <- get_y_scale(data, y = outcome, group = group, fun = fun, stack = stack) if(is.null(step.increase)) step.increase <- yscale$max/20 else if(scales %in% c("free", "free_y")){ step.increase <- step.increase*(yscale$max - yscale$min) } # ystart <- k*yscale$max ystart <- yscale$max + step.increase yend <- ystart + (step.increase*ncomparisons) if(is.null(ref.group)) ref.group <- "" if(ref.group %in% c("all", ".all.")){ # y.position <- yscale$y*k y.position <- yscale$y + step.increase } else{ y.position <- seq( from = ystart, to = yend, length.out = ncomparisons ) } if(!is.null(y.trans)) y.position <- y.trans(y.position) results <- tibble(group1, group2, y.position) %>% mutate(groups = combine_this(group1, group2)) results } #' @describeIn get_pvalue_position add p-value y positions to an object of class \code{rstatix_test} #' @export add_y_position <- function(test, fun = "max", step.increase = 0.12, data = NULL, formula = NULL, ref.group = NULL, comparisons = NULL, y.trans = NULL, stack = FALSE, scales = c("fixed", "free", "free_y")) { scales <- match.arg(scales) asserttat_group_columns_exists(test) .attributes <- get_test_attributes(test) args <- get_test_arguments(test) test <- keep_only_tbl_df_classes(test) if(!is.null(args)){ if(missing(data)) data <- args$data if(missing(formula)) formula <- args$formula if(missing(ref.group)) ref.group <- args$ref.group if(missing(comparisons)) comparisons <- args$comparisons } if(is.null(data) | is.null(formula)){ stop("data and formula arguments should be specified.") } positions <- get_y_position( data = data, formula = formula, fun = fun, ref.group = ref.group, comparisons = comparisons, step.increase = step.increase, y.trans = y.trans, stack = stack, scales = scales ) if(nrow(test) == nrow(positions)){ test$y.position <- positions$y.position test$groups <- positions$groups } else{ # this occurs when tests are grouped by two variables (for ex), # but y positions are grouped by one variable # merging positions and test data frame if("y.position" %in% colnames(test)){ test <- test %>% select(-.data$y.position) } if("groups" %in% colnames(test)){ test <- test %>% select(-.data$groups) } common.columns <- intersect(colnames(test), colnames(positions)) test <- test %>% dplyr::left_join(positions, by = common.columns) } test %>% set_test_attributes(.attributes) } # Compute y scale depending on fun get_y_scale <- function(data, y, group, fun = "max", stack = FALSE){ if(!.is_empty(group)){ desc.stat <- data %>% group_by(!!!syms(group)) %>% get_summary_stats(!!y, type = fun) } else { desc.stat <- data %>% get_summary_stats(!!y, type = fun) } # Add error bars positions if any fun.splitted <- unlist(strsplit(fun, "_", fixed = TRUE)) .center <- fun.splitted[1] .error <- ifelse(length(fun.splitted) == 2, fun.splitted[2], 0) .center <- desc.stat %>% pull(!!.center) if(.error != 0) .error <- desc.stat %>% pull(!!.error) if(stack){ .center <- rep(sum(.center), length(.center)) } y <- .center + .error ymax <- max(y, na.rm = TRUE) ymin <- min(y, na.rm = TRUE) list(y = y, max = ymax, min = ymin) } # Return group1 and group2 values from possible pairs get_group <- function(possible.pairs, index){ possible.pairs %>% map( function(x){as.character(x[index])}) %>% unlist() } # Combine vectors: c(a, b) & c(c, d) --> list(c(a, c), c(b, d)) # ... two or more character vectors combine_this <- function(...){ params <- list(...) purrr::pmap(params, c) } #' @describeIn get_pvalue_position compute and add p-value x positions. #' @export add_x_position <- function(test, x = NULL, group = NULL, dodge = 0.8){ # Checking asserttat_group_columns_exists(test) .attributes <- get_test_attributes(test) if(any(test$group1 %in% c("all", ".all."))) { # case when ref.group = "all" test$group1 <- test$group2 } groups <- c(as.character(test$group1), as.character(test$group2)) %>% unique() %>% setdiff(c("all", ".all.")) # case when ref.group = "all" is_rstatix_test <- inherits(test, "rstatix_test") is.null.model <- ("null model" %in% test$group2) & all(test$group1 %in% 1) is.grouped.by.legend <- test %>% is_stat_test_grouped_by(group) is.grouped.by.x <- test %>% is_stat_test_grouped_by(x) is.basic <- !is.grouped.by.x & !is.grouped.by.legend # Data preparation if(is_rstatix_test) { data <- attr(test, "args")$data if(is.basic & is.null(x)) x <- get_formula_right_hand_side(.attributes$args$formula) else if(is.grouped.by.x & is.null(group)) group <- get_formula_right_hand_side(.attributes$args$formula) } else if(is.basic){ data <- data.frame(x = groups, stringsAsFactors = FALSE) x <- "x" } else{ if(is.grouped.by.x) data <- expand.grid(x = unique(test[[x]]), group = groups) else if(is.grouped.by.legend) data <- expand.grid(x = groups, group = test[[group]]) colnames(data) <- c(x, group) } if(is.null.model) { data$group <- rep(1, nrow(data)) group <- "group" } # Add xmin and x max if(is.basic){ x_coords <- as_numeric_group(data[[x]]) xmin_id <- as.character(test$group1) xmax_id <- as.character(test$group2) } else{ x_coords <- get_grouped_x_position(data, x = x, group = group, dodge = dodge) if(is.grouped.by.legend){ # Add x position to stat test when the test is grouped by the legend variable # Case when you group by legend and pairwise compare between x-axis groups xmin_id <- paste(test$group1, test[[group]], sep = "_") xmax_id <- paste(test$group2, test[[group]], sep = "_") } else if(is.grouped.by.x){ # Add x position to stat test when the test is grouped by the x variable # Case when you pairwise compare legend groups at each x-axis position, # so the data is grouped by x position xmin_id <- paste(test[[x]], test$group1, sep = "_") xmax_id <- paste(test[[x]], test$group2, sep = "_") test$x <- unname(as_numeric_group(test[[x]])) } } test$xmin <- unname(x_coords[xmin_id]) test$xmax <- unname(x_coords[xmax_id]) if(is.null.model) test$xmax <- test$xmin test %>% set_test_attributes(.attributes) } # Compute grouped x positions or coordinates # data is a dataframe containing the x and the group columns get_grouped_x_position<- function(data, x, group, dodge = 0.8){ data <- data.frame(x = data[[x]], group = data[[group]]) %>% dplyr::distinct(.data$x, .data$group) %>% dplyr::arrange(.data$x, .data$group) data$x.position <- as_numeric_group(data$x) # Add group.ranks and ngroups at x position data <- data %>% rstatix::df_nest_by(vars = "x") %>% mutate( data = map(.data$data, function(data){data$group.ranks = 1:nrow(data); data}), n = unlist(map(.data$data, nrow)) ) %>% tidyr::unnest(cols = "data") # Compute x coords d <- data x_coords <- (((dodge - dodge*d$n) / (2*d$n)) + ((d$group.ranks - 1) * (dodge / d$n))) + d$x.position names(x_coords) <- paste(d$x, d$group, sep = "_") x_coords } # Check if a stat test is grouped by a given variable is_stat_test_grouped_by <- function(test, x = NULL){ answer <- FALSE if(!is.null(x)){ if(x %in% colnames(test)){ answer <- TRUE } } answer } # Return a numeric named vector # c("a", "b", "a") -> c(a = 1, b = 2, a = 1) as_numeric_group <- function(x){ grp <- x %>% as.factor() %>% as.numeric() names(grp) <- x grp } #' @describeIn get_pvalue_position compute and add both x and y positions. #' @export add_xy_position <- function(test, x = NULL, group = NULL, dodge = 0.8, stack = FALSE, fun = "max", step.increase = 0.12, scales = c("fixed", "free", "free_y"), ...){ if(missing(dodge)){ if(stack) dodge <- 0 } test %>% add_y_position( fun = fun, step.increase = step.increase, stack = stack, scales = scales, ... ) %>% add_x_position(x = x, group = group, dodge = dodge) } # Helper functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% asserttat_group_columns_exists <- function(data){ groups.exist <- all(c("group1", "group2") %in% colnames(data)) if(!groups.exist){ stop("data should contain group1 and group2 columns") } } .is_grouped_test <- function(test, x = NULL){ answer <- FALSE if(!is.null(x)){ if(x %in% colnames(test)){ answer <- TRUE } } answer } .contains_selected_comparisons <- function(test){ answer <- FALSE if(is_rstatix_test(test)){ comparisons <- attr(test, "args")$comparisons answer <- !is.null(comparisons) } answer } # To be removed add_x_position0 <- function(test, x = NULL, dodge = 0.8){ asserttat_group_columns_exists(test) .attributes <- get_test_attributes(test) group1 <- set_diff(test$group1, c("all", ".all."), keep.dup = TRUE) group2 <- set_diff(test$group2, c("all", ".all."), keep.dup = TRUE) groups <- unique(c(group1, group2)) if(.contains_selected_comparisons(test)){ # get all data groups group.var <- get_formula_right_hand_side(.attributes$args$formula) groups <- .attributes$args$data %>% convert_as_factor(vars = group.var) %>% pull(!!group.var) %>% levels() } group1.coords <- group1.ranks <- match(group1, groups) group2.coords <- group2.ranks <- match(group2, groups) n <- length(groups) if(.is_grouped_test(test, x)){ test <- test %>% .as_factor(x) %>% mutate(x = as.numeric(!!sym(x))) # x levels order xpos <- test$x group1.coords <- (((dodge - dodge*n) / (2*n)) + ((group1.ranks - 1) * (dodge / n))) + xpos group2.coords <- (((dodge - dodge*n) / (2*n)) + ((group2.ranks - 1) * (dodge / n))) + xpos } if(.is_empty(group1)) { # case when ref.group = "all" group1.coords <- group2.coords } test %>% mutate(xmin = group1.coords, xmax = group2.coords) %>% set_test_attributes(.attributes) } rstatix/R/wilcox_effsize.R0000644000176200001440000001641115074310430015314 0ustar liggesusers#' @include utilities.R utilities_two_sample_test.R NULL #'Wilcoxon Effect Size #'@description Compute Wilcoxon effect size (\code{r}) for: \itemize{ \item #' one-sample test (Wilcoxon one-sample signed-rank test); \item paired #' two-samples test (Wilcoxon two-sample paired signed-rank test) and \item #' independent two-samples test ( Mann-Whitney, two-sample rank-sum test). } #' #' It can also returns confidence intervals by bootstap. #' #' The effect size \code{r} is calculated as \code{Z} statistic divided by #' square root of the sample size (N) (\eqn{Z/\sqrt{N}}). The \code{Z} value is #' extracted from either \code{coin::wilcoxsign_test()} (case of one- or #' paired-samples test) or \code{coin::wilcox_test()} (case of independent #' two-samples test). #' #' Note that \code{N} corresponds to total sample size for independent samples #' test and to total number of pairs for paired samples test. #' #' The \code{r} value varies from 0 to close to 1. The interpretation values #' for r commonly in published litterature and on the internet are: \code{0.10 #' - < 0.3} (small effect), \code{0.30 - < 0.5} (moderate effect) and \code{>= #' 0.5} (large effect). #' #'@inheritParams wilcox_test #'@param ci If TRUE, returns confidence intervals by bootstrap. May be slow. #'@param conf.level The level for the confidence interval. #'@param ci.type The type of confidence interval to use. Can be any of "norm", #' "basic", "perc", or "bca". Passed to \code{boot::boot.ci}. #'@param nboot The number of replications to use for bootstrap. #'@param ... Additional arguments passed to the functions #' \code{coin::wilcoxsign_test()} (case of one- or paired-samples test) or #' \code{coin::wilcox_test()} (case of independent two-samples test). #'@return return a data frame with some of the following columns: \itemize{ #' \item \code{.y.}: the y variable used in the test. \item #' \code{group1,group2}: the compared groups in the pairwise tests. \item #' \code{n,n1,n2}: Sample counts. \item \code{effsize}: estimate of the effect #' size (\code{r} value). \item \code{magnitude}: magnitude of effect size. #' \item \code{conf.low,conf.high}: lower and upper bound of the effect size #' confidence interval.} #'@references Maciej Tomczak and Ewa Tomczak. The need to report effect size #' estimates revisited. An overview of some recommended measures of effect #' size. Trends in Sport Sciences. 2014; 1(21):19-25. #' @examples #' if(require("coin")){ #' #' # One-sample Wilcoxon test effect size #' ToothGrowth %>% wilcox_effsize(len ~ 1, mu = 0) #' #' # Independent two-samples wilcoxon effect size #' ToothGrowth %>% wilcox_effsize(len ~ supp) #' #' #' # Paired-samples wilcoxon effect size #' ToothGrowth %>% wilcox_effsize(len ~ supp, paired = TRUE) #' #' # Pairwise comparisons #' ToothGrowth %>% wilcox_effsize(len ~ dose) #' #' # Grouped data #' ToothGrowth %>% #' group_by(supp) %>% #' wilcox_effsize(len ~ dose) #' #' } #'@export wilcox_effsize <- function(data, formula, comparisons = NULL, ref.group = NULL, paired = FALSE, alternative = "two.sided", mu = 0, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ...){ env <- as.list(environment()) args <- env %>% .add_item(method = "wilcox_effsize") params <- c(env, list(...)) %>% remove_null_items() %>% add_item(method = "coin.wilcox.test", detailed = FALSE) outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(number.of.groups > 2 & !is.null(ref.group)){ if(ref.group %in% c("all", ".all.")){ params$data <- create_data_with_all_ref_group(data, outcome, group) params$ref.group <- "all" } } test.func <- two_sample_test if(number.of.groups > 2) test.func <- pairwise_two_sample_test res <- do.call(test.func, params) %>% select(.data$.y., .data$group1, .data$group2, .data$estimate, everything()) %>% rename(effsize = .data$estimate) %>% mutate(magnitude = get_wilcox_effsize_magnitude(.data$effsize)) %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "wilcox_effsize")) res } # Wilcoxon test using coin R package; returns effect size coin.wilcox.test <- function(x, y = NULL, mu = 0, paired = FALSE, alternative = c("two.sided", "less", "greater"), ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ...){ required_package("coin") alternative <- match.arg(alternative) check_two_samples_test_args( x = x, y = y, mu = mu, paired = paired, conf.level = conf.level ) if (!is.null(y)) { DNAME <- paste(deparse(substitute(x)), "and", deparse(substitute(y))) if (paired) { # Transform paired test into one-sample test problem OK <- complete.cases(x, y) x <- x[OK] - y[OK] y <- NULL METHOD <- "Paired Wilcoxon test (coin)" } else { x <- x[is.finite(x)] y <- y[is.finite(y)] METHOD <- "Independent Wilcoxon test (coin)" } } else { DNAME <- deparse(substitute(x)) METHOD <- "One-sample Wilcoxon test (coin)" x <- x[is.finite(x)] } if(is.null(y)){ y <- rep(mu, length(x)) test.type <- "symmetry" } else{ group <- rep(c("grp1", "grp2"), times = c(length(x), length(y))) %>% factor() x <- c(x, y) y <- group test.type <- "independence" } data <- data.frame(x, y) results <- coin_wilcox_test( data, x ~ y, type = test.type, alternative = alternative, ... ) # Confidence interval of the effect size r if (ci == TRUE) { stat.func <- function(data, subset) { coin_wilcox_test( data, formula = x ~ y, subset = subset, type = test.type, alternative = alternative, ... )$r } CI <- get_boot_ci( data, stat.func, conf.level = conf.level, type = ci.type, nboot = nboot ) results <- results %>% mutate(conf.low = CI[1], conf.high = CI[2]) } RVAL <- list(statistic = results$z, parameter = results$n, p.value = results$p, null.value = mu, alternative = alternative, method = METHOD, data.name = DNAME, estimate = results$r) if (ci) { attr(CI, "conf.level") <- conf.level RVAL <- c(RVAL, list(conf.int = CI)) } names(RVAL$statistic) <- "Z" names(RVAL$parameter) <- "n" names(RVAL$estimate) <- "Effect size (r)" class(RVAL) <- "htest" RVAL } # Perform wilcoxon test using coin package coin_wilcox_test <- function(data, formula, subset = NULL, type = c("independence", "symmetry"), ...){ type <- match.arg(type) coin_wilcox_test_func <- switch ( type, independence = coin::wilcox_test, symmetry = coin::wilcoxsign_test ) if(!is.null(subset)) data <- data[subset, ] res.wilcox <-suppressWarnings(coin_wilcox_test_func(formula, data = data,...)) n <- nrow(data) z <- as.vector(coin::statistic(res.wilcox, type = "standardized")) p <- coin::pvalue(res.wilcox) r <- abs(z)/sqrt(n) # Effect size tibble(n = n, z = z, r = r, p = p) } get_wilcox_effsize_magnitude <- function(d){ magnitude.levels = c(0.3, 0.5, Inf) magnitude = c("small","moderate","large") d.index <- findInterval(abs(d), magnitude.levels)+1 magnitude <- factor(magnitude[d.index], levels = magnitude, ordered = TRUE) magnitude } rstatix/R/cochran_qtest.R0000644000176200001440000001000015074310430015115 0ustar liggesusers#' @include utilities.R NULL #'Cochran's Q Test #'@description Performs the Cochran's Q test for unreplicated randomized block #' design experiments with a binary response variable and paired data. This #' test is analogue to the \code{\link{friedman.test}()} with 0,1 coded #' response. It's an extension of the McNemar Chi-squared test for comparing #' more than two paired proportions. #'@param data a data frame containing the variables in the formula. #'@param formula a formula of the form \code{a ~ b | c}, where \code{a} is the #' outcome variable name; b is the within-subjects factor variables; and c #' (factor) is the column name containing individuals/subjects identifier. #' Should be unique per individual. #'@examples #' # Generate a demo data #' mydata <- data.frame( #' outcome = c(0,1,1,0,0,1,0,1,1,1,1,1,0,0,1,1,0,1,0,1,1,0,0,1,0,1,1,0,0,1), #' treatment = gl(3,1,30,labels=LETTERS[1:3]), #' participant = gl(10,3,labels=letters[1:10]) #' ) #' mydata$outcome <- factor( #' mydata$outcome, levels = c(1, 0), #' labels = c("success", "failure") #' ) #' # Cross-tabulation #' xtabs(~outcome + treatment, mydata) #' #' # Compare the proportion of success between treatments #' cochran_qtest(mydata, outcome ~ treatment|participant) #' #' # pairwise comparisons between groups #' pairwise_mcnemar_test(mydata, outcome ~ treatment|participant) #' #'@export cochran_qtest <- function(data, formula){ args <- as.list(environment()) %>% add_item(method = "cochran_qtest") friedman_test(data, formula) %>% keep_only_tbl_df_classes() %>% mutate(method = "Cochran's Q test") %>% remove_class("friedman_test") %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "cochran_qtest")) } # http://geai.univ-brest.fr/carpentier/2008-2009/Notes-Cochran-Q.pdf exact_cochran_qtest <- function(data, formula, nboot = 500) { # Data preparation data <- data %>% select(!!!syms(all.vars(formula))) colnames(data) <- c("outcome", "groups", "participant") nb.outcome <- length(unique(data$outcome)) if(nb.outcome > 2 | nb.outcome == 1){ stop("Unique possible outcome values should be 2") } # Convert outcome into 0/1 if(!is.numeric(data$outcome)){ data$outcome <- as.numeric(as.factor(data$outcome)) - 1 } if(!all(unique(data$outcome) %in% c(0, 1))){ stop("Outcome values should be 0 or 1") } data.wide <- data %>% spread(key = "groups", value = "outcome") %>% select(-.data$participant) nb.row <- nrow(data.wide) nb.col <- ncol(data.wide) results <- cochran_qtest(data, outcome ~ groups|participant) qobs <- results$statistic freq <- 0 perm <- permutations(nb.col) # perm.list <- purrr::array_tree(perm) for (boot in 1:nboot) { data.permutated <- data.wide k <- 1+ as.integer(stats::runif(nb.row)*gamma(nb.col+1)) for (j in 1:nb.row) { k <- 1+ as.integer(stats::runif(1)*gamma(nb.col+1)) data.permutated[j,] <- data.wide[j, perm[k,]] } qperm <- get_cochran_q(data.permutated) if (qperm >= qobs) {freq <- freq + 1}} results %>% select(-.data$df) %>% mutate( p = freq/nboot, method = "Exact Cochran's Q test" ) } # e1071::permutations # Returns a matrix containing all permutations of the integers 1:n (one permutation per row). permutations <- function (n) { if (n == 1) return(matrix(1)) else if (n < 2) stop("n must be a positive integer") z <- matrix(1) for (i in 2:n) { x <- cbind(z, i) a <- c(1:i, 1:(i - 1)) z <- matrix(0, ncol = ncol(x), nrow = i * nrow(x)) z[1:nrow(x), ] <- x for (j in 2:i - 1) { z[j * nrow(x) + 1:nrow(x), ] <- x[, a[1:i + j]] } } dimnames(z) <- NULL z } get_cochran_q <- function(data.wide){ # Compute rows and column totals row.total <- apply(data.wide, 1, sum) column.total <- apply(data.wide, 2, sum) grand.total <- sum(data.wide) k <- ncol(data.wide) # Cochran's Q test statistic numerator <- sum((column.total - (grand.total/k))^2) denominator <- sum(row.total * (k - row.total)) q = k*(k-1)*(numerator/denominator) q } rstatix/R/reexports.R0000644000176200001440000000120415074310430014321 0ustar liggesusers#' @importFrom tibble tibble #' @export tibble::tibble #' @importFrom dplyr mutate #' @export dplyr::mutate #' @importFrom dplyr filter #' @export dplyr::filter #' @importFrom dplyr group_by #' @export dplyr::group_by #' @importFrom dplyr select #' @export dplyr::select #' @importFrom dplyr desc #' @export dplyr::desc #' @importFrom tidyr drop_na #' @export tidyr::drop_na #' @importFrom tidyr gather #' @export tidyr::gather #' @importFrom tidyr spread #' @export tidyr::spread #' @importFrom generics tidy #' @export generics::tidy #' @importFrom generics augment #' @export generics::augment #' @importFrom car Anova #' @export car::Anova rstatix/R/chisq_test.R0000644000176200001440000001525715074310430014451 0ustar liggesusers#' @include utilities.R NULL #'Chi-squared Test for Count Data #'@description Performs chi-squared tests, including goodness-of-fit, #' homogeneity and independence tests. #'@inheritParams stats::chisq.test #'@param res.chisq an object of class \code{chisq_test}. #'@param p.adjust.method method to adjust p values for multiple comparisons. #' Used when pairwise comparisons are performed. Allowed values include "holm", #' "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't #' want to adjust the p value (not recommended), use p.adjust.method = "none". #'@param ... other arguments passed to the function \code{{chisq_test}()}. #' #'@return return a data frame with some the following columns: \itemize{ \item #' \code{n}: the number of participants. \item \code{group, group1, group2}: #' the categories or groups being compared. \item \code{statistic}: the value #' of Pearson's chi-squared test statistic. \item \code{df}: the degrees of #' freedom of the approximate chi-squared distribution of the test statistic. #' NA if the p-value is computed by Monte Carlo simulation. \item \code{p}: #' p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the #' used statistical test. \item \code{p.signif, p.adj.signif}: the significance #' level of p-values and adjusted p-values, respectively. \item #' \code{observed}: observed counts. \item #' \code{expected}: the expected counts under the null hypothesis. #' } #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. #' #' @examples #' # Chi-square goodness of fit test #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' tulip <- c(red = 81, yellow = 50, white = 27) #' # Q1: Are the colors equally common? #' chisq_test(tulip) #' pairwise_chisq_gof_test(tulip) #' # Q2: comparing observed to expected proportions #' chisq_test(tulip, p = c(1/2, 1/3, 1/6)) #' pairwise_chisq_test_against_p(tulip, p = c(0.5, 0.33, 0.17)) #' #' # Homogeneity of proportions between groups #' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' # Data: Titanic #' xtab <- as.table(rbind( #' c(203, 118, 178, 212), #' c(122, 167, 528, 673) #' )) #' dimnames(xtab) <- list( #' Survived = c("Yes", "No"), #' Class = c("1st", "2nd", "3rd", "Crew") #' ) #' xtab #' # Chi-square test #' chisq_test(xtab) #' # Compare the proportion of survived between groups #' pairwise_prop_test(xtab) #' @describeIn chisq_test performs chi-square tests including goodness-of-fit, #' homogeneity and independence tests. #' @export chisq_test <- function(x, y = NULL, correct = TRUE, p = rep(1/length(x), length(x)), rescale.p = FALSE, simulate.p.value = FALSE, B = 2000){ args <- as.list(environment()) %>% add_item(method = "chisq_test") if(is.data.frame(x)) x <- as.matrix(x) if(inherits(x, c("matrix", "table"))) n <- sum(x) else n <- length(x) res.chisq <- stats::chisq.test( x, y, correct = correct, p = p, rescale.p = rescale.p, simulate.p.value = simulate.p.value, B = B ) as_tidy_stat(res.chisq, stat.method = "Chi-square test") %>% add_significance("p") %>% add_columns(n = n, .before = 1) %>% set_attrs(args = args, test = res.chisq) %>% add_class(c("rstatix_test", "chisq_test")) } #' @describeIn chisq_test perform pairwise comparisons between groups following a global #' chi-square goodness of fit test. #' @export pairwise_chisq_gof_test <- function(x, p.adjust.method = "holm", ...){ if(is.null(names(x))){ names(x) <- paste0("grp", 1:length(x)) } compare_pair <- function(levs, x, ...){ levs <- as.character(levs) suppressWarnings(chisq_test(x[levs], ...)) %>% add_columns(group1 = levs[1], group2 = levs[2], .before = "statistic") } args <- as.list(environment()) %>% add_item(method = "chisq_test") comparisons <- names(x) %>% .possible_pairs() results <- comparisons %>% map(compare_pair, x, ...) %>% map(keep_only_tbl_df_classes) %>% bind_rows() %>% adjust_pvalue("p", method = p.adjust.method) %>% add_significance("p.adj") %>% mutate(p.adj = signif(.data$p.adj, digits = 3)) %>% select(-.data$p.signif, -.data$method) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "chisq_test")) } #' @describeIn chisq_test perform pairwise comparisons after a global #' chi-squared test for given probabilities. For each group, the observed and #' the expected proportions are shown. Each group is compared to the sum of #' all others. #' @export pairwise_chisq_test_against_p <- function(x, p = rep(1/length(x), length(x)), p.adjust.method = "holm", ...){ args <- as.list(environment()) %>% add_item(method = "chisq_test") if (sum(p) != 1) { stop( "Make sure that the `p` argument is correctly specified.", "sum of probabilities must be 1." ) } if(is.null(names(x))){ names(x) <- paste0("grp", 1:length(x)) } results <- list() for (i in 1:length(x)) { res.chisq <- suppressWarnings(chisq_test(c(x[i], sum(x) - x[i]), p = c(p[i], 1 - p[i]), ...)) res.desc <- chisq_descriptives(res.chisq) res.chisq <- res.chisq %>% add_columns(observed = res.desc$observed[1], expected = res.desc$expected[1], .before = 1) results[[i]] <- res.chisq } results <- results %>% map(keep_only_tbl_df_classes) %>% bind_rows() %>% add_columns(group = names(x), .before = 1) %>% adjust_pvalue("p", method = p.adjust.method) %>% add_significance("p.adj") %>% mutate(p.adj = signif(.data$p.adj, digits = 3)) %>% select(-.data$p.signif, -.data$method) results %>% set_attrs(args = args) %>% add_class(c("rstatix_test", "chisq_test")) } #' @describeIn chisq_test returns the descriptive statistics of the chi-square #' test. These include, observed and expected frequencies, proportions, #' residuals and standardized residuals. #' @export chisq_descriptives <- function(res.chisq){ res <- attr(res.chisq, "test") %>% augment() colnames(res) <- gsub(pattern = "^\\.", replacement = "", colnames(res)) res } #' @describeIn chisq_test returns the expected counts from the chi-square test result. #' @export expected_freq <- function(res.chisq){ attr(res.chisq, "test")$expected } #' @describeIn chisq_test returns the observed counts from the chi-square test result. #' @export observed_freq <- function(res.chisq){ attr(res.chisq, "test")$observed } #' @describeIn chisq_test returns the Pearson residuals, \code{(observed - expected) / sqrt(expected)}. #' @export pearson_residuals <- function(res.chisq){ attr(res.chisq, "test")$residuals } #' @describeIn chisq_test returns the standardized residuals #' @export std_residuals <- function(res.chisq){ attr(res.chisq, "test")$stdres } rstatix/R/emmeans_test.R0000644000176200001440000001700715074310430014762 0ustar liggesusers#' @include utilities.R NULL #'Pairwise Comparisons of Estimated Marginal Means #' #' #'@description Performs pairwise comparisons between groups using the estimated #' marginal means. Pipe-friendly wrapper arround the functions \code{emmans() + #' contrast()} from the \code{emmeans} package, which need to be installed #' before using this function. This function is useful for performing post-hoc #' analyses following ANOVA/ANCOVA tests. #'@inheritParams t_test #'@param model a fitted-model objects such as the result of a call to #' \code{lm()}, from which the overall degrees of #' freedom are to be calculated. #'@param covariate (optional) covariate names (for ANCOVA) #'@return return a data frame with some the following columns: \itemize{ \item #' \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the #' compared groups in the pairwise tests. \item \code{statistic}: Test #' statistic (t.ratio) used to compute the p-value. \item \code{df}: degrees of #' freedom. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. #' \item \code{method}: the statistical test used to compare groups. \item #' \code{p.signif, p.adj.signif}: the significance level of p-values and #' adjusted p-values, respectively. \item \code{estimate}: estimate of the #' effect size, that is the difference between the two emmeans (estimated #' marginal means). \item \code{conf.low,conf.high}: Lower and upper bound on a #' confidence interval of the estimate. } #' #' The \strong{returned object has an attribute called args}, which is a list #' holding the test arguments. It has also an attribute named "emmeans", a data #' frame containing the groups emmeans. #'@examples #' # Data preparation #' df <- ToothGrowth #' df$dose <- as.factor(df$dose) #' #'# Pairwise comparisons #' res <- df %>% #' group_by(supp) %>% #' emmeans_test(len ~ dose, p.adjust.method = "bonferroni") #'res #' #' # Display estimated marginal means #' attr(res, "emmeans") #' #' # Show details #' df %>% #' group_by(supp) %>% #' emmeans_test(len ~ dose, p.adjust.method = "bonferroni", detailed = TRUE) #'@export emmeans_test <- function(data, formula, covariate = NULL, ref.group = NULL, comparisons = NULL, p.adjust.method = "bonferroni", conf.level = 0.95, model = NULL, detailed = FALSE){ . <- NULL covariate <- rlang::enquos(covariate = covariate) %>% get_quo_vars_list(data, .) %>% unlist() args <- as.list(environment()) %>% .add_item(method = "emmeans_test") required_package("emmeans") outcome <- get_formula_left_hand_side(formula) rhs <- group <- get_formula_right_hand_side(formula) grouping.vars <- NULL if(is_grouped_df(data)){ grouping.vars <- dplyr::group_vars(data) rhs <- c(grouping.vars, rhs) %>% paste(collapse = "*") data <- dplyr::ungroup(data) } if(!is.null(covariate)){ covariate <- paste(covariate, collapse = "+") rhs <- paste(covariate, rhs, sep = "+") } data <- data %>% .as_factor(group, ref.group = ref.group) group.levels <- data %>% get_levels(group) # Build linear model formula <- stats::as.formula(paste(outcome, rhs, sep = " ~ ")) if(is.null(model)) model <- stats::lm(formula, data) # Fit emmeans # Possible pairwise comparisons: if ref.group specified, # only comparisons against reference will be kept if (is.null(comparisons)) { comparisons <- get_comparisons(data, variable = !!group, ref.group = !!ref.group) } method <- get_emmeans_contrasts(data, group, comparisons) formula.emmeans <- stats::as.formula(paste0("~", rhs)) res.emmeans <- emmeans::emmeans(model, formula.emmeans) comparisons <- pairwise_emmeans_test( res.emmeans, grouping.vars, method = method, p.adjust.method = p.adjust.method, conf.level = conf.level ) res.emmeans <- res.emmeans %>% tibble::as_tibble() %>% dplyr::arrange(!!!syms(grouping.vars)) %>% dplyr::rename(se = "SE", conf.low = "lower.CL", conf.high = "upper.CL") %>% mutate(method = "Emmeans test") if(!detailed){ to.remove <- c("estimate", "estimate1", "estimate2", "se", "conf.low", "conf.high", "method", "null.value") to.keep <- setdiff(colnames(comparisons), to.remove) comparisons <- comparisons[, to.keep] } comparisons %>% add_column(.y. = outcome, .before = "group1") %>% set_attrs(args = args, emmeans = res.emmeans) %>% add_class(c("rstatix_test", "emmeans_test")) } #' @export #' @param emmeans.test an object of class \code{emmeans_test}. #' @describeIn emmeans_test returns the estimated marginal means from an object of class \code{emmeans_test} get_emmeans <- function(emmeans.test){ if(!inherits(emmeans.test, "emmeans_test")){ stop("An object of class 'emmeans_test' required.") } attr(emmeans.test, "emmeans") } pairwise_emmeans_test <- function(res.emmeans, grouping.vars = NULL, method = "pairwise", p.adjust.method = "bonferroni", conf.level = 0.95){ # Comparisons without adjusting the pvalue # reverse the order of subtraction for consistency with pairwise_t_test comparisons <- emmeans::contrast( res.emmeans, by = grouping.vars, method = method, adjust = "none" ) comparisons <- tidy(comparisons, conf.int = TRUE, conf.level = conf.level) comparisons <- comparisons %>% tidyr::separate(col = "contrast", into = c("group1", "group2"), sep = "-") %>% dplyr::rename(se = "std.error", p = "p.value") %>% dplyr::select(!!!syms(grouping.vars), everything()) # Adjust the pvalue. We don't want to use adjust_pvalue here, because # emmeans support method = "tukey", but this is not the case for adjust_pvalue p.adjusted <- emmeans::contrast( res.emmeans, by = grouping.vars, method = method, adjust = p.adjust.method ) %>% as.data.frame() %>% pull("p.value") comparisons <- comparisons %>% mutate(p.adj = p.adjusted) %>% add_significance("p.adj") # Homogenize variable classes between res.emmeans and comparisons # because: tidy() is converting factor to character -> so restoring back factors res.emmeans.tbl <- tibble::as_tibble(res.emmeans) variables <- intersect(colnames(res.emmeans.tbl), colnames(comparisons)) for(variable in variables){ if(is.factor(res.emmeans.tbl[[variable]])){ comparisons[[variable]] <- factor( comparisons[[variable]], levels = levels(res.emmeans.tbl[[variable]]) ) } } comparisons <- base::droplevels(comparisons) comparisons %>% dplyr::arrange(!!!syms(grouping.vars)) } # Returns a list of contrasts for specific comparisons # data: data frame, # group: grouping columns, # comparisons a list of comparisons get_emmeans_contrasts <- function(data, group, comparisons){ get_dummy_code <- function(level, group.levels){ dummy.code <- rep(0, length(group.levels)) lev.pos <- which(group.levels == level) dummy.code[lev.pos] <- 1 dummy.code } make_emmeans_contrast <- function(groups, contrasts.list ){ group1 <- groups[1] group2 <- groups[2] contrasts.list[[group1]]-contrasts.list[[group2]] } make_comparison_name <- function(groups){ paste(groups[1], groups[2], sep = "-") } group.levels <- get_levels(data, group) contrasts.list <- group.levels %>% map(get_dummy_code, group.levels) names(contrasts.list) <- group.levels comparison.contrasts <- comparisons %>% map(make_emmeans_contrast, contrasts.list) comparison.names <- comparisons %>% map(make_comparison_name) names(comparison.contrasts) <- comparison.names comparison.contrasts } rstatix/R/freq_table.R0000644000176200001440000000266615074310430014407 0ustar liggesusers#' @include utilities.R NULL #'Compute Frequency Table #'@description compute frequency table. #'@param data a data frame #'@param ... One or more unquoted expressions (or variable names) separated by #' commas. Used to specify variables of interest. #'@param vars optional character vector containing variable names. #'@param na.rm logical value. If TRUE (default), remove missing values in the #' variables used to create the frequency table. #'@return a data frame #' @examples #' data("ToothGrowth") #' ToothGrowth %>% freq_table(supp, dose) #'@export freq_table <- function(data, ..., vars = NULL, na.rm = TRUE){ if(is.vector(data) | is.factor(data)){ data <- data.frame(group = data) vars <- "group" } data <- data %>% df_select(..., vars = vars) vars <- colnames(data) if(length(vars) == 0){ stop("Specify at least one variable") } if(na.rm){ data <- data %>% filter(stats::complete.cases(data)) } results <- data %>% group_by(!!!syms(vars)) %>% summarise(n = n()) %>% mutate(prop = round(.data$n *100 / sum (.data$n), 1)) %>% dplyr::ungroup() results } spread_table <- function(data, vars){ last.var <- dplyr::last(vars) grouping.vars <- utils::head(vars, -2) if(length(vars) >= 2){ data <- data %>% select(-.data$prop) %>% group_by(!!!syms(grouping.vars)) %>% nest() %>% mutate(data = map(.data$data, spread, key = last.var, value = "n")) } data } rstatix/R/anova_summary.R0000644000176200001440000003070015074310430015152 0ustar liggesusers#' @include utilities.R utilities_two_sample_test.R factorial_design.R NULL #'Create Nice Summary Tables of ANOVA Results #' #' #'@description Create beautiful summary tables of ANOVA test results obtained #' from either \code{\link[car]{Anova}()} or \code{\link[stats]{aov}()}. #' #' The results include ANOVA table, generalized effect size and some assumption #' checks. #' #'@param effect.size the effect size to compute and to show in the ANOVA #' results. Allowed values can be either "ges" (generalized eta squared) or #' "pes" (partial eta squared) or both. Default is "ges". #'@param observed Variables that are observed (i.e, measured) as compared to #' experimentally manipulated. The default effect size reported (generalized #' eta-squared) requires correct specification of the observed variables. #'@param detailed If TRUE, returns extra information (sums of squares columns, #' intercept row, etc.) in the ANOVA table. #'@param object an object of returned by either \code{\link[car]{Anova}()}, or #' \code{\link[stats]{aov}()}. #' #'@return return an object of class \code{anova_test} a data frame containing #' the ANOVA table for independent measures ANOVA. However, for repeated/mixed #' measures ANOVA, it is a list containing the following components are #' returned: #' #' \itemize{ \item \strong{ANOVA}: a data frame containing ANOVA results \item #' \strong{Mauchly's Test for Sphericity}: If any within-Ss variables with more #' than 2 levels are present, a data frame containing the results of Mauchly's #' test for Sphericity. Only reported for effects that have more than 2 levels #' because sphericity necessarily holds for effects with only 2 levels. \item #' \strong{Sphericity Corrections}: If any within-Ss variables are present, a #' data frame containing the Greenhouse-Geisser and Huynh-Feldt epsilon values, #' and corresponding corrected p-values. } #' #' The \strong{returned object might have an attribute} called \code{args} if #' you compute ANOVA using the function \code{\link{anova_test}()}. The attribute \code{args} is a #' list holding the arguments used to fit the ANOVA model, including: data, dv, #' within, between, type, model, etc. #' #' #' The following abbreviations are used in the different results tables: #' #' \itemize{ \item DFn Degrees of Freedom in the numerator (i.e. DF effect). #' \item DFd Degrees of Freedom in the denominator (i.e., DF error). \item #' SSn Sum of Squares in the numerator (i.e., SS effect). \item SSd Sum of #' Squares in the denominator (i.e.,SS error). \item F F-value. \item p p-value #' (probability of the data given the null hypothesis). \item p<.05 Highlights #' p-values less than the traditional alpha level of .05. \item ges Generalized #' Eta-Squared measure of effect size. \item GGe Greenhouse-Geisser epsilon. #' \item p[GGe] p-value after correction using Greenhouse-Geisser epsilon. #' \item p[GGe]<.05 Highlights p-values (after correction using #' Greenhouse-Geisser epsilon) less than the traditional alpha level of .05. #' \item HFe Huynh-Feldt epsilon. \item p[HFe] p-value after correction using #' Huynh-Feldt epsilon. \item p[HFe]<.05 Highlights p-values (after correction #' using Huynh-Feldt epsilon) less than the traditional alpha level of .05. #' \item W Mauchly's W statistic } #' #'@author Alboukadel Kassambara, \email{alboukadel.kassambara@@gmail.com} #'@seealso \code{\link{anova_test}()}, \code{\link{factorial_design}()} #' @examples #'# Load data #'#::::::::::::::::::::::::::::::::::::::: #'data("ToothGrowth") #'df <- ToothGrowth #'df$dose <- as.factor(df$dose) #' #'# Independent measures ANOVA #'#::::::::::::::::::::::::::::::::::::::::: #'# Compute ANOVA and display the summary #' res.anova <- Anova(lm(len ~ dose*supp, data = df)) #' anova_summary(res.anova) #' #'# Display both SSn and SSd using detailed = TRUE #'# Show generalized eta squared using effect.size = "ges" #'anova_summary(res.anova, detailed = TRUE, effect.size = "ges") #' #'# Show partial eta squared using effect.size = "pes" #'anova_summary(res.anova, detailed = TRUE, effect.size = "pes") #' #'# Repeated measures designs using car::Anova() #'#::::::::::::::::::::::::::::::::::::::::: #'# Prepare the data #'df$id <- as.factor(rep(1:10, 6)) # Add individuals ids #'head(df) #' #'# Easily perform repeated measures ANOVA using the car package #' design <- factorial_design(df, dv = len, wid = id, within = c(supp, dose)) #' res.anova <- Anova(design$model, idata = design$idata, idesign = design$idesign, type = 3) #' anova_summary(res.anova) #' #'# Repeated measures designs using stats::Aov() #'#::::::::::::::::::::::::::::::::::::::::: #' res.anova <- aov(len ~ dose*supp + Error(id/(supp*dose)), data = df) #' anova_summary(res.anova) #'@name anova_summary #'@export anova_summary <- function(object, effect.size = "ges", detailed = FALSE, observed = NULL){ if(inherits(object, "Anova.mlm")){ results <- repeated_anova_summary(object) } else if(inherits(object, "anova")){ results <- summary_independent_anova(object) } else if(inherits(object, c("aov", "aovlist"))){ results <- summary_aov(object) } else{ stop("Non-supported object passed: ", paste(class(object), collapse = ", "), ". ", "Object needs to be of class 'Anova.mlm' or 'anova'.") } .args <- attr(object, "args") # exist only in anova_test() results <- results %>% add_anova_effect_size(effect.size, observed) if(!detailed){ results <- remove_details(results, method = "anova") } results$ANOVA <- order_by_interaction_levels(results$ANOVA) results <- results %>% map(~dplyr::mutate_if(., is.numeric, round_value, 3)) if(length(results) == 1) results <- results[[1]] results %>% set_attrs(args = .args) } # Summary of Anova.mlm object: summary_anova_mlm #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # this function is used for repeated and mixed anova repeated_anova_summary <- function(res.anova, detailed = FALSE){ .summary <- suppressWarnings(summary(res.anova)) # Anova table converted into data frame aov.table <- .summary$univariate.tests %>% convert_anova_object_as_data_frame() %>% set_colnames(c("Effect", "SSn", "DFn", "SSd", "DFd", "F", "p")) %>% select( .data$Effect, .data$DFn, .data$DFd, .data$SSn, .data$SSd, .data$F, .data$p ) %>% mutate(`p<.05` = ifelse(.data$p < 0.05, "*",'')) sphericity.test <- corrections <- NULL # Mauchly's Test for Sphericity if(nrow(.summary$sphericity.tests) > 0){ sphericity.test <- .summary$sphericity.tests %>% convert_anova_object_as_data_frame() %>% set_colnames(c("Effect", "W", "p")) %>% mutate(`p<.05` = ifelse(.data$p < 0.05, "*",'')) } # Sphericity corrections if(nrow(.summary$sphericity.tests) > 0){ corrections <- .summary$pval.adjustments %>% as.data.frame() %>% set_colnames(c("GGe", "p[GG]", "HFe", "p[HF]")) %>% tibble::rownames_to_column("Effect") p.gg.signif <- ifelse(corrections[["p[GG]"]] < 0.05, "*",'') p.hf.signif <- ifelse(corrections[["p[HF]"]] < 0.05, "*",'') corrections <- corrections %>% add_column(`p[GG]<.05` = p.gg.signif, .after = "p[GG]") %>% add_column(`p[HF]<.05` = p.hf.signif, .after = "p[HF]") } # Results results <- list(ANOVA = aov.table) if(!is.null(sphericity.test)){ results $`Mauchly's Test for Sphericity` <- sphericity.test results$`Sphericity Corrections` <- corrections results <- results %>% add_corrected_df() } results } convert_anova_object_as_data_frame <- function(aov.table){ aov.table.list <- list(Effect = rownames(aov.table)) for(col in colnames(aov.table)){ aov.table.list[[col]] <- aov.table[, col] } aov.table <- as.data.frame(aov.table.list, stringsAsFactors = FALSE) rownames(aov.table) <- 1:nrow(aov.table) aov.table } add_corrected_df <- function(.summary){ aov.table <- .summary$ANOVA %>% select(.data$Effect, .data$DFn, .data$DFd) corrections <- .summary$`Sphericity Corrections` %>% dplyr::left_join(aov.table, by = "Effect") %>% mutate( df.gg = paste(round_value(.data$GGe*.data$DFn, 2), round_value(.data$GGe*.data$DFd, 2), sep = ", "), df.hf = paste(round_value(.data$HFe*.data$DFn, 2), round_value(.data$HFe*.data$DFd, 2), sep = ", ") ) %>% select(-.data$DFd, -.data$DFn) df.gg <- corrections$df.gg df.hf <- corrections$df.hf .summary$`Sphericity Corrections` <- corrections %>% select(-.data$df.gg, -.data$df.hf) %>% add_column(`DF[GG]` = df.gg, .after = "GGe") %>% add_column(`DF[HF]` = df.hf, .after = "HFe") .summary } # Summary of independent anova #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% summary_independent_anova <- function(res.anova){ res.anova <- as.data.frame(res.anova) .residuals <- res.anova["Residuals", 1:2] if('Mean Sq' %in% colnames(res.anova)){ # exists when res.anova is from stats::anova res.anova <- select(res.anova, -.data$`Mean Sq`) } if('Sum Sq' %in% colnames(res.anova)){ # in stats::anova, Sum Sq is not the first column, so do select res.anova <- res.anova %>% select(.data$`Sum Sq`, dplyr::everything()) colnames(res.anova) <- c('SSn','DFn','F','p') ss.exists <- TRUE } else{ # case of white.adjust = TRUE. SS doesnt exist in the results colnames(res.anova) <- c('DFn','F','p') ss.exists <- FALSE } res.anova <- res.anova %>% tibble::rownames_to_column("Effect") %>% add_column(DFd = .residuals$Df, .after = "DFn") %>% mutate(`p<.05` = ifelse(.data$p < 0.05, "*",'')) %>% filter(.data$Effect != "Residuals") if(ss.exists){ res.anova <- res.anova %>% add_column(SSd = .residuals$`Sum Sq`, .after = "SSn") } results <- list(ANOVA = res.anova) results } # Summary of anova from stats::aov #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% summary_aov <- function(res.anova){ remove_empty_space <- function(x){ sapply(x, function(x){strsplit(x, " ")[[1]][1]}) } reformat_aov_summary <- function(aov.summary){ if(inherits(aov.summary, "listof")) aov.summary <- as.data.frame(aov.summary[[1]]) else as.data.frame(aov.summary) .residuals <- aov.summary["Residuals", 1:2] aov.summary <- aov.summary %>% set_colnames(c("DFn", "SSn", "MS", "F", "p")) %>% tibble::rownames_to_column("Effect") %>% add_column(DFd = .residuals$Df, .after = "DFn") %>% add_column(SSd = .residuals$`Sum Sq`, .after = "SSn") %>% mutate(`p<.05` = as.character(ifelse(.data$p < 0.05, "*",''))) %>% mutate(Effect = remove_empty_space(.data$Effect)) %>% filter(!is.na(.data$p)) %>% select(-.data$MS) aov.summary } res.anova <- summary(res.anova) %>% map(reformat_aov_summary) %>% dplyr::bind_rows() %>% order_by_interaction_levels() results <- list(ANOVA = res.anova) results } # Reorder ANOVA table by interaction levels in the term order_by_interaction_levels <- function(aov.table){ .terms <- aov.table$Effect nb.interaction <- str_count(.terms, ":") aov.table %>% dplyr::arrange(nb.interaction) } # Add effect size #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add_anova_effect_size <- function(res.anova.summary, effect.size = "ges", observed = NULL){ ss.exists <- "SSn" %in% colnames(res.anova.summary$ANOVA) if(!ss.exists){ return(res.anova.summary) } if("pes" %in% effect.size){ res.anova.summary <- res.anova.summary %>% add_partial_eta_squared() } else { res.anova.summary <- res.anova.summary %>% add_generalized_eta_squared(observed) } res.anova.summary } # Generalized eta squared add_generalized_eta_squared <- function(res.anova.summary, observed = NULL){ aov.table <- res.anova.summary$ANOVA if(!is.null(observed)){ obs <- rep(FALSE, nrow(aov.table)) for(i in observed){ if (!any(grepl(paste0("\\b",i,"\\b"), aov.table$Effect))) stop("Specified observed variable not found in data: ", i) obs <- obs | grepl(paste0("\\b",i,"\\b"), aov.table$Effect) } obs.SSn1 = sum(aov.table$SSn*obs) obs.SSn2 = aov.table$SSn*obs } else{ obs.SSn1 <- 0 obs.SSn2 <- 0 } aov.table <- aov.table %>% mutate(ges = .data$SSn / (.data$SSn + sum(unique(.data$SSd)) + obs.SSn1 - obs.SSn2)) res.anova.summary$ANOVA <- aov.table res.anova.summary } # Partial eta squared add_partial_eta_squared <- function(res.anova.summary){ res.anova.summary$ANOVA <- res.anova.summary$ANOVA %>% mutate(pes = .data$SSn/(.data$SSn + .data$SSd)) res.anova.summary } rstatix/R/utilities_two_sample_test.R0000644000176200001440000002324715074310430017605 0ustar liggesusers # Comparing means # ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: # Global function to compare means compare_mean <- function( data, formula, method = "t.test", paired = FALSE, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", detailed = FALSE, ...) { outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) number.of.groups <- guess_number_of_groups(data, group) if(method %in% c("anova", "kruskal.test") & number.of.groups <= 2) stop("The number of groups <= 2; you should use t.test or wilcox.test") # Case of one sample test if(number.of.groups <= 2){ res <- two_sample_test(data, formula, method = method, paired = paired, ...) } # Pairwise comparisons else if(number.of.groups > 2){ if(method == "anova"){ res <- anova_test(data, formula, ...) %>% select(.data$Effect, .data$F, .data$p) %>% set_colnames(c("term", "statistic", "p")) %>% add_column(method = "Anova", .after = "p") %>% add_column(.y. = outcome, .before = "term") %>% as_tibble() } else if(method == "kruskal.test") res <- kruskal_test(data, formula, ...) else if(is.null(ref.group)) res <- pairwise_two_sample_test( data, formula, method = method, paired = paired, comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, detailed = detailed, ... ) else if(ref.group %in% c("all", ".all.")) res <- two_sample_test_one_vs_all ( data, formula, method = method, p.adjust.method = p.adjust.method, detailed = detailed, ... ) else res <- pairwise_two_sample_test( data, formula, method = method, paired = paired, comparisons = comparisons, ref.group = ref.group, p.adjust.method = p.adjust.method, detailed = detailed, ... ) } if(!detailed) res <- remove_details(res, method = method) res } # Performs one or two samples mean comparisons two_sample_test <- function(data, formula, method = "t.test", ref.group = NULL, detailed = FALSE, ...) { if (is_grouped_df(data)) { res <- data %>% doo(two_sample_test, formula, method = method, ref.group = ref.group, detailed = detailed, ...) return(res) } test.function <- method test.args <- list() grp1 <- grp2 <- NULL outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) # One sample mean comparison ========================= if (.is_empty(group)) { grp1 <- "1" grp2 <- "null model" outcome.values <- data %>% pull(!!outcome) n <- sum(!is.na(outcome.values)) test.args <- list(x = outcome.values, ...) } # Two sample mean comparisons ======================== else { # Convert group into factor if this is not already the case data <- data %>% .as_factor(group, ref.group = ref.group) outcome.values <- data %>% pull(!!outcome) group.values <- data %>% pull(!!group) group.levels <- data %>% get_levels(group) grp1 <- group.levels[1] grp2 <- group.levels[2] x <- outcome.values[group.values == grp1] y <- outcome.values[group.values == grp2] n1 <- sum(!is.na(x)) n2 <- sum(!is.na(y)) test.args <- list(x = x, y = y, ...) } statistic <- p <- NULL res <- suppressWarnings(do.call(test.function, test.args)) %>% as_tidy_stat() %>% add_columns( .y. = outcome, group1 = grp1, group2 = grp2, .before = "statistic" ) # Add n columns if(grp2 == "null model"){ res <- res %>% add_columns(n = n, .before = "statistic") } else{ res <- res %>% add_columns(n1 = n1, n2 = n2, .before = "statistic") } if(!detailed) res <- remove_details(res, method = method) res } # Pairwise mean comparisons pairwise_two_sample_test <- function(data, formula, method = "t.test", comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", detailed = FALSE, ...) { if (is_grouped_df(data)) { res <- data %>% doo( pairwise_two_sample_test, formula, method, comparisons, ref.group, p.adjust.method, detailed = detailed, ... ) return(res) } outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) data <- data %>% .as_factor(group, ref.group = ref.group) group.levels <- data %>% get_levels(group) # All possible pairwise comparisons # if ref.group specified, only comparisons against reference will be kept if (is.null(comparisons)) { comparisons <- group.levels %>% .possible_pairs(ref.group = ref.group) } res <- compare_pairs(data, formula, comparisons, method, detailed = detailed, ...) %>% adjust_pvalue(method = p.adjust.method) %>% add_significance() %>% p_round(digits = 3) if(!detailed) res <- remove_details(res, method = method) res } # One vs all mean comparisons ----------------------------------- two_sample_test_one_vs_all <- function(data, formula, method = "t.test", p.adjust.method = "holm", detailed = FALSE, ...) { if (is_grouped_df(data)) { results <- data %>% doo(two_sample_test_one_vs_all, formula, method, p.adjust.method, detailed = detailed, ...) return(results) } outcome <- get_formula_left_hand_side(formula) group <- get_formula_right_hand_side(formula) new.data <- create_data_with_all_ref_group(data, outcome, group) pairwise_two_sample_test( data = new.data, formula = formula, method = method, ref.group = "all", p.adjust.method = p.adjust.method, detailed = detailed, ... ) } # Create new data set containing the "all" group level create_data_with_all_ref_group <- function(data, outcome, group){ grouping.vars <- grouping.vars.data <- NULL if(is_grouped_df(data)){ grouping.vars <- dplyr::group_vars(data) data <- dplyr::ungroup(data) grouping.vars.data <- data %>% select(!!!syms(grouping.vars)) } data <- data %>% .as_factor(group) outcome.values <- data %>% pull(!!outcome) group.values <- data %>% pull(!!group) group.levels <- group.values %>% levels() all.data <- tibble( outcome = outcome.values, group = "all" ) source.data <- tibble( outcome = outcome.values, group = as.character(group.values) ) new.data <- all.data %>% bind_rows(source.data) %>% mutate(group = factor(group, levels = c("all", group.levels))) colnames(new.data) <- c(outcome, group) if(!is.null(grouping.vars)){ # repeat grouping.vars.data for "all" group new.data <- dplyr::bind_rows(grouping.vars.data, grouping.vars.data) %>% dplyr::bind_cols(new.data) %>% group_by(!!!syms(grouping.vars)) } new.data } # compare_pair(ToothGrowth, len ~ dose, c("0.5", "1")) compare_pair <- function(data, formula, pair, method = "t.test", ...){ group <- get_formula_right_hand_side(formula) data %>% filter(!!sym(group) %in% pair) %>% droplevels() %>% two_sample_test(formula, method = method, ...) } # compare_pairs(ToothGrowth, len ~ dose, list(c("0.5", "1"), c("1", "2"))) compare_pairs <- function(data, formula, pairs, method = "t.test", ...){ .f <- function(pair, data, formula, method, ...){ compare_pair(data, formula, pair, method, ...) } pairs %>% map(.f, data, formula, method, ...) %>% bind_rows() } # Remove details from statistical test results #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% remove_details <- function(res, method){ if(method == "anova"){ # Remove details from ANOVA summary: such as intercept row, Sum Sq columns aov.table <- res$ANOVA aov.table = aov.table[, names(aov.table) %in% c('Effect','DFn','DFd','F','p','p<.05', 'ges', 'pes')] intercept.row <- grepl("Intercept", aov.table$Effect) res$ANOVA<- aov.table[!intercept.row, ] } else if(method %in% c("t.test", "wilcox.test", "kruskal.test", "sign.test") ){ columns.to.keep <- intersect( c(".y.", "group1", "group2", "n", "n1", "n2", "statistic", "df", "p", "p.signif", "p.adj", "p.adj.signif"), colnames(res) ) res <- res[, columns.to.keep] } else if(method %in% c("coin.wilcox.test", "cohens.d")){ columns.to.remove <- c("p", "p.adj", "p.adj.signif", "p.signif", "statistic", "method", "alternative", "df") columns.to.keep <- setdiff(colnames(res), columns.to.remove) res <- res %>% select(!!!syms(columns.to.keep)) } else if(method %in% c("prop.test")){ columns.to.keep <- intersect( c("n", "group", "statistic", "df", "p", "p.signif", "p.adj", "p.adj.signif"), colnames(res) ) res <- res[, columns.to.keep] } else{ columns.to.remove <- c("n1", "n2", "n", "method", "alternative", "statistic", "df") columns.to.keep <- setdiff(colnames(res), columns.to.remove) res <- res %>% select(!!!syms(columns.to.keep)) } res } # Two samples tests-------------------------------------- # Check two samples test args check_two_samples_test_args <- function(x, y = NULL, mu = 0, paired = FALSE, conf.level = 0.5){ if (!missing(mu) & ((length(mu) > 1L) || !is.finite(mu))) stop("'mu' must be a single number") if (!((length(conf.level) == 1L) & is.finite(conf.level) & (conf.level > 0) & (conf.level < 1))) stop("'conf.level' must be a single number between 0 and 1") if (!is.numeric(x)) stop("'x' must be numeric") if (!is.null(y)) { if (!is.numeric(y)) stop("'y' must be numeric") if (paired) { if (length(x) != length(y)) stop("'x' and 'y' must have the same length") } } else { if (paired) stop("'y' is missing for paired test") } if (length(x) < 1L) stop("not enough (finite) 'x' observations") } rstatix/R/levene_test.R0000644000176200001440000000277415074310430014620 0ustar liggesusers#' @include utilities.R #' @importFrom stats median NULL #' Levene's Test #' #' @description Provide a pipe-friendly framework to easily compute Levene's #' test for homogeneity of variance across groups. #' #' Wrapper around the function \code{\link[car]{leveneTest}()}, which can #' additionally handles a grouped data. #' @param data a data frame for evaluating the formula or a model #' @param formula a formula #' @param center The name of a function to compute the center of each group; #' mean gives the original Levene's test; the default, median, provides a more #' robust test. #' @return a data frame with the following columns: df1, df2 #' (df.residual), statistic and p. #' #' @examples #' # Prepare the data #' data("ToothGrowth") #' df <- ToothGrowth #' df$dose <- as.factor(df$dose) #' # Compute Levene's Test #' df %>% levene_test(len ~ dose) #' #' # Grouped data #' df %>% #' group_by(supp) %>% #' levene_test(len ~ dose) #' #' @export levene_test <- function(data, formula, center = median){ if(is_grouped_df(data)){ results <- data %>% doo(~levene_test(., formula = formula, center = center)) return(results) } else if(is_lm(data)){ results <- car::leveneTest(data, center = center) } else{ results <- car::leveneTest(formula, data, center = center) } results <- broom::tidy(results) %>% rename( df1 = .data$df, df2 = .data$df.residual, p = .data$p.value ) %>% select(.data$df1, .data$df2, .data$statistic, .data$p) results } rstatix/R/cor_plot.R0000644000176200001440000001354015074310430014115 0ustar liggesusers#' @include utilities.R NULL #' Visualize Correlation Matrix Using Base Plot #' @description Provide a tibble-friendly framework to visualize a correlation #' matrix. Wrapper around the R base function #' \code{\link[corrplot]{corrplot}()}. Compared to #' \code{\link[corrplot]{corrplot}()}, it can handle directly the output of the #' functions \code{\link{cor_mat}() (in rstatix)}, \code{rcorr() (in Hmisc)}, #' \code{correlate() (in corrr)} and \code{cor() (in stats)}. #' #' The p-values contained in the outputs of the functions #' \code{\link{cor_mat}()} and \code{rcorr()} are automatically detected and #' used in the visualization. #' @inheritParams corrplot::corrplot #' @param cor.mat the correlation matrix to visualize #' @param palette character vector containing the color palette. #' @param p.mat matrix of p-value corresponding to the correlation matrix. #' @param significant.level significant level, if the p-value is bigger than #' \code{significant.level}, then the corresponding correlation coefficient is #' regarded as insignificant. #' @param insignificant character, specialized insignificant correlation #' coefficients, "cross" (default), "blank". If "blank", wipe away the #' corresponding glyphs; if "cross", add crosses (X) on corresponding glyphs. #' @param label logical value. If TRUE, shows the correlation coefficient #' labels. #' @param font.label a list with one or more of the following elements: size #' (e.g., 1), color (e.g., "black") and style (e.g., "bold"). Used to #' customize the correlation coefficient labels. For example \code{font.label #' = list(size = 1, color = "black", style = "bold")}. #' @param ... additional options not listed (i.e. "tl.cex") here to pass to corrplot. #' @seealso \code{\link{cor_as_symbols}()} #' @examples #' # Compute correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.mat <- mtcars %>% #' select(mpg, disp, hp, drat, wt, qsec) %>% #' cor_mat() #' #' # Visualize correlation matrix #' #:::::::::::::::::::::::::::::::::::::::::: #' # Full correlation matrix, #' # insignificant correlations are marked by crosses #' cor.mat %>% cor_plot() #' #' # Reorder by correlation coefficient #' # pull lower triangle and visualize #' cor.lower.tri <- cor.mat %>% #' cor_reorder() %>% #' pull_lower_triangle() #' cor.lower.tri %>% cor_plot() #' #' # Change visualization methods #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.lower.tri %>% #' cor_plot(method = "pie") #' #' cor.lower.tri %>% #' cor_plot(method = "color") #' #' cor.lower.tri %>% #' cor_plot(method = "number") #' #' # Show the correlation coefficient: label = TRUE #' # Blank the insignificant correlation #' #:::::::::::::::::::::::::::::::::::::::::: #' cor.lower.tri %>% #' cor_plot( #' method = "color", #' label = TRUE, #' insignificant = "blank" #' ) #' #' # Change the color palettes #' #:::::::::::::::::::::::::::::::::::::::::: #' #' # Using custom color palette #' # Require ggpubr: install.packages("ggpubr") #' if(require("ggpubr")){ #' my.palette <- get_palette(c("red", "white", "blue"), 200) #' cor.lower.tri %>% #' cor_plot(palette = my.palette) #' } #' #' # Using RcolorBrewer color palette #' if(require("ggpubr")){ #' my.palette <- get_palette("PuOr", 200) #' cor.lower.tri %>% #' cor_plot(palette = my.palette) #' } #' #' @export cor_plot <- function(cor.mat, method = "circle", type = "full", palette = NULL, p.mat = NULL, significant.level = 0.05, insignificant = c("cross", "blank"), label = FALSE, font.label = list(), ...) { insignificant <- match.arg(insignificant) if(insignificant == "cross") insignificant <- "pch" # Outline color of circle, ellipse, .... outline <- ifelse(method == "color", "white", FALSE) # Correlation coefficients label parameters font <- parse_font(font.label) addCoef.col <- NULL if(label) addCoef.col <- font$color # Correlation matrix data show.diagonal <- TRUE if(inherits(cor.mat, "cor_mat")){ cor.value <- cor.mat %>% as_matrix() p.mat <- cor.mat %>% cor_get_pval() %>% as_matrix() } else if(inherits(cor.mat, "cor_mat_tri")){ cor.value <- cor.mat %>% as_numeric_triangle() %>% as_matrix() p.mat <- cor.mat %>% cor_get_pval() %>% as_numeric_triangle() %>% as_matrix() if(inherits(cor.mat, "lower_tri")) type <- "lower" else type <- "upper" cor.diagonal <- diag(cor.value) cor.diagonal.is.na <- all(is.na(cor.diagonal)) if(cor.diagonal.is.na) show.diagonal <- FALSE else show.diagonal <- TRUE } else if(inherits(cor.mat, "rcorr")){ cor.value <- cor.mat$r p.mat <- cor.mat$P } else { cor.value <- cor.mat %>% as_matrix() } # Correlation matrix p-value if(inherits(p.mat, "tbl_df")) p.mat <- p.mat %>% as_matrix() corrplot <- corrplot::corrplot corrplot( cor.value, method = method, type = type, tl.col="black", tl.srt = 45, col = palette, diag = show.diagonal, p.mat = p.mat, sig.level = significant.level, insig = insignificant, pch.cex = 2, outline = outline, addCoef.col = addCoef.col, number.cex = font$size, number.font = font$style, ... ) } # Parse label font parse_font <- function(font){ if(.is_empty(font)){ font <- list(size = 1, color = "black", style = "plain") } else if(!is.list(font)){ stop("The argument font should be a list. ", "Example: font <- list(size = 1, color = 'black', style = 2)") } else{ font$size <- ifelse(is.null(font$size), 1, font$size) font$color <- ifelse(is.null(font$color), "black", font$color) font$style <- ifelse(is.null(font$style), "plain", font$style) } # convert fon style to numeric available.styles <- c(1, 2, 3, 4) %>% rlang::set_names(c("plain", "bold", "italic", "bold.italic")) font$style <- available.styles[font$style] font } rstatix/R/eta_squared.R0000644000176200001440000000414315074310430014570 0ustar liggesusers#' @include utilities.R NULL #' Effect Size for ANOVA #' @description Compute eta-squared and partial eta-squared for all terms in an #' ANOVA model. #' @param model an object of class aov or anova. #' @return a numeric vector with the effect size statistics #' @describeIn eta_squared compute eta squared #' @examples #' # Data preparation #' df <- ToothGrowth #' df$dose <- as.factor(df$dose) #' #' # Compute ANOVA #' res.aov <- aov(len ~ supp*dose, data = df) #' summary(res.aov) #' #' # Effect size #' eta_squared(res.aov) #' partial_eta_squared(res.aov) #' @export eta_squared <- function(model){ model %>% aov_stat_summary() %>% aov_stat_core("eta") } #' @describeIn eta_squared compute partial eta squared. #' @export partial_eta_squared <- function(model){ model %>% aov_stat_summary() %>% aov_stat_core("peta") } aov_stat_summary <- function (model) { if (!inherits(model, c("aov", "anova"))) model <- stats::anova(model) aov.sum <- broom::tidy(model) if (!tibble::has_name(aov.sum, "meansq")) aov.sum <- tibble::add_column(aov.sum, meansq = aov.sum$sumsq/aov.sum$df, .after = "sumsq") aov.sum } aov_stat_core <- function(aov.sum, type){ meansq.resid <- aov.sum[["meansq"]][nrow(aov.sum)] ss.total <- sum(aov.sum[["sumsq"]]) ss.resid <- aov.sum[["sumsq"]][nrow(aov.sum)] n_terms <- nrow(aov.sum) - 1 if (type == "omega") { aovstat <- purrr::map_dbl(1:n_terms, function(x) { ss.term <- aov.sum[["sumsq"]][x] df.term <- aov.sum[["df"]][x] (ss.term - df.term * meansq.resid)/(ss.total + meansq.resid) }) } else if (type == "eta") { aovstat <- purrr::map_dbl(1:n_terms, ~aov.sum[["sumsq"]][.x]/sum(aov.sum[["sumsq"]])) } else if (type %in% c("cohens.f", "peta")) { aovstat <- purrr::map_dbl(1:n_terms, ~aov.sum[["sumsq"]][.x]/(aov.sum[["sumsq"]][.x] + ss.resid)) } if (type == "cohens.f") aovstat <- sqrt(aovstat/(1 - aovstat)) names(aovstat) <- aov.sum[["term"]][1:n_terms] aovstat } rstatix/NAMESPACE0000644000176200001440000001062115074310430013164 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(plot,anova_test) S3method(print,anova_test) S3method(tukey_hsd,data.frame) S3method(tukey_hsd,default) S3method(tukey_hsd,lm) export("%>%") export(Anova) export(Manova) export(add_significance) export(add_x_position) export(add_xy_position) export(add_y_position) export(adjust_pvalue) export(anova_summary) export(anova_test) export(as_cor_mat) export(augment) export(binom_test) export(box_m) export(chisq_descriptives) export(chisq_test) export(cochran_qtest) export(cohens_d) export(convert_as_factor) export(cor_as_symbols) export(cor_gather) export(cor_get_pval) export(cor_mark_significant) export(cor_mat) export(cor_plot) export(cor_pmat) export(cor_reorder) export(cor_select) export(cor_spread) export(cor_test) export(counts_to_cases) export(cramer_v) export(create_test_label) export(desc) export(df_arrange) export(df_get_var_names) export(df_group_by) export(df_label_both) export(df_label_value) export(df_nest_by) export(df_select) export(df_split_by) export(df_unite) export(df_unite_factors) export(doo) export(drop_na) export(dunn_test) export(emmeans_test) export(eta_squared) export(expected_freq) export(factorial_design) export(filter) export(fisher_test) export(freq_table) export(friedman_effsize) export(friedman_test) export(games_howell_test) export(gather) export(get_anova_table) export(get_comparisons) export(get_description) export(get_emmeans) export(get_mode) export(get_n) export(get_pwc_label) export(get_summary_stats) export(get_test_label) export(get_y_position) export(group_by) export(identify_outliers) export(is_extreme) export(is_outlier) export(kruskal_effsize) export(kruskal_test) export(levene_test) export(mahalanobis_distance) export(make_clean_names) export(mcnemar_test) export(mshapiro_test) export(multinom_test) export(mutate) export(observed_freq) export(p_adj_names) export(p_detect) export(p_format) export(p_mark_significant) export(p_names) export(p_round) export(pairwise_binom_test) export(pairwise_binom_test_against_p) export(pairwise_chisq_gof_test) export(pairwise_chisq_test_against_p) export(pairwise_fisher_test) export(pairwise_mcnemar_test) export(pairwise_prop_test) export(pairwise_sign_test) export(pairwise_t_test) export(pairwise_wilcox_test) export(partial_eta_squared) export(pearson_residuals) export(prop_test) export(prop_trend_test) export(pull_lower_triangle) export(pull_triangle) export(pull_upper_triangle) export(remove_ns) export(reorder_levels) export(replace_lower_triangle) export(replace_triangle) export(replace_upper_triangle) export(row_wise_fisher_test) export(row_wise_prop_test) export(sample_n_by) export(select) export(set_ref_level) export(shapiro_test) export(sign_test) export(spread) export(std_residuals) export(t_test) export(tibble) export(tidy) export(tukey_hsd) export(welch_anova_test) export(wilcox_effsize) export(wilcox_test) importFrom(broom,tidy) importFrom(car,Anova) importFrom(car,Manova) importFrom(dplyr,as_data_frame) importFrom(dplyr,bind_rows) importFrom(dplyr,desc) importFrom(dplyr,do) importFrom(dplyr,everything) importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,is_grouped_df) importFrom(dplyr,left_join) importFrom(dplyr,mutate) importFrom(dplyr,mutate_all) importFrom(dplyr,mutate_at) importFrom(dplyr,n) importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(dplyr,tibble) importFrom(dplyr,ungroup) importFrom(generics,augment) importFrom(generics,tidy) importFrom(magrittr,"%<>%") importFrom(magrittr,"%>%") importFrom(magrittr,extract) importFrom(magrittr,set_colnames) importFrom(purrr,map) importFrom(purrr,map2) importFrom(rlang,"!!!") importFrom(rlang,"!!") importFrom(rlang,":=") importFrom(rlang,.data) importFrom(rlang,quo_name) importFrom(rlang,quos) importFrom(rlang,sym) importFrom(rlang,syms) importFrom(stats,IQR) importFrom(stats,TukeyHSD) importFrom(stats,as.formula) importFrom(stats,complete.cases) importFrom(stats,cor.test) importFrom(stats,cov) importFrom(stats,median) importFrom(stats,pbinom) importFrom(stats,pchisq) importFrom(stats,qbinom) importFrom(stats,quantile) importFrom(stats,sd) importFrom(stats,shapiro.test) importFrom(stats,t.test) importFrom(stats,var) importFrom(stats,wilcox.test) importFrom(tibble,add_column) importFrom(tibble,as_tibble) importFrom(tibble,tibble) importFrom(tidyr,drop_na) importFrom(tidyr,gather) importFrom(tidyr,nest) importFrom(tidyr,separate) importFrom(tidyr,spread) rstatix/NEWS.md0000644000176200001440000003246115074420350013054 0ustar liggesusers# rstatix 0.7.3 ## Bug fixes - Fixed CRAN check errors related to R-devel changes in Wilcoxon tests. Updated tests to accept both legacy and R-devel p-values when exact conditional two-sample inference with ties is used (R-devel r88748). Tests now use flexible assertions to ensure compatibility across R versions ([#220](https://github.com/kassambara/rstatix/issues/220)). - Fixed documentation formatting errors: removed trailing spaces in `\item{}` syntax in `box_m.Rd` and corrected `{v}` to `\code{v}` in `wilcox_test.Rd` ([#220](https://github.com/kassambara/rstatix/issues/220)). - Fixed roxygen2 warning about `sign.test()` internal function by adding `@noRd` tag. # rstatix 0.7.2 ## Minor changes - Required `tidyselect` versions is `>= 1.2.0` ## Bug fixes - `emmeans_test()`: restoring grouping variable class (`factor`) in the final results `emmeans_test()` (#169) - Fix warning in `emmeans_test()`: "Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0." # rstatix 0.7.1 ## Minor changes - `cor_plot()` now accepts additional arguments to pass to corrplot() (#66) - suppressMessages() used to suppress this message ("Coefficient covariances computed by hccm()") generated by `car::Anova()`. - `get_comparisons()` now drops unused levels before creating possible comparisons (#67) - Now, the function `get_summary_stats()` keeps the order of columns specified by the user (#46). - internal `two_sample_test()` now counts group sizes (`n1` and `n2`) by the number of non-`NA` values [#104](https://github.com/kassambara/rstatix/issues/104) ## Bug fixes - Name collisions bug fixes in the `shapiro_test()` function. Shapiro_test() throws an error if the input data contains column names "value" or "variable". This is fixed now (#52). - Bug fixed in the `cor_test()` function, where there was a tidy evaluation conflict when the input data contains "x" and "y" as column names (#68). - The `dunn_test()` documentation is updated to describe the discrepancy between the default behavior of the `rstatix::dunn_test()` compared to other packages (`dunn.test` and `jamovi`). The default of the rstatix::dunn_test() function is to perform a two-sided Dunn test like the well known commercial softwares, such as SPSS and GraphPad. This is not the case for some other R packages (dunn.test and jamovi), where the default is to perform one-sided test (#50). - Now, the function `get_summary_stats()` handles the user defined probabilities for grouped data (#78) # rstatix 0.7.0 ## New features - New function to extract information from rstatix statistical tests: - `get_n()` to extract sample count (n) from statistical test results. - `get_description` to extract stat test description or name - `remove_ns()` to remove non-significant rows. ## Major changes - Rewriting `add_x_position()` to better support different situations (#73). - Now, the output of the function `dunn_test()` include `estimate1` and `estimate2` when the argument `detailed = TRUE` is specified. The `estimate1` and `estimate2` values represent the mean rank values of the two groups being compared, respectively (#59). ## Minor changes - `cor_spread()` doc updated, error is explicitly shown if the input data doesn't contain the columns "var1", "var2" and "cor" (#95) - Maintenance updates of the functions `emmeans_test()` and `levene_test()` to adapt to broom release 0.7.4 (#89) - The documentation of the function `anova_test()` is updated to explain the internal contrast setting (#74). - Now, `p_mark_significance()` works when all p-values are NA. Empty character ("") is returned for NA (#64). - Classes (`rstatix` and `grouped_anova_test`) added to grouped ANOVA test (#61) - New argument `scales` added in the function `get_y_position()`. If the specified value is "free" or "free_y", then the step increase of y positions will be calculated by plot panels. Note that, using "free" or "free_y" gives the same result. A global step increase is computed when scales = "fixed" (#56). ## Bug fixes - The function `anova_test()` computes now repeated measures ANOVA without error when unused columns are present in the input data frame (#55) # rstatix 0.6.0 ## Minor changes - Adapted to upcoming broom v0.7.0 release (#49) - New argument `stack` added in `get_y_position()` to compute p-values y position for stacked bar plots ([#48](https://github.com/kassambara/rstatix/issues/48)). - `wilcox_test()`: Now, if `detailed = TRUE`, an estimate of the location parameter (Only present if argument detailed = TRUE). This corresponds to the pseudomedian (for one-sample case) or to the difference of the location parameter (for two-samples case) ([#45](https://github.com/kassambara/rstatix/issues/45)). ## Bug fixes - `anova_test()` function: Changing R default contrast setting (`contr.treatment`) into orthogonal contrasts (`contr.sum`) to have comparable results to SPSS when users define the model using formula (@benediktclaus, [#40](https://github.com/kassambara/rstatix/issues/40)). - Now, the option `type = "quantile"` of `get_summary_stats()` works properly (@Boyoron, [#39](https://github.com/kassambara/rstatix/issues/39)). # rstatix 0.5.0 ## New features - New functions added for easy data frame manipulation. These functions are internally used in the `rstatix` and the `ggpubr` package and makes it easy to program with tidyverse packages using non standard evaluation. - df_select - df_arrange - df_group_by - df_nest_by - df_split_by - df_unite - df_get_var_names - df_label_both - df_label_value ## Minor changes - Now, in `freq_table()` the option `na.rm` removes only missing values in the variables used to create the frequency table (@JuhlinF, [#25](https://github.com/kassambara/rstatix/issues/25)). - Missing values are now correctly handled in `anova_test()` (@benediktclaus, [#31](https://github.com/kassambara/rstatix/issues/31)) - Maintenance for adapting to the future dplyr 1.0.0 version [#32](https://github.com/kassambara/rstatix/issues/32) ## Bug fixes - An informative message is now displayed when users try to apply Hedge's correction when computing the Cohen's D for one sample test (@GegznaV, [#36](https://github.com/kassambara/rstatix/issues/36)). - Bug fixes in the `games_howell_test()` function : the t-statistic is now calculated using the **absolute** mean difference between groups (@GegznaV, [#37](https://github.com/kassambara/rstatix/issues/37)). - x position is now correctly computed when when making custom comparisons (@barrel0luck, [#28](https://github.com/kassambara/rstatix/issues/28)). # rstatix 0.4.0 ## New features - The `cohens_d()` function now supports Hedge's correction. New argument `hedge.correction` added . logical indicating whether apply the Hedges correction by multiplying the usual value of Cohen's d by `(N-3)/(N-2.25)` (for unpaired t-test) and by `(n1-2)/(n1-1.25)` for paired t-test; where N is the total size of the two groups being compared (N = n1 + n2) (@IndrajeetPatil, [#9](https://github.com/kassambara/rstatix/issues/9)). ## Minor changes - Now, the function `cohens_d()` outputs values with directionality. The absolute value is no longer returned. It can now be positive or negative depending on the data (@narunpat, [#9](https://github.com/kassambara/rstatix/issues/13)). ## Bug fixes - The value of `mu` is now considered when calculating `cohens_d()` for one sample t-test (@mllewis, [#22](https://github.com/kassambara/rstatix/issues/22)). - The function `tukey_hsd()` now handles situation where minus `-` symbols are present in factor levels (@IndrajeetPatil, [#19](https://github.com/kassambara/rstatix/issues/19)). # rstatix 0.3.1 ## Minor changes - tidyr > 1.0.0 now required - know, `identify_outliers` returns a basic data frame instead of tibble when nrow = 0 (for nice printing) - new argument `detailed` added in `dunn_test()`. If TRUE, then estimate and method columns are shown in the results. # rstatix 0.3.0 ## New features - `prop_test()`, `pairwise_prop_test()` and `row_wise_prop_test()`. Performs one-sample and two-samples z-test of proportions. Wrappers around the R base function `prop.test()` but have the advantage of performing pairwise and row-wise z-test of two proportions, the post-hoc tests following a significant chi-square test of homogeneity for 2xc and rx2 contingency tables. - `fisher_test()`, `pairwise_fisher_test()` and `row_wise_fisher_test()`: Fisher's exact test for count data. Wrappers around the R base function `fisher.test()` but have the advantage of performing pairwise and row-wise fisher tests, the post-hoc tests following a significant chi-square test of homogeneity for 2xc and rx2 contingency tables. - `chisq_test()`, `pairwise_chisq_gof_test()`, `pairwise_chisq_test_against_p()` : Chi-square test for count data. - `binom_test()`, `pairwise_binom_test()`, `pairwise_binom_test_against_p()` and `multinom_test()`: performs exact binomial and multinomial tests. Alternative to the chi-square test of goodness-of-fit-test when the sample. - `counts_to_cases()`: converts a contingency table or a data frame of counts into a data frame of individual observations. - New functions `mcnemar_test()` and `cochran_qtest()` for comparing two ore more related proportions. - `prop_trend_test()`: Performs chi-squared test for trend in proportion. This test is also known as Cochran-Armitage trend test. ## Minor changes - Now `get_test_label()` and `get_pwc_label()` return expression by default - Unit testing and spelling check added - Code rewritten to adapt tidyr 1.0.0 # rstatix 0.2.0 ## Minor changes - `get_anova_table()` supports now an object of class `grouped_anova_test` - ANOVA table is now correctly returned when `correction = "none"` for repeated measures ANOVA - `NAs` are now automatically removed before quantile computation for identifying outliers (@IndrajeetPatil, [#10](https://github.com/kassambara/rstatix/issues/10)). - Unquoted factor variable name is now supported in factor manipulation functions: `set_ref_level()`, `reorder_levels()` and `make_valid_levels()` - New argument `model` added in the function `emmeans_test()` - Adapting to tidyr v1.0.0 (@jennybc, [#6](https://github.com/kassambara/rstatix/issues/6)) ## New features - New function `welch_anova_test()`: Welch one-Way ANOVA test. A wrapper around the base function `stats::oneway.test()`. This is is an alternative to the standard one-way ANOVA in the situation where the homogeneity of variance assumption is violated. - New function `friedman_effsize()`, computes the effect size of Friedman test using the Kendall's W value. - New function `friedman_test()`, provides a pipe-friendly framework to perform a Friedman rank sum test, which is the non-parametric alternative to the one-way repeated measures ANOVA test. - New function `games_howell_test()`: Performs Games-Howell test, which is used to compare all possible combinations of group differences when the assumption of homogeneity of variances is violated. - New function `kruskal_effsize()` for computing effect size for Kruskal-Wallis test. - New functions added to round and format p-values: `p_round(), p_format(), p_mark_significant()`. - New function `wilcox_effsize()` added for computing effect size (r) for wilcoxon test. - New function `get_anova_table()` added to extract ANOVA table from `anova_test()` results. Can apply sphericity correction automatically in the case of within-subject (repeated measures) designs. - New functions added to extract information from statistical tests: `get_anova_label()` - New function `emmeans_test()` added for pairwise comparisons of estimated marginal means. ## Minor changes - the unnecessary column `comparison` removed from `tukey_hsd()` results (breaking change). - New column `n` (sample count) added to statistical tests results: `t_test()`, `wilcox_test()`, `sign_test()`, `dunn_test()` and `kruskal_test()` (@ShixiangWang, [#4](https://github.com/kassambara/rstatix/issues/4)). - `rstatix_test` class added to `anova_test()` results - the results of `kruskal_test()` is now an object of class `rstatix_test` that has an attribute named **args** for holding the test arguments. - In `get_y_position()`, y positions and test data are merged now for grouped plots. - New argument `y.trans` added in `get_y_position()` for y scale transformation. - significance column added in `tukey_hsd()` results. - `adjust_pvalue()` now supports grouped data ## Bug fixes - `detailed` arguments correctly propagated when grouped stats are performed # rstatix 0.1.1 ## New features - New function `get_pvalue_position` added to autocompute p-value positions for plotting significance using ggplot2. - New function `get_comparisons()` added to create a list of possible pairwise comparisons between groups. - New function `dunn_test()` added for multiple pairwise comparisons following Kruskal-Wallis test. - New function `sign_test()` added. ## Minor changes - `get_summary_stats()` now supports type = "min", "max", "mean" or "median" - the results of `t_test()`, `wilcox_test()`, `dunn_test()` and `sign_test()` are now an object of class `rstatix_test` that has an attribute named **args** for holding the test arguments. - The results of `cohens_d()` is now a data frame containing the Cohen's d and the magnitude. ## Bug fixes - the argument `detatiled` is now passed to `compare_pairs()`. # rstatix 0.1.0 First release rstatix/inst/0000755000176200001440000000000015074310430012722 5ustar liggesusersrstatix/inst/WORDLIST0000644000176200001440000000162115074310430014114 0ustar liggesusersaaronsc ANCOVA anova Anova aov args arround autocompute Autocompute basemean bca BH bonferroni bootstap cbu ci coef cohen's Cramer's df DF DFd DFn dplyr DunnTest dv effectSize emmeans Ewa fdr Feldt frindly Geisser ges GG GGe ggplot glyphs HFe hochberg holm hommel howell http https Huynh idata idesign intra iqr Kendalls kruskal Kyu labelled labelling Levene's litterature lm lwr Maciej mahal Mauchly's mrc mvnormtest nd perc pes plotmath psy pvalue quartile reimplementation rpubs Sangseok Satterthwaite Schlege sd se signif softwares sphericity Sphericity Ss SSd SSn statswiki steve Technometrics tibble tidyr tidyverse Tomczak TP tukey uk unnested wallis Welch Welch’s wich wilcoxon Wilk www Armitage Anesthesiol Hyunh McNemar McNemar's conf gla nrow rescaled rx unreplicated xc tbl sep directionality Usefull Cramer Olkin GGPUBR GGPlot Ss' tidyverse tidyverse' Manova GraphPad dunn github jamovi kassambara rstatix/tools/0000755000176200001440000000000015074710633013116 5ustar liggesusersrstatix/tools/README-two-sample-t-test-1.png0000644000176200001440000003015715074310430020220 0ustar liggesusersPNG  IHDR   iCCPICC Profile8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|UP`o,IDATx xEƿ )HoD\ DW!DYXEQQ* r< ,rp(@!!v; 3tϼHwH `(@C\d D/5'7I~ƠL[E t/HmA$7YrNp=&@joa.2K@d)ܓ BŨqPW"Axx]ZݳzOq"&aaL_c@3b.!ǻ:5ce۽JBwbGO[qMärHtl7XpYOJkmtٸ"lH͖H~A gJfHXd+zV+9{"^|(s߇שZV{5 稑z t%̙3Gʗ//m۶-~ZTRŧG5FJ}K^^\{.QܹsN d۶mRR%i֬5v`#s/m?+"\s 6LnQL2c  ,x ';С绘3h 3g>~xV<r7KӦMeҥy{(@SNVZJLL 6<2tP;vlsر2m4q2j(1馛䫯Obcco>M6ɏ?({+Wĉ޳߿@\/_ѣj*yUId֬Yyfٳg:tH{9u>##8< `fy0̘1C Gի t2ɓex /Rj֬D(77WF!(ϝ;W?-[nQBzjINNVϸۜ_B9/kv/.Z=['!(,ZHZhan׮c=7h_o]j|^/aQU D߸lٲGO>f4C6l&ʫJsM41㠄_U%CM=dp R~ @:ԼysuILL[ p:uRaxb% B|݇rk k.pG^TIoΝҪU+ݭz/[pfpwC QSOwgΜiZ.l_͋A5|=gA2Rh޽Nv=9Xj.+V&C8~ݎ;6áٳҦoUk7zP**a˘1cTC4zA3k߾KKK~ZE{Uݵh,І#oJS۷tՌ_HRRs=>ӧOz<6K]Kk.n=C ={phnݺ4jHz+j:ET(b^FtRďӱcTo)tTXLv \/"#GTc{ "h8Ư ?^ET=2bᅄaoLC{Q7 hļ[U1%zqy饗|J2k`2).QaGSo|+ !@Н;}k<@qix{kUpXx1 aRUzw+MU?o@*eU t7hxTSm @a}gt!@j S^=1_wn^].Ӈnu6%ZѮ CM{yG0'6Bv>X^#¢\=p},#ysVlAyrMq?h3*m?ҵIUT.  X,CPm,FU0e!P"@ fZIb(@CDJʹP,!4B(ri%Y,Ch  P(6J#@X%Pm,Fd 9$J(@L+ XbBsH PB)V 2@(Rn3$`1 e!P"@ fZIb(@CDJʹP,!4B(ri%Y,Ch #GٳgC)V5ƍ̙3m!4BHӴPB@@˚5k5vXiҤTVM/Ǐw Ad,J8ƍ ʌ3dɒ%&IIIn? ]J1c|.߱cL>]-ZDϟ/ b ӧ5 'VZ% ,iӦP[rDGGK~sҴiSYlF ]N>-?L:UԩBp߾}RF %B'7##1~ =䓂 9UЦM$..$@&6Z A;'zƊ SbEi۶СC HrrR߿sAEh۶mRBСԪUKV^B.;;[bbbQBcʕ+gxM$`~cǎ J|GfȑҩS'vڒ)aFKOO=z ؟ڀׯJ<(}tRիX 8ݻwKϞ=U!~+EFFʵ^D Bw5ר-ZDAQ5Cխ{2`D#~+k޼yYfҰaCUKII4Dӑ !C#u֕uIVVs-~ # P^. ϓ ؘ\Ct” 6H;ly]j֬)wy =@im-aO*U8g Y Ȃh.^(]t!Cn >\ T/tQ+\믿׼[jb2cUqXӗ[QN5T|r}xO>6?u^=.\X!_?3aÆiqnnϪ +bX/Ê{>ыsa)nݺX4ja{Ǽ|ҤIdT(ZB͍`~ۀd'1DȱJx]F F_pAP킨|Wrm1bsΕիA?lem,j8z4{QEY`8RSSSeԨQje_|QC5= Po1(T\٭eʔ3c 8pIB5Lo@g_7,g9Fc5'N8نcT9,4.>DU^=C8 rawdPlYv0UV~z'S1 \˖-Uc)q<}9娎a-(Lp7 r֏1Bnh`gr9tPe+_{55F1Cm„ RXX(;w9s:vFGu?N˵ . X{oqoJ+K/TTIkӦ7ߘWDQFap^R=s9x6nܨ{ĩ@zv]wi+dr;0 ]6M&cEǫ_K4-[]?PIFi*42{XQ*YӸ[E pu <;M?o]h`G@@ P&P'@ 7'>MNoO$@ |>B@I dI.@iiijY,; rtR2vX ,߿?~1 $@A@4x`Yv̚5K{=ɜqƩ0ޒ%K,< %NXb;dʦMB EWS۷L>]-Zde&+[R/afʍWwHt t7 6>P^c{씉UgDxѷU;_3K)<B% ,ilϒ-˗/ɓ'/pWF %B!V ؗ_JCX?;)4H)'aGyļqk3 k̑¼yխ.]s`\8T]B1Ӹ;a#$@ u;?Ν;+ի]ʆz]֭U]1HCQ{A,G{G)1J@kזL'cts H*@ ,P["ád]4׫W/R޽[zi\o W|2|p駟 ćzHvMZh!2rHIMMÇKrrt] ș _U ʞ={UVҩS'پ},^Xڵkg$hF{OfT=vLIIcy!=$@"F޽{R[֫W6q[ndee1w.1Hv.@ . \Vlle0 } f_LH4PJ*I$ WH4PJ*I$ WH4PJ*I$ WH4PJ*I$ D2 Gzrde,tkF|26ժRVyie!#@1K.ʫժRFU҉^ܥlܐ]:'r%ukjF%+g_^}GEoXpӶwd$`k [g'{;h= ؚGI(@?ZO&@ux7 ֓ pƻ#PxHaS ӴB &=4,2F?.w;|"Wv:EЋr%풽=Ӄwc$U:/ 9+̂K >t"Pwi:J$lkgkr"1 E^ QkȊKArURpf%RClh0F,We2;L]I233e„ uV9whM4I[H'r2dԭC$@YFu]Urʕn (tYj̟?_BrqTH !hݺUQصkr-#˗;ʕ+yY;v4iD/|q댡p2$@WLk`t]>+~؉'wޒ!3gΔKJZ[oUJƍǍ' .3fȒ%K$--M\ڜ&'`Hڀx A)Eo]5k_x>|X+ԩ:׵kW[|Ҿ}{ٱcL>]-ZDPKHH+VH>} IyVB1(6mZA`P1ףd+N]Eu ׯyx-[F2C't5m۶[v8p@ƌ'5jP"N:F? $@FR hDFFJڵ%**zг6l0i޼ :TӪx]jUڹs=ڈ" I` b*U}]ٰaCRSS}J-χR ۨvA]BW|^ \9xF&8J@[裏ʏ?oР$ӭ[7UB>PRGom>mڴ1AWlVE1;tčr^~ ؀kQÃG}6lbB6nܨJ-ׯpoGcԨjrtaJ[.==]'9ѣ(u6q/z#ѻ ѵ^KrrrJA{nٳg<&1`#>> `2 /O?rd$TEG$ tCps7o|0DG$@(VN-ժUsRjUJMMUFS6l7 g~ Ϧ\:%ᮣP-e-˗/7o5: pOjKQ.]ȱcOjSd Xvڒ)%..1~ Krrrd&ڴ4ٽ{ H,'@-Z|@E42>|X{2`g HL X6o<ӬY3iذDDDHJJ GAF _-E T\n1wn/d T.G*66rQx^'08|HdGx|d'w  r6@i2Y$` ;m$ %@ ҌeH(@v%HAJdPK(H3";!h# ) Pf,Ev @C.FR X&@d\$Gf,e[)ZX YBPfД$PRS*x @ HކHw ߙ  "@*! (@3$@%DTB y  P|g+HJ@6$@i=[y ؃%ٳ2vXiҤrq{$@^7N.\(3f̐%KHZZ$%% KC^+#-Xn.؎;dh"%:8|IHH+VH>}lF \J@+Whׯi}||4mT-[fC$`}I59Sddd8O$`s>}Z5<ZjUB;cFx駇H,'@QQQZ0 <'G~)$@!`kժ%.V ,&&){RPP`~vDG$`ڵkKffGD? XNz%999zj-zv-={4!? P-$11QF)raINNT `L Ir͛{5k& 6III4Dӑ mݺueݺuzĪU<ę %Ȱ.66zb~KwW3 @r`<06hֻէ~8"O!*ʕ ]Щm8L=ť;(\/t 7Haa_+_G)S뱶y%mC \ U$@WCҍWPv١\[CG6l X́Εۀ\0HOX|ѣGfٗ@nn+-[/B aM` 駟b sϹ3~iЕ,Kӧ i,?䓚>_p:7k,Oz.q}]uNQq9夳0}r੧:G`>QGGkƛn @I3jcƌZMoV£W4}dq$N/izT7niKCk 3rq ΆaYXrG c5j$.,ӊBC{IkH :%kY+?h  PHe7K"@V~)n&Ed5$R(@!L, XZAkH PB*XLɳFVرSNTfcvLԼq2j(byLjok}k拭B}d穉0` l //իW_=L~c,JX"%EFfϝ;W]Mgo= -w}%(nA'##C :9(9a-98M,IU0KfwS>3\RϜ9s$!!aAC|p7,˗}>1#c9 e ={{f/v4j7Wˆ8}-9.OM02(@Ɋ1U%,Mq# .TK J$/4uh.겲$.. &Y.Km+8 XRX9m߾]av;K`}eyLjoY/OlmQٲeU {[4uAO4Iȇ~n=#JFq?oܘ!=2m!p!M/7]gy\:V߶FZXZiM)ǖ2zȐ!Z||T<,1퍱4Ἁc5 pED%htHjlHtSN`:tzl/7q\nK8 KeGpء֤*l9~ex9M݃Om@g' `|,I;zG <9ox @F> Id3$`  k $@ lgI(@ZA!ID5PB2IENDB`rstatix/tools/README-comaprison-against-reference-group-3.png0000644000176200001440000002572515074310430023605 0ustar liggesusersPNG  IHDR ۤQ iCCPICC Profile8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|UP`o'IDATxKr)JAQԀb!`cbPT% #61bX(U@){]^޻;;0s9y|sz@#s9& ` <}Z{=Y|_^,Y"&M=zlݺU6m$7'Ho*ZEВGʴiwߕˏ?(={H>}dڵү_?ٻwc9rĊ#HMXőh [ tWW_--Z|=#%KnݺI…nB sгgO5ט5j$7'ɓ'o7bu]']v͛73pB曥I&̴XMXőX+вѯqM3}rW۷oAeΝYAsqmn6i4kLJ.-*ҴiS49@"~K(MO2i#~ o߾iZ\d)?nja?_뫯mܸQ6l Z2w˗7f⋦Pn]d;8zh{b& L 'LB&D3' (f2 @ $;vʕ+[Dᤉ`@7r/ 1 |QV;vL(< ""` *H"E,̟?T\9̏@Y@kw9rD_`Ĉ '@X*g@rIի4iDnV5 ,x; @ Fܹde'åyӳiɓ'k 4R7=zt| d@o߈Hn;v+VL.Kʕ+믗%JvˬYR+/5jԐRJIǎeaa8 v g;#7tSRfVZy'/)SFt۸m7|#_~w'0ܡm-ZyPzn E h/?Pn*|4hDsWJŊ^3b y8w}Sѩ[̜9SZnmrG M@dnS/|mB 5"Wk7js~i&N:uf͚lm$ v @>_.ޡCUVL}Ν+6m~Kٲeӱ;vrA .x͋Yb/WzV^t(cڵ[nLod(onep =q @"E߮];ٲe̞=;ůjo dɒҬY`N{1 5 թSLD-_K;9:SGm޼ W^ j)Wk B[ot4 d@;5:}6L˻zfIyuיu鳓=̙3Gt@SA gV۾}TV-ԋc@jC 1O.LUTmoܸi=5zoәḻ́6 foذAVZ% 9^u)]tE1 d[tO?m\ڷo՗vX~]XrǏ wՉZ8袦MJ>}dʔ)RhQ޽W7AA >b-۶m]A#ϯ:Kx7ͭ: 8 &G3HTƍW?CdC@8l v.\Xt6o`f *m&],f8M̛7OveFz@8tR! Yg|8ߙӬz-&MfMի_? ĩr 2G-\]P.6PͯJ9Z1G:ͻ.ZOS99 .=Cg.!E/B-:GC;#֪"jǻƌ#}Qȶ5kHϞ=/1#/Gƍüĉa~z2yd3c<¨Q"_˗KFG^Qf`{'MSs9M4{Ƞ #/3MU"oaPQteHϘNTϷA36r(}tP}x-[ 2W_} 80{BH1m u˖-x 3foW'x 9ki:w)GZg:U$tE}ڏVHoWiӦEF!y_GГ# ?n胬/@Ѧ]k)VxrѰKgT\"pV:*a>Ȱ6Y9 )?}VZQiʎXv+Xka5M+j[ ?_8r4_]WZyeM"kbi6bX?`G=xuo7k}cqDYjUgB M 9( *ȣ>; ѣG;iD>4*L@ @< @  iTd@<xh@@Ҩ0  x ", 4"R8uꔜ8q"K>/\ H,K=,?t_jԨ!J;ݻ@9'8~K>K  SLcʴidÆ ҢE 6` O@9"`Lŋn?˹e+^Sxwnݺ2sLiݺu=x@@l?^*V(K.jժEY/Q";RZliGRKy殳!Uo(Wݻ7 +QDÆ e۶mf@@ʗ//ڔBwھ}\wuaƧL2ҹsT%t^kj8@'ڄpa={t4ޟJ+W{.&82-[!#K `MqM@]t4mT#k׮[JݥI&ҩS'\ @qph&L`kժ%\pi 7n q/7@M M@ϷL'͛7OveFz@8@H, ٲ8@HG6%' @PCCMV!@Bip @C6Y J1 @cdrJ@1"~[.C"IK.NpINݺu4͚5sI}.*,L H@"i @\TX @ D$.@."0@" I\\DpQaa* D@I T@$$&qApEIH$M " S!$H@EBH$ 4  .*,L H@"i @\TX+V[tKC8+>+"\|5 G8@#$-1Cp4ŃqGH[b h $< @GAH yl D0'8q1/y捙TyeƎ+=㍊ͩSرcR`Aɗ/eO^G1`B/p2Q믿JѢESfC*޹s(P fi%1skꪫdҩS4ͥKt4nX&M>}ȑ#%wRRTN*" ^*Or@ h6*}98!aeҥK[n1;ժU[ 2eԮ];OqظqTPze*+W믿^J(!EˬYK<ֱ;w6m_~,[LzeƗ?1֡zo.]TZ5윓ЗeIXM`Ϟ=ҪU+9䥗^2eȳ>+m۶oF.lǕu"y|IwѠq|{ y& J3M6:Ck.YpaL/_.]vNgLLI0tPݻ|'IH#_:@ 7jSB_~TX1̺'SW^-͚53?*H@lz,'1y p饗w;w\ٴi\ya^=AZҥKYWdIscǎ07otMOAP1К.ʖ-=Wvé .> s@q' W@\]|,eĿ\ٔGڄGwZӥ9Q_?4I;EWv/!M6ZuŊfbq 0@b$ D>;ْܹ70',/6/Ly7͢{/t1N/ef]k@?ªUaÆfgyFg+ۃqp̪Gd$мys>,خ]W_//9 _m҄5kRG ^}]v/>cǎL<HjIW"w#p a1ʢEDlө~ߙ Wu?rHٳ̘14'Łuu G9Ik VH $ IT';HiM**TfNtP?+VVM_&?/_>yWeرf3[ f 裏_0lڴ)ҋs$5#%B76}pG mL :|o[|//k oi2Mwq^dqƾ7>PPnيs=n9|0?G CB|͠栍[lH%K{)bF:u*fܸqfOW,k۶IZ"r7a}Ba6o,˗ ^ _&Pwr-[ xs@!8-, T@R9 @[6X@ %r@%8l @R IKKpn` @!8ܲ2@I%_1@1IENDB`rstatix/tools/README-unnamed-chunk-10-1.png0000644000176200001440000010712115074710633017672 0ustar liggesusersPNG  IHDRǵiCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iOHC @IDATx]|EF(z/JUA@QA * *(6@EQ?QPޫz!@Bz߼ ren7vg2oUA`bF;n<`F`3!0#`0Ӊa3# #)ty،#0#0v3;x6#070" N'03 0#`0Ӊa3# #),0qqqصk,0W0 @dܹ APZ5t O#f NѣG1j(|嗸{.lقWq]*F`F`߾}رc6o,_ZѲeKTR6m3#`S(VVׯ/eCŜ9sC6m@': 01#X,899aݺu(WVX[nW>wwwܹs`[" 7n܈ "&&F*|oooo 0@tUo۶ \3#`sXd\t 3gĴi(bժUiZؗ,Y֭[ʕ+ԩ>zhDFFbѢExG0k,Z"#X>#Gbq~޽ L?$@4~x8q}~ycF@- ]aSOIY?AɧSRRзo_wܹsIY2`[b#XfFcda#ifyPF( ˞;wv:1SN; w0911#0:&@yIŰbϟޟä<&g0&F`ԂWHtDLvH10``LcF00nbW_Ņ Pvm3jGF.PX+PW0``=%F`T{j:3#XM(_'*U|}}iXWD 6#NKbJ:l< 2&Y"OZzV^ bQtBo@@UyROF0G1o9)i&OJJZ.8ɿgGG0#0U~`,+W켄_sמ-,'(95Sf,;//Fv{"7ۉ'ojKR`,ziVP= nv %F@<^_.-1;.׸p'&YfFx=)dgf[TTz;͞[,uV70=܈LD oԱկ 3+Ghnp#` ~'ǮPt(MXG01#`mdQӟlDbr-Dť/Yo2#` |> @#bNGGb_U7#lJ<8~) K^@GڦZr`bFZh#!ev$]>1#`4%l:Ug 3qrѓ0#` %|6ULg2C3#0C2߼d1,Q1?hmXp#`yJ,X}-r-P&F`, `«wޕ}}ѼysKIje\]kDb%[k_F l۶-*VhS((؛-(5 "t:|<]aF?(y4b {Nܲv"2E[ʊ˕1#"5k֠W^ D~pm駟駟λ6sLԮ]^^^hҤ ۼ{G-p!iKO<#G1é+wMbJy\QKF$F1cǎaРA(W~7޸W^ӧիWc8p -Z.]_Ǽy8.]DGGW1_N#yFMe3?Ǡ&bbb0uDD!Cpww"Ç]3Crj<%gbFH$%>*g/o>ȗ-[Vwnݺ_I[R%*DZ'K):>F0T.^Z?~ToٲFA L%WELc]ٲ6#h#7n]XI<1n8H0Y+Ro>^:!舜v--t׌}pb찹<#0F!`0Zi1?P||<~|76H,X*O:ףu # z̄ 䉁N RSUsT%:B_y 硭\#6] ـW_߇>C0ݻ7z-|G<… {GСCAbUVaٲewBF|S9+1{4w\CVupkF@)n=BOa:ڰar ʗ//E)u;πG~y)|fxpj --- [nC=tu5SfϞ}S ŋQt]}cQ'݀(qt {'K?9777bg*eMZ~^IC"?E!BJ*%uA~X`I 4zUKJ Dze\w0bL4 UVab;~} #X2`PX"LO#t^nXb~< ;w?0"`S퍆 J3Qs=SļR+p4۷o3rF`mۆ TO59M%lU<|O_U $4͛x'QV-L8QctYf2YN^0b;A2jOw8ۄ-4ӣ5Bdd$W?+ lĉ4HFvh𨐥j$+WEۆlk0Lk'/-7o΁dIWA$8O={4ʊ̀qF01pUl _k>>9Q>Q<(2|%P^=O>AӦMA" IHNp5]06@D3³}hߤ"\];T Qu|ҥKqh=)r)_>( ,YvܹrO>5`lzWE1#QZr>xUj(T׮]%(SĦD>;w⠕+WJ?1M6Iо}{xxxeӑ "t`]0oW'%GDpj&JYz<& Ȧ )SRRdzϗ_~Y߿}#&a 0VG@ݫpԯybUoP#LUvLpR >Ňϔ*tRC j$2Hrz@͆Oii;jaO[:PV7Jأg؝1cy R{RXp&FPv~}@ W(첵D=X#v+YyۣpݴS3g1C!G __m08 #`w yr(NEk]:䯙cҁd ԪUO`ԏ]2Y;^O F i?> e,\dCquD},Y"P]lz3f3[@sBbc7xJJ2Z\_x$=#B]#9?YX|||jj F(S#hʱ J{cnv'y,!ZkQt>1ǻĨGknǟč,{(޽{%LhhL]\8~gI)!0RBۿ̬ll?r[Bau7IST9/R"$.fiYn+K`aqT^#PVl˔e˖g}&QHZ(#h >0_$֢|l\+ 95S&rw!ɔr9_;s0T/'%PLj֬)x7F. fLnHO |9ٙBk٤BEL#m HSǽgF<?0fдY7==]fز18)F@Y4 Rf/DVD4D9sF!<8k!i@v:tV6ol) [JHHF@yX<\##0@&;0hZ<\cL\2vsoqI)HNMs$kxN 4Y kUă M`bm!ښ/6V41ׇ8;E,i1 cn`棲,1z5cxxkcx_g! @EaͮIC58})BMȒ]}/?< 0ە0/l[_z!Wg" @i7|=* B+a<]Q!S6*;rFM^kbhGIh͎ذ4:e8GRs=0(d8y Ɓw !d~J;h"]p9?SmCzA2L!UrbrMGj'Yf;}w^Wxxl 3%f&h,#;':at3&a#uP#HIi?t\h_/: ܍MB'""*^wF5ošH3aoȼė[!DE"75-7-Ə~*,nW3[pbjnF'+/jRIKl-Ѧixf¯nƤ43RIC# vh;,]XO@D[~g'ηNHJ7M 90=~`1ʧɓhƖW[<q?\_bވƻ]\Q0BBPW-n'S}oFXSM,!(r0Ze?K DslR:>XXwnEዟ6~?`bdmɭ~=`Gna(E83> ?xUtO\,ԉqrL F0`q阶GmD}zoa5o|nKU2@xYj,s)弸LpVOSgacq3c ]0NMd*+).T21u(V_u>446me Gȑ#ѴiӼ2|8+?A76R@uХkpr4҉&>1zF(d}Ca۶my=UVΝ;3xQfMtA^:tdyL|5a#ĪEF'j0P\\y+l,|P;e4޽{c~'97n 0vX۷Oq-K-qW^bCKLN81qtpDbR%0B {2מ={}vԩS=qlذחHFdj % ,iӒe`,ŵhӦEFFSN `׮]ظq#ckHqS ''^{N7fl?3 Mz[;ʡ# 0]#t^Jz`wtUѨ~ZX2OWSFrСC8<P:w͛7St}/_k׮.^Ln]&=l(`Et`u( W&8 3@X4j˗GZB'^zI0tDM41eeÙ!5! 钣pFaF48ֆ|*nlٲF$)ccc; lJ8HS39JVSW0-cjR8ű1[lncLAyI@Z;Q!˯Z(h\=QϨ`-v8T@M85% -gҰ{G PviY|`FD3jp0ִRa CfPz /au6W0f( k 6CdڢiMENԅqfZ3%%xH:MŶauM\FC<W!*xaxVZ>$%Ь \N}Y?QOv0հBҌʕ Sh\ #`;Ի**P.hCx04!A@P@_ z郩z/6q?Gy+ȏ'|3 *yRB=ZTFbЦi?aR/qўBY?(pT?΋ 6ܹssdTmc@  3ɯm Q =ѓ  N+?|Jj]ʈZZ/gB@;u ^*PVecPB)%L!0hHK4SIٵ^oW qNaLt [bAAFafSBky.|3 sJuDVRi|Z_2؝:uJ1l8!ܴY `]5ɴyYWÕc.vj%_/w,YE2%Q)\hN< 3cӁZ~1:kWǢP1S,YR޸2kA4ԘWvۼQ)Ha:vgϞ2ĉd;v쀟5kS"))I5#`OţM>-*L3†Igh,^.ºfČ BOhMmp2Qͱ{nY +U{)G61VCL>|\W-%;BM3-TZ.Էb+,:!\n"[美o2yxx 55:tСCe~wߥ"0rHԭ[WwU#` @7;$YF':#:7*/o/wLFqxgʨwJRP)K׌Mj_fw1M^h٨*,eݼ표,\]]e]6|}}eSJwh*G>iy*DH܉K'YWRDI\3Q>C:t!ۉ46]7.ێ!UD=0NnNǍ'?C`q⧟~wgK.ϕ1@AsW2k`dzj<# ZxUb $ c+W(i8<ضmWxG sux1oňqED%ԭu| xe-7|?\69i$Xd ƌ .TR2kɓcU+dgvCrXZ&u×8q&]7<'Kzww_{ltaڴi>2g+f`fμ }lG`њX0K'bSiwWe~Hyι5wk / DfW_ r~X@L`Sds=+.!{\+qu݈Fbr*R҅#h#ՃРf4VJO};V:yYFZ)?W Wk3Hݰzwh _? ,@rr2<==okdZpnN9"  #)Zjf(W3s2҅#+/f:eB@آ8#D>Y YH9V>4N󒓓 HrW"+69i)I Dh R"}H#U29b"` Ҝy8bQ?$f:kxpLa5^M?g'#%!,ěDd$щFW+Hڽ ^l ZŦFpN$wS?-GBdk@Ոm_X'2!ʎBe -4_g!`W'T1Cp읉p ,-I2\GYb7F`e!G{Y8zxU%?0EnNIWXNk<8(tH1iIt ";XscW㽧ʼn =<ɹ&˕0 'ڈJ~mv+]Ao,Ұ 7m&RF0`KD[ByOi>nՐ#GbQQz9Οb5,YqEH](cNz r QI&B0J 31 7+E2HtI} ?anB|/ޜ$qژaz9B }(DbQ {i+,\rⶸhE*l2BȲDDll?KEE_y);=dݹ;ⷒ%.^,Lc!NQW}0r)|0ElKJ[de ]vi##"6P(S((G,N_5Tϟc\z5FbѢEҥ ^ư7Oާ?nݺ?!C0k,ܽ{<bbr貅2owޑ^s(rB=B}Wr&1ۙPc˜@& H1 !P#Xll,>CL>/R˖-Qr弝Ύ;>gGI$M' Fk{' | V\UV!44͚5e#ܹst!/%q]Qv܉TۙwԖ?F䌬;p wJ_X Mi ,c,] o۠}qN?BEZlz4D-Z_~)wӽScΝ >-:jڴ)#;vL@t?]DBBY?JEy\NVPjMPQVQO`S,)|{.}iӸxbߣ>*O67[2}+WIcFXXLk?gϞ{qqqC~ZtY6}s]m+X1J~қnp/b喝8w9WW5z "F'6LLӧOcƍRE([NV>i!~>h YN 1v/ D~ cvcѻa;?.Sk Y}"K?}v&=g՗[.\?]  q_&B z(IίOJqE؆,^y)'Q){OOO??N:xT*<6l0=~cVxwpq9(EQLRՙ_苃ZkOY i\cB7hH7'[/w"P(Q|IisAiI$X`<=zׯG֭(EOA裏/M6g}V8i߾}tTA^z2ݫj8 pru)E"y;\ܔz(s 1ς̿0('6+dM?:'25I=dI uVPR%:u ;w=ӢN͛ 2J¦M"B1S*|h'֭[VHHN<~ K U覞ϘPߕ"rb'FTB4v9GҀc}ܔ;V;-dN ;}& >$gR*ROIKZuD `z]fC>S8r䈴O&AA_-$OMM\%oV>&E}JOwuH8՘TU-2ܳh_!} Oп{"ąCfY'ؖDd {no^n{!ϝ;XZ @7z-utN Z񑬌]N2*Z#:]m =)=o˱`bꆎ} .$ ĝ$ƞddM|TT<<H;tPL4IF _! ԀI=]zRc{qIdUGi@iFm!z9 k6pB_w:F=Y^v,_[J%vt'@yr'c@$$.&1 PhrdRE *{ج@\  d~}% TBˊmpy<P9m[ac؀д^mEL |YiT.Ϟ=+zwwwe y(˄ 8|l۶ XrA"`4(ȼ˺]65F "WZa>uju$>]!ft!.̻C;dWO(tNy Y3RQ> ONUd?o<_[i*T9x2GLk IGźR:B  v ջ*K]vp 7p^X21XEO<#~?Pv)2xm (o+=N7XXVAi8zo/ſ *0Cѿ<C`Y&t/()U I,vdIɓ'q7"pRijl2]d :v;wH0F,ūwtuAO'MO&S>U(?56EUT{b ߾*Skq K'^4Ou*t{[[6}IdC̀ h޽2k׮R'Pşx@ ~2!1F^QN*WXKW@,ۜ=;zx#pgq 1uoFZLb{җOdOȾ|X0~7־o" >MdK'퇀!o"l(6-r u8og$LE`Ĉ25k{I?yR^z dODt4;X;]1=¹7dͦN!mD|kմYvn5 A܌۹&()CPgpl3~Y.!]Ci\ |粃dy-iD;LEMU-r84"5Y> ~ ~YIpL(Nc~Wρg's1|/eZ.\kξAs<'EEP:&@q;2(~*׼fK@S]tX|)7#hE'kw_ý\n56hFNyjQ !_h+W5E֭իWK3PIY)a6vhڼTLO\.|?[D;]e9 r Uo›ğ78GËx )}p%~A#Vʖ-9s">@2rW JJRR0=&m# P˗~12#?}T}Ϟ=2/x񋂽?}7o߾'^0? ZhK_w &Tr`PrG(f*1``P ,|`3?̮UXRlYdq0FN vk<i"&kS&\eUZU1@IDAT≨”rh>v!DBi7GZ;тQmJY]ymceŒ͔j,LTb.E%4$e"C:::Uz!5zj)/8kL% bWo௺m>\.}CóB9iq8-F{?^ʀLF W0JVH]$rs"X5צB={:F(YM廉vWX?~:* _aT",_h"051it}.Nj^zQ>$CԹP c?|3&wXwZ^KJ},`x iٲܱn bm'6 `$:y 3=5oc#'gVW63҇yn!g *HzZTJ.%|?V!-ߋ{ՉHy=nc;Af G j9P˫ `G&NEHы ޹gHϲE΀FNk(҄e. skbtX+Aɘ&CC]ptv+ n2 RCbޔ5'okۯd{u=X/~xJ,/ibi<$}]Zh"Ymq3['19'P qDv.S76 q t6–]ඍ@D2t\p%U4r_@fh>)rj?AP%R?{!Ϩ e%{Jh$ ( 2s1 ?0ZbO58nye89@iQ'4"BIl_'o)dxE0B~ bGVpitJB=p>|:uBPP^}Uܸq#o;v_!Cth߾=͛w>^@ аaCxO?WΘ/EQ75KBp˨gLN*id w1 ͥؔtZ>S젳QXJuqqq8x zaÆI&_bE{>>>$nGň#s˖-KfЧO wA!U >}:1zh$''f͚&c}M{fǝdp5\V3 Z(.nFI(m뿸>s!B=87@`R?1Fp0z[޽S?;#GzUY&`,^"1]&O ̙P%1E.j,4d%1K{z :>Jq }ݻw޵+… ySO=%G}T}bbbOOe>___]q)̲)=&!P,Bi;] EIt/M25nYxoF1Zu䔻Zt.*Urr8s Zn}}R|\3B)i2S ?BS֩B'8"QwR"2(Dtt@$"ul̘1Q Y]HODäCOQQq`}w_vp7 ?n7MbanpwqX8SZa~z >1c昀Q 0o߾nڵKZ -[VZ8p$)I`xӎ%u+gp.ޞU{ARvǫD.i<撷٫b\~,(3gΔ:R1F¶diC=dNJ鬄FڵÄ pm|WF>!UM;{C#W]]]9c/\^iܾU3O1^.)]C)-Ӯ;C@cRsYs='4+12t!woV?i_~A`` yxW$&)|*hڴiҔÌcpҰX ~)۴e\DYj?n9PbarGsH%TZ>$"?(ҧ'|/d ֩ bdO U捇J-vH B6ԬY3 ?λ}%Ydž d%JkiWZwtp)zPAa ɠ mTU[{5H(Nj 7gG,S.G }5֮D^^^@fj&\24}"ǰuDLMܹ~Q>~ծ%-^@ Zu3B`P @̾JV"Ta5O޶۟8q"~@1R /̱co+6tPW 0 Q0L% -ج.mʚ}lp6ž^3ؿjp5@cNC7/ͩGϞ?3R!?I,HB"uI+sJˠ/B¨ile{@6`XBg) xCR瞄g <ï9"]~RfG5R+ݿba?@εL*QZIZHgdd?F-dDEax衇)"z{{KQhUe[Lb;L^z@e#4Z#: ŧ,Z% Qo7$>W8Y'lpL)HT̛PH: OV)WCD9SM6*A#c^ãP8ҧ)22$ (; A_O1xࠡ8dTws&-jA-l`16<hQ7" -3bykpu6){ *Z*yfl۶ /t邀iɸzj=\#+e˖DX4Z+J,="*5$uGqҞ\v?4db˦(]q 4SO߶Ho:, ~$` E4UGr4x$ #U7SܟS:u@Lb|L%%MD#Nh0~4b*Z&篐=\aw-M2=WOOפ1؍oU 4`-0I%T 4[ܘlqEߤ,֬Y$v}(w!$$D*?h@7;VqҥP׼Ev".3>2yջw@V4e"s4.&=_ε_%´y0TRqrŋxgܹs211W?{֨aߊ!mۢCAbPmi5ljo3q^ڽ=*uh{U0 m?ϲϽ~l]Q1`ch@=*d9{/dSX蜴?4*EU=GA()!93*Yu'dXΆaܹ+W/U ΔܷTEmD '2B^8fGQ\FhsE3^A;kVI/A2IL )zaLZ%f 9u5jH4?1ٲeKIW))I9ܭ%v3>F@pt3ĒSzvBG)ڌG)[zEAbrF%)6{qvmj;/|WQ'cBr>pMQ4(7D]e( DЅSU@rL# |Nv(6PU FTPEPHb?MU($w,WrCd7(U"4},IXi|R] !ôxQnT@ {A'{e4H;W=( z.JGK~r"E/lIT ÇTZ|/:IqGݣ=sf:7--[B8uɳlW? CW)&[զ |0 0 >j b//_);BGԌ,<]QM*x%oڵ1ydL2Eo۶-J1K߮]ާ#GTôbٜܶ;[[w#q٫rh'&9|;˵{~/bK]rV]@ Z7b =k߰6^1P"*]{}LR}A=wd41$3%=:\81`wb `WZNqn+4+ɣſΐxFרRP,rvC6-BrVYӘ}*ahWj$mV?f~&@>%&GRn8@GK0F1HԹ zlX t6[X 9]~,<- ?u1z$c?Cjo5JbIrb0:: K J|e˖uT(7Iv(lˋz.E+_vzUO$ B?:!5i(6xfj>GSf od$$aBb&?|t-N.&|X+1{9B._L@<k0)?ѠA;1:%tboso iDlۃ; E$ߺt8liqljHԹQ5oW{p =!CJ'$%+=tҭELPGp~F/琘Kd$&]%1RJBCPFUl EP~&`۞YufLBaIc5JX ~IKuH/ێ"r))))iLrz)Zd؉*"DMP "Sf VomX)%)8TɎ7fy\S0"+Y5q]_&&@vd3c 8PKL3#QDk7 "ye5t%LH\"C]/yj<dEcIK$' ݅KXKLH %aZ;c)))v%(b%1ztr(VRGLR8igOceF@A(&W0pJMe[iԬMIݞƜ)1\ӘiIVy!ljd4חG|TTXQ10^\z4TܸqîL)4=s||ʭT _rr2(iЎA 1{sDDn޼iWc Cdd]̙3C 冶 ^vGP`" F`3-``\#0ZDg0hZ "V IaLLDLx8^^pW`-bH! BAИ]\IF,.hf(kt3Mٶ ).3Y&O9"b J UKvKIyNb)zJ1P긜-BW_[o5>GsBM+V"b#yy4VW"B`g72-gki"q*Mx:#5=e1] nQ}Aq@[~m d/+:|x(rD< h"Ú)ڰqnLN8noފ{[+ &b*vx.E,޴^/NuY9H|̂~>enbjn+ٴ^]UޟXY}fSw(PUd P#h=MP-aOOH-%{-OG^pD8[8/ium$މ(84X{{╓ ٢<;)C{}Z⋿n9"Up?(!znY=[8  MKCE/?Gt݂3v 1E愌ߒD4<6Owe,Z73|f% ~H9}(-r 12wn a߸M÷s8S(7pG- .hd=Ċ+E2qާHCTJ',93QN˜,k1xz6$ߓ[k&FR_C←ovorrgnϘj.{1s.oFĶC_[lcw,򙔽<),:b!& v'd_43מƗ+_gfbSpwT$X {aIH,v8Q,;%]6)'ЩOxMRtW[!:􈭻R:D;/b = o䏓B4:loIQ lb-}Fy tkfᛰqޤ:IvhdpL .,s^ S DF_u\:?@GLyY1ke(pFh-d KFBHTP9[\Lo:-* Gz梮!M[|>YzwbSȇO5&˂)%!PMNJ2G } [W,8 aߒH4w$non3<DA{0TTHJadZ5ԥ"b nR GZgMP*'@>*]ǵ?Vr"? R*Ag!B0ZhJdulnV| {  3Le~7ih9bJCZ5%HuGb4SXX/Pf/?VK($W}ӭ?=f71.Ћ 5SC7cdϹ>y0XƮ"5)nY+~;ܵGq,/Z+3P]L)ަ r"j_'e %CXYC4jPg>)sJ ZLV;H;XV=^hl[6}(͟?_ $3g [Mh3z0v]vfY[Mw\vr!rgDaKot*ԅ֤GjA-k]xx@hߖ:,kfK\dg[zkʹ/j9d|G,nիW˧~*?侇C+pK?ڡƉo+>X^{5MpB-t \@ _Ι3G?|l7>۾/VÃ^}̆$WKsvk*]uO__{=Aqڴi2c m_r92fǺukiɀo>.ZMRUovShIƬ3*k+B$7,x[B's&W}erMsSҷKRUկ5K@,ydXIr-2tPիtMk^q7NΝ+G/ώ-uIu&v|ǚGnAǏ'|t{_&>H6},'&cU,*B+~elrBu-ӣ" bb'{9sWjb+esifYًLp&'?6{VǓ`oO?]ny饗^hӡ+g}VO.C GyD>lyw裏ֲ2yds9>4Ù͎oW$4>6-,'+@((˾[yeÞ?nKro2 Ŵ@ʿ+*g@􇮟E;ɥ@c1z<,g{/Xe4iSVUUo!mg{1:u<NJXzY~ 0@&L =|RVV?Bo5޼;l;?8EX<37{x$qӵ\ ߬~h:du/^l;cǎ2eYy8NO{)"kӣ`ҥ>:t"?1YQd݁UqtsƮ[sKox ÆY~n _:4pZc?3X\1fl]jjji}=hv [޽tE.\ Xt8eo)yB6nl*^+0t?־N=]6}?;ZѺDE^G&Oz/x*CiǶ> w0N95k\}ղneNr@э+D,lKV'?at?'w[J:u,|-zC,鸖J'ZhOl #TyEbbxا\r%6l6 ￯ ;UIɶsz)N]eR5/hɡX P;oyAyyIj PW&ܣS;c9U ~18*^4'Yy*J-S!:8zgŊ "tG)_eժU1z*2/{0?{NߥU'C e$[/V sw]?R{E]OgGE~ndʜB^@lta 3gU9rox@wxFsI@oΣ\>S3g,_kRh.*-mf*Lٷp28uzs]nh3$L&)ϡ ʪ [BFW15IJ }N:A־3jao 18:[_ġ0M( e/*ʵ\#(2F LwC;.*lD獌 (,TK Z`Z5nO@3(,GCL <?mٰϡ㨣reqTgRV0*#zrC4TS Ρ`+?A]s0^|~ y?Oڐ$H| BhU&>3<8~Fr j=:Ka@ FI\=~r8*v⯪qc?}N<=r=pJIU3WX^,'N/Ņ[uȴq)YfW)/+&@#Nª)o%YYPP^&{x-d^O5 غNn0$3N9 #1.o P1)=%ZcZgIacRG# s׃&J?BT.PJV''pDʞe뤨}v4Yy(23ҒN+9hhwS;ym +Oڞv2*z~wIaEvIЎ#K3Om;α/zAyQ}9}gLc쉞@vzҩDn7|>@\!*21&U(}L+)Q{WtQmG[aJ.o%+ٝ2o _zp\ Vi~R}ᯥdp{r&kG/z=]/!{b C4|%^|V:v Vͭ5BcgoFp.7NvȬn:iҳKvwQXcmTuuR<`D /#>fS%@'nj .e?^Oy}3I6Wzv)t9/8UF OоHxd̅9o.C -)OXnKޑ-._}.7ax3-4l`y{)=HJH -T /c~Ju"ܜԃ]2Hc',#-[#JK0_F=7AhЊ bEp}2#;_.cFuR劔LiCC ƃz.kG& &W?>_6 T 5I˥ӆ!5яhm`PN~m0B6!W+2Cq[#3+Gk>~C1_#_Yr=0䍾KawĝJħ)o>B~Nwv4&Snڻ#<}O;cvA$v!xTى!_u,j_)T6%cē>vt?|,{ YL%gpSRU%DjLʉ;q}Ӈϧ~"}. ߂^Ac~w =}v@r{Kmm.p g\p=4Y9K-|_k0f.m☽" 7H;02+Az bsSdUX6cH ylYvcuYi|k߮H.0 W{yuƇdz]DIFXF居Ѥ۲}'9 GbaW79ޙ37 QMp:aqY{݅%Rri&b+[-Õ¯3 c,@o+\^pdXCfTfک2IJAGPv*6oia cE[+ bLÇKeZ)Y~_4Κ/_+c/2糜_>끲J?%#рр@ 4` @ jP   ȅdx400HHR J\Ѐ1 FFF)@A\.<$sΕΝ;{(Ev/y%sV*oذ!d޾}lڴ)d 7yǎ ۣ3rP_|a6oNbj Y4,vXy眏2$S! @f   0sS42   xЀ1f   ٭ 8&ܵ]%2^N,]'p//'nt$6 )6f:3M0@3ZN w,f^bv(BTYt@ :xq>o5htI\a4h.v+0f@hNh -Il6bTdWP<&dJVoI!|owm*IāBґ "(_H E%ǔ C5< ylh3B, iQɈGbasVиMP6e5kŃa|Ȉ08D#0QB[`PvԎ#aW>Gd$,hܱYιyg)s[0ۮLJ}XFaw&o;F;;8t/XKq(xLZA<RB|23? q"Ϯ8#@4qeؖ4ă0F3/ &HMM'M/'!=I&mæ8v54$2];@G~&Bq }MG<4<(7qW@mavYH݆%-DSV:yN|FDQyɋ?(kBF2^v v2_q+ t-4'$ûP:qP;y3\H4Y8K+m̻F(NMy`F8<",~|p{eӌ'} st` Mďva:+i_ 0NU9Ag kA?o±? ;/m' <쀖۩0vJ$ Zzˡw;HkB4@)Bm[~n-Y"2z.g_2TgoC|ƈjH(75aDVm|0xϷx4'oԸm PY_iu 5V>`pkcy;uyR8|3G:ZoC-e+}\QoaeσP&<M#NUYTf1)~Q>yݩ_|1> `}p`ϸmzp)JA &J߮4 @@?[B\^L0000C ݈l4`4`4@ `<Հ1yFFFwhhh O5` @>x#рр@κߗWiقaFCۙ õ K)iƒ++*nbX h8c#ݼ@`?tU5;N=   )MeNh# wp⑵ CX @_(RUY2nt$N 2Zĕh8|Q9(0qcd v䋕^qZTCKيtgi,.L40K>D6RO@JC:] < 5нWA: Q-x3iuu+Z;iӛ"[|SqFL/˗JeU['aZ%.቎3͑ljS" >/p tvl(;KIO˦C&y(2nu$0`2 'nٶvʪ ϯ Z[0^ͳi`XitlWt%n7ɦ pm@tP\] 97K+*?;n糜0,?E+LD6(u+Xhmx"}YyRjGX80Mm7dk9 %_,P! E^rv }.4',ҷ[5 Ama8,n]3uwiWRY[./ !N0zbHx 5R;ɅgDgV.=kL ![A,cHSGOܬ[1`<,;apc5),v3*@b &'L 3e]fs=izj:tIN{챴^d5x%#84h5yd XmeY|գGԺKpL+ էO ;xoN:9nd~'T\ٿ뷿' y?2)7lu¢>k}P*Nck6BxȽW_}U{^) neҾ}{C_c޽ QG%x뮻nD8O։xt 9 tBUХ>@vq#3^}2m4e. Ff * ,DV."Yf %MY1!G}&{x߸؍|\y啂t*7 9MTHlKRŸpêuRtӦM̍%>|;RXܩoƍh>ގ[3wrq%4Jr9?ۂF -Là ra/ Ufzqro-Ua+apG0a2?55䤮nWB YI;}YsY>SLT &H=vWSNO{焕Ml̙3G7pn ٜ(_f&+TXlغPOl`㏏$ *+<CC:܂vXXt[~HW2MaEo޼Y8dp3#PBMQ!InݺYhh]BZƃT72G'd'V裏Z0t\roK~ZoMVNrsҔoY{D.HiEW.Lh_yc򗿴pN@7ndmݦpވug# 4'Q/"X ˆp2 }{d0V>L}y ha[EiW$8a U4TɄDeHTf xγK5W5Y Y18?C{wZk̄e%o^x\AWdB2ӥk#0? f0$ԉ;y8 zM(C-I s0V8472'$ 72@ 4]gJV߭t7z'N:DOC0 ۞hhh MH&F 5` 4،rF̣2   cէf4`4`430 gahhh_ > 6р19 FFFji   șGe500WOhhh g4dGIENDB`rstatix/tools/README-comaprison-against-reference-group-2.png0000644000176200001440000002524615074710632023612 0ustar liggesusersPNG  IHDRP +iCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iP &IDATx xNWA"DL)MmEŠϤdt1mVLˠЪ%*c 1iRt EDDP߾}{ ԢE U` ^---MiӦQllG9Bu"~ϟ?uڶmv= Mp3f 5oޜ^z%<G&&&C@OW EPݴi-]ӗ\wF]k67|^ 7nZsQɓ'E<(j?8կ_xz|2լYř׾+M|5P<Йaʂ… G#FP6mh׮]T^=x"qVN:i@L%`XaÆ .fŴb a֭D[kSTT$KIIQ` V G}%ܯɦI&ԴiSa~MѣGիz5:PZZ?  `@%KEAt"Ep ~A@@/@eWy[ٸqcھ};]pxT۴&o @$`(Odު.ji A ^A@@K;A,x-  h@ Z@ AWji A ^A@@K;A,x- ^  e:u+֏P Xr8Iѣw^qY6k,:s8rժUo>Yf ;vΞ=K3gy lTCҥKÇ7ߤ*--SN{_B֭#>y~k)==]$yUA@PH`СEC Hk>R|ȑ½K.ԹsgqnY텽gϞTJqYZ3adÂ= p u\hmۖ\"2r90a8Q P,X@'Nxv]]ɮwO7q3A@ ZH @JI# NZH @JI# NZH &>}zHeRō̂~rrrD{b^P R `P  `=P R `P  `=P R `P  `=P R `P  `=P R `P  `=P R `P  `= h'zh"0\@?No5nܘի'NSR`_vMOkצT*..Vn@,Ap}h۶miϞ=ԻwoM[d8qzA`ƍi˖-{nJNNQ߼yȑ#5B3gݻ ?˖-Dˣ>}d > Zիq^ON-&<<\|SDDW\󟄄jѢn QӦME^*jӦMS&M;Dԩ#DT '66Ο?u@L%`js}_}$7ozTx_W޾}[ z0 LVV_ZjE-[I|rTgz-mĂyr!IاNw}o΃ pq _axxCT*hO ݸq>s#/_5knݚۧ~~TO ݣYfљ3gɓj*Xf ;vΞ=K3g$rJ1`yQڻw/XB{ #$""`hԩSğN:ӎ; xx5Q> ߭ٳgQ>|8qeڵzjںuqrKDÇI?| 5Џ?v*u* I;wf͚ nݺO]1EEEtJIIQ .xȑE]tΝ;Sď3{IUT#FPZhС!C(22R\ %"\:h ZXģ~- 6Le*AIIIB(G-b/=3|QEM0pЂ hĉ\ wjѢEԶm[RV C B@H7ȓ᥸8IN4jH)zq_ה\uBIH(o 3#guR6yi&Wq,.NGL@Fpeܱ/B 0  `UZ !-5< 2S  /Rs/!b6o# Hڈ  N,f5<# Hڈ  "j71(ZSټy3?ޔ!`G /7"TViMK3t "y2 [ƍsx.=#jea)| vT61ڶp @@. `[P `6]t LaC4СCjzD 8x uQ &<^('@  DDD/ Ͽs0P3#NЙXԨsTf4͠8AAbD&@ 5:p#0 @ (Fd@ P3#NG: 3@@͠8AA+Q Ыߦ jЎٳԲeKS \z֭[Gu5< ޽{uQF>|Xx/..&f۴iS[_hт"##u=;\B޽{">7̖-[EFol21chƌd^#TG?ӨQ{tb׮]  B  $h@PA@ H ;(07P/X8@nӦx]vBPy̙CԽ{w]yǞ<ӧ{S%ϟDnݚΝ'MU6B+OBB8B@U*M (U{]:y_>Ifl۶Mūm9rDL$皮p]y.Uo Ja$ kժ%~}]v-ׯ__~Y  :TdKi<gz'ϝ;w5F Ih֬Y8̰cǎB]#cǎ͛ŒETS׹[?ciذaЛ@1ON_)5FН;wR hbD_ry? =#%PPP^+#OZÓΟyiĈ{nPz 9x/ (ƵFi^So?犖eЩ޽{SQQ}9xEOr_p`VK%8g[GXآ$w/ΝpetiںuxݺuBb[(N \K/$&smk_ESY^Ṟ,<1WG1̃QTrѴzj^:qӼCx7N `OqƩ[ƿŎG2 .gϞM_P67,{Y*%?~M#oh߾}<;DLg6eT,v_qkܸGmZ&= &22tPk0  ˬB푓SYv=M6OgbiPKstVf1Zά3ԇPAB4 YЇT@ @@CE}@@PAB4 YЇT@ @@CE}@@PAB4 YЇT@ `-|2J`͚5TfMWG\@9@@ ؛@۶m2ЄLQ ! v#[! !LQ ! v#[! !A$?Ew^*((o8qBCNL;w A @@͛i~|w{^Fcƌ@ @@|vM з}ݻw $ 6"٠A} ( @`0'P$p*wޥ[nRIʼ  ` @Æ k(==vڔJ f0E@o޼IÇ 6x{FFeggSff&]< V!`j~^94nܘ>yTÀ*`z*K6 -  h@ Z@ AW(6fy}89U0 Ɖ~}@)vd9}XFΝ;%)~cٶmAs=gt@ D 7PoT  ^@@7*p@@/  @ @F @@  x#Fn  h@z74H @@QyTÀXR@H<@JMxB@@@K5PmBRN^K>>g@ ܍˄ɢ͛Gcǎ:TjURQs#qxG"##MO^N]zudgˡ͜T1yO?MW{ٱT5jD;v+VX*]vO̘1chƌ!o/@" ؝-A^Wy#i|7P+.PDNgRvB4dhhW4 s$ snw10K} zA@M*,͚5'Mɚ5kχr;LW>"GO~zUFɴi&t M(MӟڷoO7o}ȑ#EJ~m)M/&0ǏRqqq`W.]Dz?H ,|}!;v젧zm'K@E_wח~5 &H'ɓU7wKϞ=˖I#<‹Gu$"G vR\zUW^yEusMx~7n(η׮ZĿ{n)j֭}7ӟ'ě9sv*z}.z!k\T<ׯ/L4tЊb!bɄAwxsM) |Tw&G;\sp:vpn &0ٵ Gxe Iʕ+3СC(//|I3cXh#bcFs4YpkKwޢ/@U‡P|t3JkWmlذAk7߹Þ/g}+ptiqyV@@M()K<FYM9̓̀bJrs_ڲerCLX:uꤾNj?rhO:vc2'R~D 7É`@#5=b9ڼ|@@cAlNjDA#5=b9 0< dggX|BEP~ @@"N \A@/_D`EׯǢag݊RRR/=+7cyĊ.y9-&/;wTn>Aov% ݲmy#>Քw_pQF䇏y?R?>^}U'> u޼yWG׿Em۶ӧO'%33SlKhpƒ~"餼ȵP˕pP7-Uo~#pz_>"E-ɵN&E{zKCh9XBji|.֤Zmbd^M}~‰^L\{֭K/{L/((.]3@:J*S74vtK}'*TS Һ)e7͊MVV׏fϞ-?9qƉ=Vy>UO77y#좢"%H|0…oǬիW8SOTLLLy;Y5k&5k\Z|9M0^HqdIoNP;`+|nٲ]p_1|?,+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iPth6IDATxEWrZEI"PL+ DQ9 rLQGPQ9DA0 . Q2Ko?uNef~J]g*uU! @|1HH@@$@A HH I$8F#  ($@$$ hH( @(Ac4 ;@$@A HH I$8F#  ($@$$ hH( @(Ac4 ;`{GNfKWU{m`2<8aWonٹs'~h@2skNɑ܂:z*GtV.J&J\\\aew[jzs%?pJH\BB3x\xnjYK˷q]rdߞp=k_ܹd㗥X,IXC-Pk82$tU͠SϯG͇j A&?稜x=Ze~$Cgh`E Z@333eӦMRxqiѢECRlY)Sw& q)Z})Y{߿_F^:tHN>旗'6lRJIÆ С`D* }b瞓ʕ+/7xTXQƎ[`ɯ: ŋUV߱cLnP\~2uT1cȴid͚5qFٶm,\P^z%yקO ۷O;뮻ѣeĉvZ_e׮]O*oծ^  &nϞ=R|yA7tΝne(6E̞֭=[,Y" Pի[8q&W`oݝY/Ǐ9sI&f-[{'{WicdZ,y'1%?;ݢEJ߾}壏>zuǎVZ/?jM0hݻWvޭZ;?}ծK.Un) Z?`l ꯁ,_\7nH=PU8V^]fΜ 믿~>#7ޟٺudeeIΝҥjioٲE.B/`Nm}8hA߿\ve]m w[Q6&Pg=P@U0ꫯɂ޽{KUW5B`BO޽+VL֯_o (Z:.ZyP&[5+ w77WOVɋwy;@p*U$eZI(V^8e  tFdܹV%z_s5* z!KViF%`Ѐ?& Е7nՉSO=PKO  .00s+?oœ҆ 3̏^cӦMj:))-ZUH鋂g1h~J@1 !5ʊcq5(;㸧9J%"/Lk aٳ f͚IڵպJ, fbH f^ fGe4X^O?-7|A*w,E]C k;< O`_T?,IO>D'XAarcG-XAL a0 A@zi,g1# h2hyCT3ӟ+ɀB,| 1cZtI!5k9yKpRSS]);]vt}paP,F7U&{sR_4ygW]Eߍ)G^CLI`>k;!!Au= *"S}s׾эb4j3FR41AٺԫR"&KTr}OdcPpO0#z fDLiH(NuH\j F&B$DP':L$`  %  P@X,3 %(`d"$@N$@ub$@Z 8ԉ2 XBj F&B$DP':L$`  %  P@X,3 %(`d"$@N$@ub$@Z 8ԉ2 XBj F&B$DP':L$`  %  P@X,3 %(`d"$@N$@ub$@Z 8@L ޽{ɓNGH bJ@֭+&LFޒHbJ@X,3 @P@#Ǟw&r(@fH r(c; D9 iQ'UХKJ||n|iR~})WG>$@$iSN]w%Z#F9sĉe޼y!]t6y (?RX1oڴIƏs̙ҨQ#Y`t+HH "]x@x 2/ZHG_ZZ4h@ϟoB$@&vT]cJjռʿm6XQWO=p$@$Qa:Tի'_~ūXLyez ]3vZHH * .3f9 2 jf?..Nݜw)>} )ӧUoT-UVO?ʹuV矕jժrQ;vLRRR/2=ᕘ  %@1~_￯^4hiF~GR:tHZ߾}{hʿDZ4$@$.ak^pexL6M>ceԩjM.[L] ]uСF D@Z^7nحFVZRvm׬Y3%C ٳg ZhkNH"I l-@ 9}t5 QMMM̮Ox.kmI_^^?z髮5 -Ƥ]éƍs{z {2&M|֭[B״nZ~k)S3ƍ Oذa?@_r%j 1x`L+Ǐ˿/JNNaƌ)Z33tAx f͚~eC?vi0~?W1chM6=W/jf}ϠV`>Zj=C邪ܺv]%K4Mo*^zI7r58)RDSד&Mo>u ?|k!srJ  %t=HϞ=^xA֮]+˗W-IJfy⩳[ fEG*T`eYb:yՅa=JJ*WɞF׭[W'#G7|3kn:׃y+V)_ o3ZW_2;#.rUx@mƒxdZ_Z[ӑG'L۶mOAT1^o߾J! +#<"0`]^l azB)?TG`nc`>_(p:uA1ƙ掋;v(7c\:lˈ??C֤z%C; T'D6Bԟ~iOq U-d Z$,]wLp]?#@cRBu2*;瘥5j=]uF # 6ٕW^f@njBn䊨\7&|%K*1C3) }#B* :qj=>v`q 5Ï {O 0h7ʎ@uD9-d(!C ccW+ !rC'T‚.&ňq>ZH;wkki]_/4T= 6D-JAxDq7C6 ZTх]L2XJjf<4'@ =㘻 ʄZYUhybL-~MV^)1V7H[Aw2 11hzC ? 4}}UL2EB1/V/? OѤ|*z PEHgՒEc}(5]5b㪚ޚY>@_TYk޼8~dHѰ y"}܋/WZbr)M_j 7ܠgM_H!)@,] ֖C"jK[޴4p4Z"qM0.>\r0h_E*7x A' a}??0h}]y ThE!I,-&3l߾]=B_゘  R=׃ @WPWc28?x,KŒ/E/W'}yy 5Ocԥ%6xjiCKuG9cɔHF gqI#@%S"p *%'cU)]|^lDU٠GDʋ H0g'^4"ݞh#.u, P@V,. u(ֱdJ$@#@uX$@Zǒ) 8a:@~9ui9}s_)ǏI {Rk9+?lR@]? P@m\9 P@]? P@m\9 P@]? P@m\9 P@]? P@m\9 P@]? P@m\9 P@]? P@m\9 P@]? P@m\9 P@]? DL@5Mߛo8?b @?GyDI^Jׯ?~ܭP'OÇK\rҧO9|[^E+_"M'v;eŊ2i$0a[N*j1b̙3G&N(͓ ҥ5.&/%`dp:"? k֭֬[[geeIzzl۶M87m$ǏWڹsgf̙ҨQ#Y`t=YHH@amvUЅ7ڿ\bb\h$%%I=5ҤA2|Ӎ 4@vڪ'NP-ʱcJ^VZ-ъ+*uSZ59p$@$QaPגbLsڵjw1233?Kٲeb;zh3hnniHBM b:ydٳg+ҼyshV$!!AGzvq!={閟ZM RDgϞj*UѣGrq1IIIqso׮xa씆HE k.VҥKK۶meժUkCѲlMb'uK$@$!a)SHǎպNXDzjSrԩ`!eˌ sNٲettH"M ڷo_INNVO"ah2p@ɑzHh֬!CȎ;2h AwEiHH.*x4sܹabrJ5ڦMB)55U0I'L$ѐ ]}mLbz^,jԨOyx  (%Yfsz +v " `P@8$@$k@$@A HH I$8F#  ($@$$ hH( @(Ac4 ;@$@A HH I$8F#  ($@$$ hH( @"#}yuDzę[5s'JN^lwQ9Ԣ~_ddZ!|7;;5N-)?xy$` u,Drط)2)$`P XRթ)2)gkgK~-pL D# h4L$` P[T3A$(Xk3 -P@mQ  @4Fc1$@ @E50$@H< ؂L D# h4L$` P[T3A$(Xk3 -P@mQ  @4nLXk̳-h𒦶ȋK_*; Po&A;o8t|F,3iZ"Ih$dc)RIr۷NJ_wڶZX5_r SdRҪp=5ROd$v9 @\; jaIŔ$ SdR +?I6(VE}\ SdRGz0iۦ* h#@c~IlCj`FH4j%  m!6}ɐѣGK./K$[n~Adz$N_jJ.zI; 4433S;9stM@ϗGP[rs&B$@IprIf͚nݺuSRRRxҺukYp[B'OÇK\rҧO9|[^ @ -ˬY#Gk׮w}WKVu֙1B̙#'NyIFF6nԤB @ $8B@r5+V;vСCmۤbŊJD]áwMv 8_ q<%zEUJbbbP3N_M 0@%~Lyez -[LEh& { 9pb!}2e@z-YjtQ~2Zo߮&UK);}OȳgΝ;W@`` 8O@{9y{7[׬YSjKU x.sq֭ojb袋.2EtRڰ`+\ &0ebŊV~ @ _~YM>kժ2]zj5\>q\uUjᅲvڹũR:tH`Ӹ;$@$)~ }n4= @[h!*@{%we˖8;uà:N$ [@2Dk8=eɒ%hak=!]wYFf̘aO:A( ZXt?h RMOOWaF$@v (Y߿)!Fxɓe„ j-'5 37njQ0ӧOW׮][3 HlBoE~njO=3gV˵[^X5jSHZTX| @8$O2E?,GU˙!P`A= ؕ@Iڵk/첄4$@$ (^6oPi1 @(T@W.YYY^FHBBeL!;% (&@cI"KY; @Fq1$@%@,ޝH P@u F?N$(Q\y: @d P@#˟w'b>bI l$Y [bFgٱP; U샒hG]x9KL$`@-dK ZM\!*y}nMPk82H(^G*^`)zީITم&"p@-oۜ~;:)!ZX#OH;0E&JqjIKI (UAJd/ȖjfݡrdRb2$`  5KEɅ<NI\zZ@$R,E$rА# Hb4Vk"9 h$@J5r 4y X%@՚eHBNrļ @jͲ\$@!'@ 9bހH V P@cfY. 1o@$(Z, @ P@C7 UXYH (!G * h,E$rА# Hb4Vk"9 h$@J5r 4y X%@՚eHBN‡1oba/_ٽag7JI@֞/ ^III4M  D@\|1IiIn}ci$*W?R4ԭy߈ h~~\}RR%:u[FO<)F9sȡCSN2i$)_[8^@$ ʽ"_/RQT;B9pD&{gqGsĉ2o<Ȑ.]Z4$@$`ao[N'SOO6m+ܹ9s4jH,X ݻwk @'O,~zSW-ZD{aI d-$@$iao>Rr˽m6XRjƣ @0D333\r^ʖ-%6l; ci! P@ =LnQl  % hժUeҥ^e>v오7mT.\h+V̴B$@& ϑ~*UOu5U$@$QP,Be;wt;tQX9 6kL !CdǎrA4hkN]N; D4O. ]Z3+X?g#]I<Dtiʕe5~h}bVײ&H$@a$Q=W9HJ]xbHHԕ$@$ hH\ z 5[K$7ZK9i5)В$`vcɔHF gqI#@%S"p *%:LHa(pH:PX2% :Y\ P@cɔHF gqI#@%S"p *%:LHa(pH:PX2% :Y\ P@cɔHF gqI#@%S"p *%:LHa(pH:PX2%7"_%w>(w<>*Y%!TAw|`\lz% K/)# P $  P@%p$@$A$@$/ H<P@=H%@Ñ  ^ (b8  @K _R G$@(@xI$@KHH/IH_PI1 xz% K/)# PMlb -tĈ2g8q̛7O222K.($@v"`S97m$ǏWڹsgj̙ҨQ#Y`tN ] tѢE$=z0%--M4h 7h! Hn۶M*VDNjN @D N@333đ'ez UB +;;3IH dl7 ޺'^zp>#N jժtRr;vLRRR1.:uT?6 @ x7B}s_J9t绅gZxA$@$`;ԩ`!eL.;w-[HL7ZHH l'͚5SB9dٱcʇs.Rygݹ ^aLd޽{rK2ef%JP@ ._%M6/B ƍo.L^z%뮻$G]Xa쓛,f,=7;L\x ~_͞=[z!3- 4G@QizSӻ^1cpWhxD믿^ 4( ?#~z&N7 ;~x_{[Fo6AgLyoY?m4O/^G)nMv-˗/w+wun\#^x\tEmǩ8 P@ϟRGjT. SN3;nvK.U< SX1eC4Oz m_}󖑑ڴiS`zD-[֦э?Z{-A7㛿iD4)BnZo}W˛ԩ#˗իW+%K0eIX{nݼ&7o.֭ a[_XjJ: Ktƌ#W/V?2c]+dȑ4̞={^z%?ZGN55x⧟~RWwz-¥gϞ^E{e]b+kS&ڸq4}!=Svw\fZ4}L7V}!kM451Mk86dM?Alkڵ+0fDT⹕Wªj#}~?/̙3}W`:XO:j:PM/0= p7&_t3&@ s6vbC3lX+40^ M$@&N"(h! P@$@$`(h! P@$@$`(h! P@$@$`(h! P@$@$`(h'N;S2?-y;J`*l3j(yD?Hׯ/upq'ӟ0*19wulYh$0x`Rai2au3v|;Ջ-܌m^<Çeԩ*?a\AP@WQ_bޯ_?UYp9nD!l7VQRRRg 5Va ͑؅wdGw[jNg84 Q} R%x""6Ƒ8G01y(Ϋ/ɓՆ>jGTO!Wrʲm6ݟ0f`ZG*-[V_b>@Ϫ !t999U}9r4z?a+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iP &IDATx xMgA"B JKEKڋ؋}&j.Fi:iP5jӱKALhZK22cCZ=r{<==y{}7BLToA@@^(~  PBЛ7oRQQQ Q5bŊ4u 4 DA@+0b~ khNPݸq#*U6mVЫWȑ#)11*WLTPP7  `4ڵk/fzz:eeeQFFZ9B;whH@U#FPr弒ˣ3fԩxh"jԨPݽށAW_}E,~Wsss)**z>ޫU U?gϞU{Qaa!mٲEsr К:l0jР+?z'<]\\ٳz )8Ћ~zZp!8?Wti13<""x%''w]Nw@"^~]:{9ђѣGEEG5j/ot/^X7ohh tP'NܹsG]AQiTzu:Ɠiɒ%cǎ 7o,cǎRRR?\tkFFFC=V^dWn]WqMʡC)&&ںukJKKan-P `beQY&ݾ}233%ą  Z |mLHH[ҹsg}-k@@@O hz80+Sv 5A@ `!( @@4p  ! AA@@Mk4X  jP5 \@ !BPPi@B  MhҤI^}}лwoW@x8?{`ӦMSN-[Fw+VСC4uTa{ҥhҮ]=Zq؃JSѢӞ0Ǐő1| ĕ+W ۲l[/_ .[oEÇӳ>K'1* Ea8>kT\9j߾=kNnժҥ )SFT_ׯEGG{q^8d d,TgΜc lK iΜ94n8эgn)ͣ-ZХKDpq7 D$|<hM-P #~$KJJ2q5KO䬬6y\.==9D@.|Zx]\A@M\e˖&M8%PTT$!c+ڿQB@@5hAOj:F A4"l8p `9qVnX  Fm"p `k֬VnX  FD DP':  а`D$ N$ub a! FD DP':  а`D$ N$ub a! FD DP':  а`D$ N$ub a!`{hB@tÇoM Tzuׯr&+|8ȑ#)11*WLTPPzo0^-['|BgϦ;wRn`Aj|_FFZ9B;w&F0@`*n:ڴiر5k&~ JKKg^^͘1ChNDEQF(''wn02$ #k k׮]xxrΜ9#r)sss)**z!>aÆ@&FDDPzDehԫW/[hժUٳg^։{G[nuKSz71i$+U@ՠxL瞣~f͚n| @dZb:tN>MSN;wҥKZ)רQCŋ)66VEM6%n͸>qT@)1VZQvD L24h Tߟ;^-9_+V۷nݺy‹ `& (D0m6kCϟ?/<'UZ[ܺ3g7Nt95nΛ7Zhcǎ%uplC@͍3F<),%5#GɭII+mذA # *~.֐$OJz? :T?8SE:PY$;edJII!2h#Nr^J*N*.etժU lumDtPޚӀĺNF[vm1ڼys Kx\CINrRqzWiԨQ1:dy&oPmgtOx~x':Wp%0b9#"6']@2$ԩ7/uެ/( hI ҅ Diӆׯ;V ߊbz癷cFmoE*=2- e2LMEi'yS-P=i#-ЉU)YC7ݐIǐ!`G -RI$'PF7|ѣp%!hIK-e*4M5MU # V#Z! !5MU # V#1P AT< 5Kٷoa vw\iK]xm"v@ ƕ9@TT=Y'8>Q3A@4A@c|bF2g5$؁2Bjv$  `P;" `!ؑ(@@P(! `G v C- ؁v"١Q zk? jzg'|ijܸ!._LWjժ~Zh׮][vm߯i:W#6lHњԓu!p'> nӦM"[hIذa4e2>όi .Lo߾4dȐm ^l߾%A\0"o4D` .P |@ !Cpp$yzΜ9w^e/n޼xe˖BPy4//f̘AYYYԩS']bONNu3Y܃!BгgS&6mJ3gTē#*Dy\!=zORR8gggC@*0@HlQQ=zTLvԨQCS\ fmٲEŻm8p@,$疮qSy-Ç`LJ)q H I$NWTI㏉.;tP"׮]^{ML_Kđe<sNzG۷=_=hF iڴiꫯ? 2UNͰM6Bݳ3O=:t6l ,r~R޺-\ިv<׿U0`r К@1?.bdf͚uV)P/]DO>0C=  lܸQw])/}R;^t/*^ Rqa <┡i/r!`j䖦ڼ3yhq֭;vk:<{<Onr=Pxpm <F-<g}e?eca+WX̙3έի}:GX|Y@o6XKPTJD,C`̘1bR2wݻwC xlBPK{B{UPus_BBb&<<F*:$u[ڱev8kmցz(I,V@yQzehZp.]P^{9|yZPhи@ڵk3y,^Fd@4!:PMRG  `aPV޿/jժحe,"[ xPxm 8s^+ ZEs^+ ZEs(v9\ى"yҀʧ.˾}Է *EXf ) ه>ui-U>=y'蕤Ng)/ f tVF816-gTFijCHpE  u@% j8"hC W  PT2 6\+@@P("6 pE  u@% j8;QDw+VXwO܁@ @@K X@-]4Ѕ7MU # V#Z! !5MU # V#Z! !IUk.ڸqcP|UO @͚5v la:thP=?va #` ;vիںܹCuԱnsБ4H|d͚5 m`,p $Rp @@@@#`͛7ͩ$I>C0acm{xի4rHJLLʕ+Sjj*xIq 8֮]锕E yMdΝ Q  `gwIӧOSjռG3fکS'|ѢEԨQ#ɡݻ{0-Lwԯ_̹߫E=zP%%%QÆ );;[M@1c[PժUٳg^C .ʼn'r劘8%,'NT޾}[ň#(&&&њ.>3J!]@(]4*=bh.\J  x+`xdaaW..^uM֭EX;;eɭIuK?۶mt %^l]cڠ$(hOtڱcG7oAرcw^=?)I;< ,ѣt94hqw=--#N@ł (22ի'Z}3<&  @ A@BE @@  !"E~  h@|?4H @@}QA$_ @  /P_TLG:ۗLd@E~g '?h#@?Pd @@cG A@ h@x  @@?  A@?2 1#G  4 < @  T$y?JzU9r$Mʕ+Sjj* 'S hzz:eeeQFFZ9B;w&F= F0E<1cN: 6-FQNNuH^H@kRTTCdRR5lؐ?\L=pj,jOgϞU{QQQ]vMC_A z1qY8/ݲe UXQܺu5܃fL-]4*tM7uԡ?Ok\L'5jԠ7zŋgߟg  5咽)ztys[H[n@@HЎ;/߼yرcw^JIIQp F0&'' :t(=zΝ;G ֭[SZZѼ>(L' Pdd$իWj֬IoߦL$80 M"1ںuh}<0 z80+Sv 5S@ 暷r^z0  Ij0?!m,Ϛ5Fs'?f}?3-[ʔ9Ñ_~]F ϋ2 Ncb* OJ@5'h3X8ڵM6dS6lM2Qv{1j_- `a0 o} I)? /RDǏӧOS˖-CꘪFAAM]p 1>-c^^VbT'=WtׯOƍ +Va )|D?_BHgϞ^oYf~z M^_ZjE6lݻwENy9M/.8z {%pڵ4gR }GBPmF?x[!/ӗlE_K?رc%'ɋ?ϋ.]H/7$ -ɋ|7HWMGO?,o߮|$OIg t n:qz' ;[M6px HO})/gΜI͛7WޯPh1_7'p5z(11L#& 6iᅭƍ>s ?co~EKv^t z<u!19ʆp 0 80K'}QNN=cFfGх ݄Xfs9P?wuYp=[ Tnĸ_-:M5&f+޵vZaGߺ9=O@pKefoЋzE'OG7iDMԀjK^Ab$^$ "q ƱGa$%|" !&  4 "0#5kֈcQO{Y<7" _=cy饗Ď.y;-X|ٳGXGzz:ݺu- nKܺlِ jΝ+pȐ!ncZ?clKuٔ{7(77$Yf \8ojѢ ddd#.J$p6{lG)DO'e#j'B! ʕPJ@%_|!Ȣ)ԩ#-J|DV[OiaE}zl%K! .K-Pgd? viiiʭYV۷w=>H[ŶW^Zjh7nۋ3@:pRJsQu7o_pARD:Ք _Nj?WAُY̤={'9zhacSPV8Yf⛻lرc(`8oŢ111^gJi.'ZNs닠nŊ/;;/^Lcǎ%7)::Z;~xW7@>7nXXAWgnˏE499?[ [SN_xZjW'&%%h9s pOR " %駟Ji|^$6$KJ3gΔ֩$)3ң>*GH5Lʕ+壢E䳨QgzHCq8:`R||8>e„ nʳSL*T M|r$ "㘒IĻr+S1bTTTayr_?O9.M ,.?~Hr Yl,"yYx8%Z*"+ 9ԡb;=^ '} ZjE؞UhEY  `{PW1  Vd/ @@m_( V ZE 'w!V})$IENDB`rstatix/tools/README--grouped-two-sample-t-test-1.png0000644000176200001440000005106615074310430021742 0ustar liggesusersPNG  IHDR@ \ iCCPICC Profile8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|UP`o@IDATxE䜃 **'("D̢`ġAAD ! HK^_ӳ;3;ٝ ~ 儎HHH@rՕU%   M; @pM Pb   H8Ya    @$@$@$@ GP59+L$@$@$@}HHH PJ&gIHH( $ @ 0     #@(᚜&  >@$@$@$p(%\$@$@$@HHHkrV;d_VN,%=Br~ @$ P$ME$6<j=a_k o'c$P(%Ts$ t7JXbMד D@jcr$@$C ?tc+IЃYop8yZ :T++W^x!`#ӧO .s9Grss}s7ʔ)S\O?TPAzڵ4lP W8H PJgmIr-Hj˭SN|rW]F-t/s=WKJ䢋.w}ƍ_VX!?2|yG?`z-Νg׮]`[رc孷ޒ+We֭裏={@ $o &/'xB &'N+;w+ qlQCɏ?(NOJ*Z:y >\08 hC B-AY 4pŁdZ3  $  @ 謲 @V/p /PW= 15nX_RLy睧2ŋSR8кYe \VC^vdgg˥^ꃣsZoI};NG?_8_vnw!l{{=y1m"o7j(o/@BJۙ@v䥗^huz%sZ7hCLF«Vr @]wUW]:p~ٵKKi栖V3]2fa<ွOZZO0h~B @Okʶ/}^QRXvM4њ9hu݃lٲRxq+E`HHYi;[233lt[B30K-հP Rh  :׬+{/ i~ݡ>DGLpLu'""R3gJnǏ%p !vvxa֫WL=+r@Oft}GZ(7|MW1<)c|ae˖i{iӦ "ӡ}0W_^6`:t_|ß'$(%bζ%ce {͘1CJ*%c̱ ֬Y~W^-!1f =zTZkjɒ%fl2h B x@Bc`Cfa8_ך0ڼy4m4jn=ݻܓ&M̙5a5{'tA'@sm#<۴i7n(>,ֈVӠ맧K@hkimfxu]ڷo'H.]kL0A^yWA??}䫭rCxǒ0 -Z3ǡCB|X̟ӧ_T^=;w$/^~eAߞ>}z >38qnAn0(-SgԨQrKϞ=믿O,Yr&?6lEIŊu}lYoڹs='h¹eEĉ2fywyuV+sD9]qu 8l!?tX͚5%%%E/ylyqyN yXdO~e˖~G(J=otEY MaS 4uիu.?DpT#G|ʎs9G&L ~^;hCEIq%} [lK&@0. @/_^=Q>Z^J?\s5+a0 >\k04FG$@$Px?Wn6[ SIPHDΌ۷{Tjɂ ~pc8 @HHHp-[& rWXs5ph9(瞫\~p0 U,H)=zo-m۶uӑHH l0G;\,CrK7nSY*W6 5(fϞg}'M C1ZjkmX0  ws13Mڵ˗RJpx yGt <@^t$`{.8{q#y@*~ѡ? PSk$@$@$@!@(" PSk$@$@$@!@(" 8n؏?(^xڀeu8L[Brʔ)_$+X̊:t,YJT!tn~~~Ȋ3 Ċ)SLf]dddAg 1&иqcIN>(ԩSRlYRqY3;H+g;v,`8?.;wl2KGB`Ȑ!8~F%X]6%;Jxa5k66mkk7mTn&Azd4D%뉥q=իW˿/w\rЪa xl\~ҪU+±uǬYreIZZGɿoٹsg f9b%/E"_U>Ày#gۣ>#y?+oAB74-bmڴJrO?zUvRJY3όZ5 '[6{FE~(h!NGO.ڨK.>Øw}E[hD\{ߋ \?۶m(,ظnܸqtR֭[ձtyB֭O|>S ;ciw$ޛ_~~k.9s+Jpxyakur HT }0a|駮sO$\.g$XI;w|^u_\$JtO/Rmw#R,D ߼P`6 AZ)Xx>rOlܸP_݆ g?lܹscǎߠq"^F:u,%>R,D P@)_)͚>kk׮W_:_hQxqCi\~|4/h7Ob)vQtۥG3~%q QQ/#7܊+dA v ^p`vhV𵩄X|wW_'Nz-PsZ )ZV{_a:K! g7pAߦPbJ Ç`ZF_r%u]zcV$/|ԕ&+2C} #' s+W_"M4 Oԭ[W'>>Qz]1KvN@%*6m [)lAHpUonΜ9O3Pw.Cc נbx7] z3FЏ1ISllH>4eM57ʄA ӼysP;(E%RF}zËBxCQ+ 7EIҩS'Yj2_ٳG̚;^6|A=[\Q'MT^=onTDY$C 3 ܙ܈x`oF%tx-(/0(x9<į Q_ҲeKm=,-?)͖wPv ]RZ XCUC,!af -f}_u7}T^]6l #H3>la%xNW #5`|D,YD0+ LϘ1C?\rƙՆd6YP;-<aZ}{?*jCaXqAC6  >EWiz !P/sCi, ]PWqo}U&0C`PB@ 0~!H?fI?ooLZ<-ԯLp_Ûj&fi?Cr02o%o3a;jر{RTR>:2%͢xąFcӡMއQ0 1{Wc^0eC~FvbfsTA+B780U>n 34kwOq @{>炷ӧ~[hR`g0pw? 9˄{YqYK=CЂbdZ)hH1 J>l`w9,9)X+(*@@>nNxO c|˗//qa Xt)P&ah}=30vjԨ!k֬ä|{ ㅉ|a נlX0X8 Q g; @EPޞ={(P_C:Or 7np/VceÇC9Z?Ã)Xq)]ǘ͉a=w?1[ pO'$t-vxcν裏j538ã迁ógowg?1pb(=CJ,9-~OӺN3 q~ ܝ-4.ЖcI8P`G0ȰP?͔v_oP;>pymˇs< ؚwٯ:7ӷ͹z@9ţ RqU5`B 7 b# !'69J[@ Z׌bsʸZPDHK* 5PBv4m2xjP•DԃPR=68W_pqe)RCih4먡f*\JH2f* 6Zוmiz i}Nhʸ_oVO:uΤm۶27Щ+^6g.Pl mЇ"BG8pرC???sm e `u8aJ<[X?q>vrE+6@BsGpGx7n RwJ5kK IK]ͼr/C kQv 1B+4 0F L3X- H>xq ?ȁI9ib4iXG/8j!|(սG I%=Oe/tjy %8|@M߱ʤV ?T84`JMm Rx\ qsBt>tcC-C~?@{dsz}|GӅoyp i_.X}μ^-[yk 6?HMAh9+;oa8?kbFEϊD %™y0 E`,[kDy/TBc6 OsfN 0&ş?~?`*ػrP!CP; \0FcXd 93e& z, jM :  5lqA&XyGyVJ{Jݽ&=pXZ q# !"s$ds1nvja3М=2vU+U 6#  p tm^YʔHd%m2RMB $m V7NR.4[re-’?IHH b)RX(){ƦҽUP2ܡb:ڠQ6 6[t }-aG]K.f< $2d[%^Ycbr/ڣJ0ծ];Q ,Qc(,9ٷX^ݩW#3HHH _I#PîF3fЂZ&cxKs9G֯_5j{0IHHH/ @酙\Եm֥lM>ݻ^z^<&  D}At`7 hΝ;˱cdѢEfкuK/uHH B༇ss515߿;V &/穧 ׬Y3ԩ1B/]t $:t>}8=B$@$@"`#7;$#?g^@xQRZyIJNpb*ak̙2x`i޼.9Ę={nUHW5j$Z 4iE\HH@֚!㣘6kUVkyL]vez1ĭ[JJJԪU˧5k֔Kʾ}0}. $CidRJ7Z U?yjNVb."^NuTR8@$@$@H 9dT혪g#yvbj0}   BJC$@$@$(՜ Pb   G(#hGdeH A |b$I6M;A@DoȮC'0" !'GҳLT&tGP KD ­R,=-Z+ M1+/EU*.'tv6L(/! ,O)MILed.Ծ\G-Q%`P Fa$@$@1#,ƽcƎOF3$@$@$@6'@ ' 8'OZȺGQwOe#;W咔V.f3̈HH S2ulf8bdT3RۅY) 53"8z&͏zf9?>QϫXZYOD=/f@$(%F; B`C2?z艶>%}{T9gȾJҮAċ@b)2;e҂-L3I<=m|v1s f53̈O47ҸfgVo>,>TgIJ0 KRSm}o8$IIIN++iYbkH=Fqt2fu`F$@$@$@$ @abd   'Zu  RFu@MNW-GS'V[u" 8vi^`h=tT)Y70T@pHH r޶/-_e_^/18%@8mHHH z[LEF )9t,dƨ  DHez$:=]E .#{EE:oHH$,}_ Zm H(f Ďf8e߬j߶(wrX"I$QȁI& ]^ğcX;%dZu03d/ 8{wvVvmbbըu$kX8 Z/T:-eTW$4})nfF$H3r!$au%$@(."pC+$)ksO% cH8fcI@RjiQ^EL ľ$pR MK P:u[n*ڐ @K̔{G.9soBVwڵңG)S(QB_?|=*#G H w޲~8djܪU+[dl޼Yxa\ըQC%۷oS;: $"g.-٧/4,u$''M+DuIRQχ $27kL1ի4j+1Ն*7Gц/_Gڴi5H Q T,.n{XzL&Qٳ$@"4zh- @t ٺu,ZȥIKKS_{ xd {{?~$@$@$@$@XaJ;fmٲE`ӲeKeժUU84o߾ڠ:55U D&M*xN$`^$.%>j2$d]v 肦Sп8SK.}an @d #eϓұY^#e *^`; oe@I)D("  RJHz|O)OL sm 6*6ؔtOò$$@$@$@ Xĸq0?ۜ ȧ~gΊ!$@$@$@$0]{1_t|) ؁@XY3V]=V3 %c/%,bD4SGVKޯDERG4m&FN"T:t<# HNUkMqCĶO @"2@Pvڒ"HHse߼a8. D@P(3m ƩCRH F(=5ޜy\U/D$^Y_7( I 1 $WrLō"H 8 @~IӚvU/n/rAby؇@rT> QR]sGX & RGvAzPs3   ;"vh%HHH (N&F$`;Zt75 LEAPQPg$@qA tSI.QG|d vNJ_jv"Q3 ;dcI E rW16}kK3E-Ty1 @d(2 PdbQI SFSH, X&@2*F$p'L<& [%   @4HHHlE%+䌪ZڮgIqh&eH@WcX&HX%lӳ$@$@$(%n۳$@$@$(%lӳ$@$@$h8* ~ ^Ay Ғ @P [Nq\)Mz  ؏5@A&eİWДfً\t"V6ȇV{e#+ӂi@L+KItiLb&$@$@#soQv)UT5kd„ ZnڴiҴiS7otz-#?W̹3%l-Lr;E-$f",! 1L"5k֔9su]aZs嗻š4i" 6Pra Q-U?Wr  SOi@߰a6Qٳ㲬,t6m2K$@$@$@ \s0wPO@?\|ŮZ{+HHHH@zZZ$'.O999.h̙.۷:/9eM&n?7eaAHHH( ĝTZ5YhJ2R`Z|޽]qq]$kduv{WnW=ZY=j <$@$@$`q'U^]233))).w;Σ}LB/7;wI~̄HHH@wtY;ڸq[N.q0{  p5kW~BرC $:t>}8:+A$@$@$PN?P4jH֭+ 4iW.ھIHH1hٲe~AbĥK}0#ߴxғHHH,(R(T*U*˖H:۾ ؉@\ @vYвRGGG$@$@$;qi3'   D$@([u&  '!KrZH&Ydiy 3c  @1(Y:V_ԟ$ ٧XR   (B HVJjٖ@|^ua%HH| PeBH)^KRK/uY^m_X 9ټY|   P>3^@{6rث,- @X(HΨ"I) %E8]?%bЋHH(ٽ)kKn{cRë)ϋI~̄HHhveHHHHHHI3ە"  BP8 "  p& @lW֊HHH  @A0HHH8 ޙZ{HI֏#   @\"D BdHHYw  HPYm  HdYw  HPYm  Hd3墋.J6emۤ!KoCc_RVwu-[R\F"XM\X6%k֬IiOs֬Y2o Vxa<~ׂ%yW%Zaߍ¥E۶mvbڴiچ^hj#'2}t(?]=<#>Y|9R16X.zBXhx}2Q/ZjF- N 믿Wk w u=`Se˖:L 0 zyߴiQD [oI:C}jbm 3=Ԛ7w㫅cV0Հi#:rV[2y8 t9,/#^ތ"7t~.Zȅ b &]L䬴᧌왋[l)V ?'_'j[ᩴ8 M:U mڴ~x߿q] @&6 =zavfǹF"`:rt#`􀙠±#}7`Wy@>c^8{?TގMo:ssQ S/n YKv t"7x(9@r_oX:SF(Dko38Ǿ`ܸqwy֭[km_ 60`A1J`;vNF9C螓9/}?2@W vOw 7ȁdkA5 syvwxf$mɣ x9+m+k[ay|,KO=&JEw=NŐ l9՚N (<~1]^s5>UV6Ar10ݩ=k 6:v@`I0v+QձcW^yEO-V_j #/u9n72p0Y*V[ 5n(I{wM#ݷ.]jz9K]`f/^PkY} i.?Of)aǘ0aOX<{p| Z\#A X'A-0e`M 5jd/] 4q ;?! .,PoCjΜ9~ˁ^gFm` N}i4taܸqZPvƃ>wq+1ePjJ5 :T-]q}7>ZY J3XS C P >Pn^_}zI'HN *\8GZPѸ袋[!KZt IYͮ1&Cj=J;VAh2Zb#O Z:Ќrj^ :_ FK&xC 5 Юu$nj_.he4iŒh}7~Z  $>Z^Jq5tz`15=JB5;3`}Q%2{#>,kwWwF,Ɨaq_vbZx0N/cI,GYav$rQCzm 콄Y6t Pˠ}A0=3"$%zSrteHHH,0TG$@$@$hݼ ?Q Prtr$@$@$@PG~$@$@$@&@ʑ #@ 8 G7/+G$@$@$ TG$Pd>,jJڗH:u$j2WyR2p@9.\({m ?vW{ɫ*jcL9묳{^k:+q̸%pU6eH &/ߘTTI&N(jgoQ;Va6mڤq/O&âJF'UTBɓ'e>q1 PrV{6$`{~/C u Z={hjq쫧6XjCWg%H^8fbiIڵk'/]eܹZ2e4m4nZLvUJ(!Vrc%+2HE!6l$@"@Qʐ `jԩ~9stMƍ'ǏוKJJ\"1 Pz\V"HQ(99Y7+Kf̘!J޽{c駟tQ5kxdӭ\R=*-[4,qE PrTs2$`oŊC^<|7zZ;A7n3Ps9G;V4i{>̰kai2h =־}{W\+q\y@$(՜ ؟?.-Zv@XB̨Q\k 0@'=ԭ[WOs'5iDN8!UVUVMM&=ı?QրH$C9# $[J:u<L_5L//J؊+?RtiW8'$@"u՜ 8@JJy+[)rVJ$@".^fiIHHH8V`tH ^ l߾]0 rV$@'@m IC`act   d6d HHH$@(L`N$@$@$`߆ @( IHHOې5   el}M IENDB`rstatix/tools/README-unnamed-chunk-8-1.png0000644000176200001440000010003215074310430017602 0ustar liggesusersPNG  IHDRǵ iCCPICC Profile8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|UP`o@IDATx]|TEBB =ޕ^ ]D@"(Վ `Q((*{'t{v6\+ݽ8{[f;3;!L#0vݵ0# `/#0v ;xn6#0,`FN``fF#),ٌ#w`;Ev<7`0#`ӎf3#F`vlF`X;0"N;0 ~FSXisF`#0v ;xn6#0,`FN``fF#),ٌ#w`;Ev<7`0#`ӎf3#F`vlF`X;0"N;0 ~FSXisF`#0v ;xn6#0,`FN``fF#),ٌ#w`;Ev<7`0#`ӎf3#F`vlF`X;0"N;0 ~FSXisF`#0v ;xn6#0,`FN``fF#),mvTToߎ+W ##윞`4 vX3g*W֭[B h߾=]56F0Ffoɏ9Ç믿Fxx86n܈W^z2 |aQ۲{nlݺ6l]G&MP|y_G06 ,KZjI1k֬lՓph޼9h@&F=Xd{}fzj(Q˗/ǭ[۸qcݻ#,l,uh"DDDH-[^zI͛7#%%ʕoF1Xdc/^W_Q< VZ%}ɒ%h֬._yĈw/^ݻcƌJ0Juƴi/"==SLӧA3]v!((H{5~Jhر8~8&LQF6m"\,~x.Ȑ!ݻ,;!!ݺu{m6k%,Bٲe a :kV kעCYȂ0[kNg϶m@3|ɓ'q%xxxdhw0m cbDm\Ν+ úJH;w.?xLF6x8ճMklDBf97{a`lrP".`4 Mtv !@FϣZja9aE`p"##_x-aG`$|`@wG?s+Fx<nN>44111c|}}2*#@e(>66'N@*U(je=z\1#yƯAⳗX01"F`|9pZ\MBsV ɚWz2l;r#cfB uo6!6!E| gh:ZD%I ft#1X1ykNyݰkn'#i[e]}`l ^Vug0]@ԹWoF&``T0G/')8 )h%O;pZ s#,Bւ'ʼn߾VUBR}N`Q`TG_wˎH5_Cxt"~{F6``'DHY3MwEdlfX k3@?cHh_=vFs=ve.RˬkKH ן}$Я s;L#mX?Cڵ([ހ;Q!&F6̌1cϺ`(bֈl_GZ%0zhqǞ~c„ Sʕ+?tOBBB0wܬ[?#U///ԯ_SLR޽=ߏfD Eѷo_:t(+?hբ%-=N0F@ɓ1d9]wt;wUVaȑӧ~w NoNN2b54O 6ٳgqEj ]t/bJ XMϟwK~URrIywޘ:u*N8!g4ر#BC˔)ŋKqB89jW8;:jbwrAPaÆ RCjUqeŊRꫯJ5իW *36 \T=D4&&1cp wŞ={3d+#***5+T!n cV)MGӷ~+0~~~}wߡXb *Xҝ 4w7oޜt4Eǧ6m_|cN]=۷gAn*=n!v'ނGlH%KdcE%ˆ \z5((;#H;VsI.oИ9sZʕ+.L=j(cDNIMC"y=}''',ZHzf߱cGodX~T e@!BTDShWͥH3h 8ax%}?}k6hٲ%Ȇpll`ƍXtI#iæTQl 4W4ǗN'TC-Zs(h_Ik%ܤ!IoODw}@~'ӆD'V KبK헌c$#[3mj𙚚*sΡ a@:~"x?RJ -xzj%^\fG@}L3@C9=}r%bOekTĎ[:]KD {;Yy=ZGuI>}Kw^[N_Ufb +ظRD5QjZ6 =h֯M6I,I.l2؏?O?ŋѫW/Xl.;3R'G3˞.x9MpW'Vyq "=[@;iO{r !@[L@aE@!O_n&[[9;A(]8No䁄 ,$0}Ei{B@!fD+6Б wW'|F|7A7/H(8Nt#`o($=M^;.!^ei߱PEePt@zx>rЎW͓_kfbsUZ:?­18:d{2ӥ+' oFө9DWorM8uu}X3:7 Ƹ뀠]Np#ʁ^kI&@; +Ž妊I w5AzyM=g]LF**]vMHtRT֜+reb xXI' 􄧂qi_7~ i6O8/p7#`(Ľ߸Fv1և m*Q|?/Wӯ!v,V-njQ#_sV߮]6ߏf͚e{=#``ϨP Z{O;w,ՓL5jKߌ# ``' }*?q{6] K8! |<]A V 14YBj3(?$$DӇAx {6fN' Z MC'40Ga)p8?L#(xSHt$7C5\0#0FW,e66_ݿqqq6}&˴L316Ћ^A}RYM4vvc^c`` ZVJKvzڹڮ];+qL+WD LV(HLLB\%#<lPS.`@W6Mdn$ܕ8w.n݋BL\"E(l?owOP%8J-;cv aXs7":'%"%50Ga3qsua=/O7} wo *11wF8q&& I;u~3҅̈́z)5u3ޏ \廱1="D٢^(/"~6( h|0u֊f4B-6>Iftr:L}758 Xn4IXpᤔ4eT]Y b-~-+8ZhE6;J,% K0x9yy)Q4,lLc62. SW?O%Ŧ~vpJZ:ReeW ~zӿFuiUG߭v nG2$f}UӇ031[ qo^E kr51g 4;QSמ+0~  5&i_x!,߭c*Y0,7}n2H, io_b#tm.e}!|IgW[>` tLh(Ϙ2{v\mLN4,lrg>M ̃ۊ A4%2x}K)z_Be "P3p'W<,,5pz$Huv4Nߡ*ARφ!-{ Ii[F-^.¢,Zy.[TDZ1kټt;_`>ŷ9s V6+\?#:,Trw0[OREW+H4kYl>~3$~DR w+O a |L8l_ ->$6~OhuՏ-oZ LmB Bҭ?9pІ9};c TnmVFDF``7oĉ̐yF3lf: 5b72#PX``Ş6l~w9Xwfv1-9v줞. [C{,==44y*|ӆ?D!CisbvCW"W`"%x2X@ !9sL,Y7o*_ѣG=z4|}}-[ݴxǰj*,Y2+?h&W=ݱ+'$kb2y[kM0 ^ۣjԨ!'Oʇ4/X@;{6O>%%sEJгgOTX3f ZEQ=BΎ(6B3$UӤ {3j!@!d7o???lڴIx1šTRضm{nƢsrʡL20`L G|n";qAsUD-hWt)<ęK綉 :t$4i-[f kJuO%boў7UKA II[b㗳8Nx-<2F#hSOeVZe]vͻD] c3Y(Q\b]qEJpdmj\9"@cRm׮]:.]ԛΎBҙ+Ae X2B쏠 4hӦMCBB6m www+V ƍ=oذaVf3Ũe ^VޞnV 00%'cl mMm \%/m"oӦ ֯_/~>>> ! * 7 yy%xؔ?O)TpF`p PuDj ꟁ":::u*"]zcc~5CtJXQx|8蓓ڵkHDDD cj$ҝ lQ\ZV+[ku2/8#`k =F*!Sb7RʭȬ"->[Բ&<]5{^LAFV?6`Uz9w`i״T I߾yu ך{uV|пܾ}[:@{M|מ`Pze ՋŨHV!lY?_,|@69s`ٲe\2BCC $h6p]C09(kOՀvtFJCj rUmٰfr&(_RB32# HlFQj̗DGD]!ܬw^P7-̽O;xW1Hj s, I;UAŞw)E#r&!IIoԜ18 };52MjdsϟUO>ߤ:hO-[V"ٹ&<, z:R@.Z Owa_MU ?P{%{9;w#GDxx dlmXOTMaȁ,涇x[m's\YNqC 7fٻwo~).\ $OV6lZQ11"oHPWJV/G *UߪBZ1aLŇT=p PҥA823jݱo>ЉtD"T1 B#*iaJF xw1׫Fu(zO6o=hFADWmlg")S[okVj֬C|PVApdډ#`w9ˣ8v~Łm7ճ3I|7>ʕ+ѢE ƺQ!J= ^GÇ,;88XIr-<|ׯ/-Z(Ə/ύPWvDBz<%x Xz$үb,\0|i7wAEa ĉ2E>'c/Ìe6%,tSGIh G!9%ͨeh'TC;vB<[Bڼk.WXQR 11J w%Zej(lg[3X$]+}Tl ".! tc@ԁM7o[bR sIII,ĵB2pCbPrAB^2tU޼"4پ;*)eSOSF@BP J!X DFLd0u^@keF]P0d޴iS 91^dm`AU@z)^^^ Q5+AM[We ԄJղoݺ%7Z nn<ٶfA Gݴ?f3_/<`‹ ۷2F`E@C k_ͭel[g44G>]{'UDE#=%]] QEsmE10GH#"qq\\Od8ibWiƃS+HONA{q(.Μ Gw7*~{Õ>((=s? Hd *HA\.ΚK+Qypr~dCF w;.n)1/BzbQN(?. A}D<3 _3!+0Cٽ+1'Šti Ϯ~QӏPS#QZt/SH xdNp)]E|&FȎ x/é͚;"6}] JK'cRݠr@JCb2+>Rn\D‘ҸѠ5<wg+<h %X`1N~ET>F}AI&U"N ed##IHA6!VxF!Bn༅e+vřS,"^H8I#z,!ll_Mim+6r8#PiP!(4ZIdg80uĪRur9D-d17eJj pbbOOVg՜8Փ?r񷀘+FBd$'"fb*P\3 zHdEynFV叏M<|7VPK2OnW,Eŗ£TIEN@)BĀxӾ#վ.#f 4h }a 7 c`8z@Om|@WSz-ݴ 1]9Kjc,TWM#T@ Gw5x6I&/YG{pa>B!6 ׎a?Y!4wŋjOAAPWJ;}oY/Tb2AUb%bn=%$*!HdIrX~mνyDGGʼn/J,ʕ+gf[,, ^IpSdJ}w {3)V7<ݴ*a/!#55 }GÊ l}=Ĥd =:ヒSNaݺu?1a„4ʹv %JaÆXzq,]4~Gy*X~}L2%۲466ÇGpp0-={իYѷo_/^m۶Iz]SH35Rw'BK00'eH~|wABC~0OA]!P!c̙Ѿ}{ udF űc q-4$ ^'Ob3f ^z%] UVaȑӧ|)|I曘3g|Nڵ3$ """2˗ѹsg5k Λ}7S/r$0,<"o\-&*W#Zwy>0 ϜrРO3K.L2Z9Sm6䭮]f*zJԩ+'Nĸq`Ŋ{{Uew)\ d HOn8q&BR"WA>g$X~shZ} Xe9PʘhBO=zɓoo` ;|T’ N...Y6iD4ѥK|YϷo?+;vzNW^#GOg;PT@R;p(MDd `[w[ȥE܁cPyj^,1S|8b0&4_O7r'SB .qݺuQBNUwڵѨQ#]˥G=g2C7_ F:ݻ7N r#.IIR-[W\ATTZj˒M6zϝ;HT [3 =:6̸A 8rjH_J;/se&m#ۇoT4߱c"p5](d>lx…?&nܸݻw<ٓ#Mc`! ___DFF)Zí[3"CxQ5FzS&aEwԱUS8 IDM``ߤۤ')M@dݓztrNTR -|~/fJ G9kr oڴ) D% jՒ?{LK~R f͚r[uhB~gፔA ]9L~;ϋWugBH\HgMYZea.KIuf7߀&Qw@^%ҡrF3&e` p6lȵ_͛71_Άp [ʕ+̅fT#FڱIn*"U*E/O~;˘.܊Z5C^YîEz\}@dV _䦧syTL?8r^.N.b1d:y9Г3MHC7{"r(],ba&dժUCHHH6cmǎNyPhٲU.\P,.hJ7J?D4sO>'O"ZMr򄓧)YUC%->%?Tu:]DE~/ v o֭[+OE*UJzəP,g1"Zn2T?I_~4Flڴ)TIUZR}'?! md<]Z}vUc^A a*L@h8x`OEk5 Rp Wj?tPÞTDLGW\)[NݐzCzt zLRwKo:Z.G"hCUJru:b8{;ܪ72c31(X $(&n%;"&&ev3Y]Z]]ĆgD;:bQP)\>g?Rdel "Z ^~B`^>RET5^0vȋv: J_ppeb)lCh*8UGjI=}(D~HX5M|,{hjƦ3C6{zzgv`mU8Sj<˕<ͮXMFí6ltsRp)QEDg8tr/^toJo"x[UOQc"_LBЌHIA}駟Ѩ7_:.~I t $iXʹ(ݭD<+qwv$\Gwa %F êT''ólizM^c+ih7/IOq;CAhw=\ d=XX{LCZR2N;wA )cLV/1'2#` ~~~r/x9w/SH d]XX*6oU2•Z(s6f2[,3# <#nX1#'bMQ䙝XXC̓>Ֆ)YxQG[Hm 徠ӹ(, [EAm jsPlY<\ZoD^9QQQ6>Y0@Ke'PF KUJ=ϟQ mᔵqㆌuc}A1)-K!E&`Ïs3#` fHOsqbBo"96^lnKT"U+"Fex,XW#t> )21p/׮ eZsFMgq±vG8F$$Ș{LHI}G{P>:L-1l.ĝ66}_CđblߐS ab%l= wլ4wǯUCO_Y9!qXt]Z 3kj˼?')?/݂ks>kF@Xm&gV{6jFnAgEnB>Z̙WaIވB5Bo| LciW# g,~4vL>cfE@?c* N~k.ly͋o 8b|]CQ!pPo B~ c˸i-*Rp9<Ka{%nDfT҅-I{ @{}bGg/Us2&mRM&#L$$ayAFjjYO );' &aLTz'">.NbDANt̐0;eRQo4%|@O k_X'O"|փlVk؏7 S3 obv'&w|enlx3S0;_0Rj'./SӱS2gig)$ ٻ1r?.NU =o+!* +tOc菔.֠҄~א}AsKDz򕽆 eT&@{ )K?{'/Hw1y;$fݿ6jT1C M#2! ]á Ad=XX{jݯzE䏿WĆF2H~zjdVE3aX \7oOF6: pz|),?Daz07{849)CyGZSf#)<º|#_qy|9|g~[!(6: hڗ5;GO+5dvYmQ/1sgd_~xg6sHd&#+Zc%pAYkpt7Fqv~u5k7A'bJ[>ZJVo?|K7-%a&+#"m$y}akL? K n{ؙy7 iٮO5k7l{CdP &s$(9DW_}=^~>dYXXok;1?gh弝y49pRP˫7p]R86ZAG̡—?,6YsSN~yp-V X ;pTE f: 'n"O3$)N]yN)Ur~䚂l'mkkzh6 >Z%Z0uQkD:ۤ)Ew Hety|HF|Xa}Il\Gli]VHADÇO̺gM&gǒD;qj0_|\]]f͚{-[jN (.^xOI]Szj… 3{ԩ>, L2Y?رcVzcO2 !(1BLǷcv ` e4d7'cڳk1kRo>k˗ǂ Aag,rt:˕+Ƚl7 DD'$Μ9ZSɒ% gG:jw(f:?_k?#!Y,_k3i@)X="BG6`O:Mڴi///\t ݺu{^Rd 4B'*THDD<!2Ҵ-&$go|Yrag-b,9;6iY^["߾};hOȶGҐ-RYl ikU@:Jn݊[͛7Ǟ={ڵKuyv'*9*Y|ц0|O"YiýQ~k ƶd3g*W֭[~oG/$$˗/^$ Z <رc}t ";Ho d o Aƍ?MiwIAl98:£x`AɬܳLPu1^AdhJwenשg{P8$p|Ë<믿7n"W45y߻ヒ'|yl4ʲַvBČz{);>115kҥKtF{!((H OO}UFmg7V.HqwJeKZ@Պ O!-ηrb`JΞFnEӑuEA+5^]?yK˴oѢ $}_w^ȿqjy+pÆ yo,r@M9鯿y+ߗ~4$ )- }TGxPX1-tm{{!]c~NbP/ӹ]m)| v)ߡuiPmܓp*+676O+=\fi»ܷIO9) |;&W?z)RW-* {|sTŖ-[ (4vXPzPf j*)eG‚hQ`n>ݻLLNmV0EW7zW1ԅ}Q"Mp.+6*< %J[neԼ~ý0'Ր7VX!U2Y[j%}iܹsːPkTGɼӆt:JP֠bfuPF6* S_kkO* &W_V4a0ahCײeˤ&u4KtЦQ] o.]Z[^zgm毫f @! fΜ;wJ#1̡cDv l Ҁg@Vj0;aSwg}U_^!!6ThkgeK:}Drn)? ͏=;}4V\)wo B?of HKh@}[ KHn/ H B&5̣_ZgGU0>1jaύ;8/,}]0eż|IPG )'#9o]R۔-# I+}!@*/]l* uSb h;A`3 MUtj*VM*,hY2 *6|Ԩ,W JQti-6TI7ql0`[Ȉ[[xЇ(2!9$$<](6yo[ :ڕv8P Kp"Z<7g+[\/)vvX<&'yU4:n^ Zu(MB@ڮ=Um3۶TQ#zM߹p{4@6o-:& P7)i3=K/.g$h-~^3碏CQ~[ A~d0٤2"v͠P^ U\\I0rC6|䱠ʝ]_Vk0{ -mHcR4S/iӦKf`ݗ?.bWno>A=Pg'9x00Ȼ`35xTyVቩ, b2Nf6M1:>d%}^]NuzrWM{Rv4߆Rˋo":!xGEj.4%3WZ/^\\'!$ 2D4$ ai I3EgI'_gH?TGg.3Dtˤ"蜡D#CDq,-խǔ[y8|6vw8onɼʔBPF?ZT+)WDI>f;&)*(䝠ґBD,]ə8нxQUUUvzhZdJj;uc~m%.ق2.']Fo3 /djP\wxS;p52;><g wg"LE(]b⌅z//G+5;ZXl*y壍Zk׮mҲѭ [R6#?fD2+}R;.#&&cj&YeV='M.y^}B8$EǂTF` ()l:.&j[C&z0Fe?&??lضgFdx`2tH NlF榳g*[9+)..Vb}AmfzhFiD灗,YjM``5荫Lu;+m-77ccc_-O4r'Nuұ-M,,ѡ3lbg#/ joLY^@FVxr-O Xnֵ;! $"k:b @^2FX@'1# 5P2F`,@❻|בt,BûB0+U4kSIjlb.^BhG0'\||U+WfOHNy/qra%g q"%po tg$p)j)4? !|WE^=Ps'!hk|nod2MMa!OqHQ2%ꀲ9ҝxRvm'o#4,Q2: UrwFiq~qj%ТFUŮt['ރv? 7VS@}—Q>IP."DK8()T<˔=wđc84D9*ϐ+b UĶѧtrsKGB`\u>.[P1l_ wl#1% Iⓚ0Sx@6?61goD( j!O@qjN0=kNw!A0KjS(M X/n^/`C81sٸ%SxЈ !$q( Mg}L(~Ќm0m 1ȐhMֿ︄;/8rdZb`{"|!K"q )"Md$ɹ'\JKrp-]Qeݗ/wӑ @LMxfe-6a{ב*t4+Ad'+T`[:vC)Q"2ލwFx~h ԯhzVsx15/ S|/!vHx\ʅGZ}iE@OE۵+VT?ñqr>3 TLvmȿs p=6}I>/}kM*Zrlߊ:D3 aBB,fIB-cMgB.ODد_ lHg10}?CuU*6oVsF*v7Ǫ23Koo=.܊i[$C zUHU aPۚ@ݣ sq H EK)WތwtLMxR>v,]I IkH{;va!$U,͙Hb^G)7*h J|Dkg13m2}UepC*6JO{GWUOKHѱ\L2M«3[t|h&Tl%KvCH%xZ1;W+QT2pUۅP%s?Q,ɋ!:ߙ5ś5;wxXDlO;,2r[©^ԼY^@֕H<'|3_O3pTT @K!mKLz 1'dqWI9ƮÐovݏIĢ-Bab1(DCL-|X> }T J'}Lnm6#MkR8\WSL7E5xp?BCW7^Q>_z4Q(=)u :CvLș=KXX͛W4Lm&z_TC\$n )FDl"-P8Φ-j*5 -[˗!Ckb%6)Ez̙3ѥK'+?vębØV{fذa -&!NI#;kVU4@.[&))Э5.&t_boNe++ X=cz׮]ѢE \v !!! f MD BD%~\nE%dkIA?qZ`?v\.b~nZ,J,3b M)IwϓI۝SCD:%[@򕆰,6*4e~Iz:j@:v͚5YBDDS"}gKM?W_}USLJQ'nQIe+"@B PN+W@YgDzkWNZ]9"/ %(5Vf K0BMP9S(C#)Cb{?FT [aB#ɣ*9rB*$8^b%@B=p`XZlۼ)k?~D6B#1:;V ވ4*§ Ut'f0 ?.=4[ב?:t <{M~СC2Uܹp9"» uF´֙ ;mH2FZh-Ep6d2-u|'U+)YD$m0):Ddd栧?_I*o"("κy*iOTD TRYߤק;wJ@5kbҤIW+;_ʼnNuHp󪕍N#WJC)UEJQ(n:!PBŬeu·V Uu)&?v'2э7SOK.Exx\!YMV3Dqn}9S[GqLdLZCT"|?'-_^~tG ùdYYn.*ḪNjɕST d͛7gC3ݻwg]c !1}ttEїSA*%\@uMv ]Jl]{G0uFLr?* hnuVTS-zJ1jP(6lMew$10x`  e?FjbFn)rpqgVfU1mmO&TdT/7T~93Wb*UO$t2Sm)z7AۇT&|-;6 ɏ#<\QTQՋDjO5_JB d}o G1ؠ,\ HuЊ¿@Iߥj+4Nb(S ժJɧ:ZiF. o)ш._L`tΜaJB c^k`]A}ՄjYP9{{"5ZqcMC523m4 3#Dbs;\=MZ[lsۻ*4'$@؄}#(Cӣ=G=4Nmiq[##3J̸B{ED6BR}U^w/T[u{3V>f\&8oNJzjٲi'K׿Ec| t7ZvO*29}^傩xeMѽt01w4% zIR:&У/SSRm.'{Μh&q|1')8w9<{NvE0oѺ?׾3ÐQBǰ $_ο]6,\$UXڠ1R~˖R^?'1lJy?? k_|Ec*,Q2/ y᫼ϙ4WW6T& .kZ&;~!|FQ їkY5M+|T*&.0u8M~ zӖ!I#x9:%&tФG|Qy-| E \~rCCIi=?u,+=D*ncr@Ci`벏'-EEo9-\ح&y{;[߲zeꉧo "-`N ҾR:aZ ھ\Ǵǝݦݲaً7\ʢ]\"}[5Z!ʱ knrܾ! iu@.m#%>MّRbv!`440 憀5ͭ_C0 h$ "vʶ3b9oeA9TQSZOͺLy)9m #Qmi?[ bTz7߻w~uܮUԘF m9!2eMC06 \0 C6z֯rwD@Gl9rt?t q|J al:!_'V/1*|V?aGid"P}4Hc iR bX"lաjyfzE 4| *R¤yƖuG]Y'I6ɪ',]ՑC&=P#%T''0Cb7  I 4,^B̉h*DȈq? > _Pv' D: e&OX >B>$نDPwp;I}.z1ͮK唩 @=/>X>^:`"/j&W}QȓG_V tUHAkTAoPy2_`!tdЉP_tfU'(*("lJ~5a ;~W`ytsgD́_a eߤr(_A}"UsV ہߡ>!CE n@ Pu*xC]ڐyBE< ɴ}f2dݿ].Z,>e %s 7miW('{u]<"w.D:`otgAZ!z-P+LhXKRy[WCEX吽|t(N\Ry<G0IL*cʁGM A}RGW@~N~*. vB% Y8yWMyɏO*}`_  xyr,\AڔΝCc×9QGji<{o0 ^Ad 4!Eˆ^G|^J2 =iVioF0rHuQgH1,J'HC&dҺC')n._C^OlC :-}4EJR9 dIΐƓ|zbTUJGKZu qiO:цШ, E'%rVٱ'k\RztG3a( Iظ8.|(\#qu14 uR!Uy<ٴs|@tQ?^U0Ix1 SC&!:iԊIfӫI#mqKQC3Y1ah5 CE=8 0J'o4\L0)hG BCA.V苆g76ӊ=O~BK_aAkNWmS3r+_]lL:U %U0UoIV.tD}7e%c0n,hՕ.|? FO6 4C:YLjJ}YKN1U&ց~X(_XDYPTBRQ^ CR2ٗCK;X! >Z > ᖴ)_ :pURѤG<-`81hpU6NN7TrܘcUCo+x#@'v!ӑAL>B>yL:_;>-+ǎ|'pXjX;c7~Yq1xk׮͚ ,p YOs"mV̚_~ٛ1cFSiYsNM6YO=w饗fرc?62)74lV|9Ѓl8pB/{~ϴa8E,k]^XPBoa@)`vZ!`.XJr֭iӦFz՘'2)7c&Չ-JMkǎ֭['K'~gƍqTCS{\YVq1Z_ KGZRT{/3̡:]v&,i!{noС }]wk۶ow{=zr)'qo6SN^nݼ#FxSd駟u$ӽ}M&N:I劋/JGɐ/_U'0ρ8M4^{Q10^.|/:޸q㼹sw<)'N'^^rk׮]wݕ)nTBz &dbj',5>c 0_~ /g͈;:ꫯ>۾}^xW_]'ZK,|͚5KnOFhޕ3tWzg}6~׷o_7H+FݣFiZj{)3)2`B)_6f j4h#(ڷo_.T{x۶m\~ DŶi߿kx]C> a%V;{TꪫB1/Њ7U108Nç[o;sӱ{]ww5hC NZ/ķeR6Y:!=>w'OQxϟ[ Չ{/$%xll lb>\4}ٳ hR 0#*3}=Ƨ~*Ç~(e>=ǐ<ƀk(B:;Mn @+k<l1oP2蛜8ϡ 2syɂ o&cF*i:} &Cnt7.6:h `c$%: +Ib7oq>`,Zi(ʫL+E,RZWߣ=>!fڰaeGJK'N>R&LFdYgJqpr/dd'&l#ɆL3!>Mbػx=yT`*@Ǐ./nJu8S'_G)++^z%5ŐP<x\C+S sp>dkQ@ud4&FMtY+sF1:L<ƣQ`͐:Ƹ`_t7MȘiӦiC@9V i#w9`R|H!< %L&$xT)j@٨8 0@ωc$J8:BL'3|>qTƵ#^(/ŽM shȽ dͲ.J}7BdSF%+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*i@B0w@IDATxEw#9JF  (J2Ä=E=1bNN?&8PQ QP J%mfnf'/;3=z_S]UfIH  @ P]*  `@@ RSa@ @@ JSN@@k@RN(N9F@ @H9;T@@@ RSa@ @@ JSN@@k@RN(N9F@ @H9;T@@\ΗS'\.Yrݳ_(P) F Xe}0R{$@fb v+B+dv)0ɶtEY6+ԯ__*ԭ[W5?s䭷 >V|ҥK)(o.R4iwѨQvr%',mڴ>ȻP*}ꞔv/\4h`>z% ,^_f׮]eǎf~0vm2vXiݺr!2|pٳgw=z| _|ԩSGN8y嗽c=&'O ҥKeʕg#<">l?d  ͘1/φ ?+,Ge„ w?,֭ˬߴi߶A g:'a/ t40?~hA$zgڵ~uɑEIaaY{=} 7 ۶m94huꩧʻ+f͒+O7ʴE#e ~ܐ낭عsi:uoޛ#^xA $\sw_HljEq~l}*V(]t{}Ϟ=yR\\,=iד?כ1rG RS={:eoPIZ;0Iե_~ruי"]ؤI2e7h~߶O.|zq4Y$ϊ+$//Oz>}˗K֗f7fRo3x`9E7iM:w=Z7msV2i D H2Oήgutꉵ!}J*ŋ4λM^|Es+M; GZԭ,m|oS&}.`y¡}hP^=SfPN/IF&NJfAQ&]rq4Yy%]vh:MmQ9ލx~@~A ފzgd̘1G[ޘnhNɤ'|]I}u4T!Z;A|*'P ?pٲe-M[te2kYQ`($mzL}4UtT&MZw ^33HO*Sc[@?͛W_c=VxӡS#oY_;SLOxbM](۶mk:o@;~kCI:}g_iO<ᷜ7P*uꜴ7`?CiӦ~h'MUVOO?vչqߓ{ѠSNE~1w\3Lo!%rvr-uԔk/K/0mIӖ~A֬Yw[0먁:v7?cGan>KHRW6=< tP ̇!ډW>~i!:Y?;<9sL81$ 8 ׾?W_}4-Joazm9yr+_2;K.N2Aҡ:2Jo i`пvرh̫Sc_gOo8^kv~Y%VO.Bs{T뭭bz HuWO:E>:]g8֑[G6r:]ۢuP?s!`r-HDJiNXڗdȐ!v[,h?@f(g(ֱ`I[4(50طY`Â2e|Xis%$ JEQ[: 5k,hg|7̼Hoym3ԞyzIj19_C [rO/ZqE}n[$H9 s&T5)[rP<;,@d J3E9p@Ŭ 9k}iՠ+k]_3pT $X8 Q֪Uل"!n r>  Qy"@&@3J}@@ PD"2  vF D HD@p(A@@Ȁ n r>  Q("@@m@n;@" E$" Mmg  @DDd@@ R@(@   6 Q "@&@3J}@@ PD"2  vF D HD@p(A@@Ȁ ntS dӦMnuq@EB\ٹsg,Gի'!e iH_|O֭DnkG}4dUnyI!7fqغu|ҷoߐG8eŊRbŐyX߿_*TЮjZs1G0+pZ੧2;tP9rdlG1s=7cM  Q("@@m@n;.a7#tX0GX.V@qqoX@6l .tna%.\(zGNNF9矽Zl)3f"O^oVr Vߗ{N233͗A۰0)-8v1BN;4OdW_L?VYfAdꛖЙG-~tѽfطo\ֹbŊ'N T^̝x}< n8%9-pᇋgnPС\X^.7S;J<g-[=Ť3n3l>V"*:{A{-yᲱGFenӷJׄ"/=ܓ।x$dwpFd"h>J@B QF(tHD@p(A@ 1*&9$ (Pٳ%==]̙Wl :rHiݺyԀ;2@(@@{+"'wqL:U&L ӦMիWK>}-e @RXFzRRe˖ɸqLԻwo~ʔ)Ү];1c7`  K _|!<e9sdggK~ڶm+mڴӧ{@(-@?.5 (ʕ+nݺ&]y7mȼ8`= @@1BZj%.Y^ڵk tݬ,c  PR>Ly'T0#JOKK I&}1_4?2duQߚfoݺU?I}=o@("R" >`Y|ߏi[o׽z2O=vZ]=<@(c-@Y+Ѥ):v(hw}WT"Bԭ[78p?  8K!_y3Kƍvn4ixXE^@@c-@%uv`;mڴ̛7Ol":*,ذ`c  @@ "@@H[`e]I  j@RB(%N3D@_ _ ^# @Ji  +@k@H 8T@|z ߂_ ??_>3?yrgG)}ZzogH^M>ߣn߾]>C_c38û^ݶdQ\pf_/jժ܄.ؼyS~sak͵^p|r!f͚A$uzp׾_Fޤ@ƍs0we9}(x'C?s3!9ﶢ?S⊔>TX$ իs4cSO=suO1cI'$V2'ho7yfEw Xǂ0(\wޮO<#V6mݻw,v@beffZs O?degg[_YoXݻwɛ~_4rʖ}Xw淿9[v]f0Gx?LLΝkz 'Ͳ~n˻̭/Fm~agYiUPP]"ҵ ݰ? n8 6|AaZ;HŊ֕/k͘1#lMzi͞=;lTX뵭n:u zd~ۼZz=^CZv}/<GFYzH nK u68PTbؼysLSj22moeРA~TiF-M6Yg%^xwUn~֭[]ykao-Xou],RB"l{o&^J@[-Z$W^y^]vh{tG4kVի֭[yW1ڶm]/b6Mzm h95N7O6ע.x饗u.G5-ړ/ 晙@M(6ȭZlW Lޯ}GoF:uxi_ WK;8vwՈ#SNc}m H!$}б$\zk[o٭pzkKo1hs{ gy-Vw_zܞ!Pk[~}֤4 rz:>蠃BL<|!ET@Q1%N& tt%I4zYZjh Aľe~|?4Ν;E;Dk [͒[}O)5Cn6_ZԖ)k=k[}~3i&ZNdddx߇{-뵭-'x[5m tM`ɒ%rmt7޽{@ri4O*12k㛴%GG\KzI?L|g{Ka:G믿.ZPu4N?SRRs:Z,ص}LGg8sL"tG\+Bh/ңkҥKݷnjJGj/ z&ڪC5OXZ$Jm2T@&}FͯL`[dzZ ?>hĉ/dC9Ռ* vS@C)Ե͵ݮ];-+۶m-F\awJW zm+1ӳ2au ݗ&}#w=.][uhs=gh'zKL_ۓ=]}WVm>Վ~K@}L,4s Lأ/T^w67eV=IZtG:ubz"͵~^\^略QGoik[h'Uʡj+97?ʩ[ͤ( Ku2 ^ۿ=e&}Y~{t赮״o>`w}f?h۝=/Yva ˾Ea٣pW_{6߾,Y2J&MXmﶺdV׽gN=wew| ڳgտ뢋.f-;V!,ҵڶ?@bҲ[-czžo|׾>aџXm&, i0[aBjfAe1@=wewZ(?%}dѥkR@zEo5$7i bOh]ݴj' !u/@:/؏_4n8)yߞ9:趺?{d7[_,6ew7Aƺ̵̓ס'E#]sDeXcx/E{{w@џXmc٭6xO{^ E ,%3zj{!!3fJM"WYfɨQbܘ׾4ڱs8z(M4hI:O{ uP[9{%kߏvr9X]zWGmY2}T;1óudM>k[o-s(+ӣJ b'mPQ`dZ} t*;̡#&aG8&LjLx܊#tHsʭP)zk|0 GwhRDTgT{3#w<E%su;گ|R +}F"Eйܘpq#H矙2"$GtAÄk7:_1M;^UtZRdEΝ<9<  @DDd@@ R@(@D`cߣg:3={*5iC=6# b"naǦ4G!\uUgN@|tN{&r.E!ĉs&¤ IPErő%K'ɮ{J8"r ,z+r" ZRA}7N)B@H@X  r)B  I(@@u@;T@" Eb= Nu ! @$HBG@ R!@$@I  : םR* xj$!#F`SN,^#5*gqvMH@ @ |d\5{IKK}ERRT/*Pn,ˊjgdBHIs弧IBٱ@˶|fⲔ"@|ҴiSiР 4Hvw.v-#G֭[Kڵem6Bko@P(x6O@G}2gYptpeʕgٲe2n82ekNf̘!}M@F gPFʯirxjx[_9xS>O>Y'*oܸ<++?sLΖ~O۶mM62}t2^  @ɔ4kUɒ3eݢ\&h oѢ!ܵkiyO͛Tn]Z7jH6m仈 D-pF3}䇵cZ׊z[2OȗO|ws=]kyEZ˗-ZfMk^  PR~ Rcݒy4i|ҹsgԩ 322$==Xz ٿY}vA@ Fra=7+9JÆ eǎGɑի-ҥXsm   LhݺuW_Frrh֭R\?/o@@ ^z%ٳSNqҲeKW^!Ν;דE֮]+ߧGe@@ Vb lٖX7% ."P ZG{rWKAAx㍆cǎ&>|۳e2dt2 ࠀN|8n2P hxeɒ%f^ v͛guQ^W^yEt^ 2߸qc),,4I  8> ^{@:ګI&ui`?:*LFB@r&;;_}THZwdT9Djm|߽;q%Yf+"@@_*'iUB3W$-s9V; +$R3nwJ_O۳ B@ Ή\  " L  ED.@pN&UA@s" Ha.:T'ndgˣa9K~ݴG6ȋ{ 1~ߺOy{܏8M-{_dv ! ?~)hDDY\>_{ i7Clji)RNXr H,ZE@JGmNy{ 68}XPPdC># }C*@ubG@ JSH@@ Vn*F~@[2p̢X#DH_}RD)cμ@If8r&|&Eq8@Qs qArLZ0GU^qeSSq@RW(u=5G@ e#%W}ܒ滥*+O+BO@'Ba'2 @ 0 90]`ߺv죷" ~L}_)VW!@ }z($Uێ}ieUDT6=MvUG=9fdnE6" P*GdT;^?13{1  @ ߞVX4GB-@ G Ps]t2ôTjQQ.@ XȋBBDH 81@[l~X/^,{˲j裏J>}&޼"ٛ_$uMkZ@C /9s UVfwI5jyhjɝ/3Ƀ  D.SL . #  QŧcǎeVbBmX D-uTzu޽QdiԨFB oR]q,ɒW̑ڸ#  1@dGAg!zklĉ&={СCMg+lsTVhժUrzv9 @Tt. ;#  21@>3FҥK RfD;(Qiugʯ*f͒ *ti:???oڏH[#ڎ;=/M+VH  @$ o6S2i y"]v)b|ҭ[7M4h [n$jOo@@40T_cϱ6nhncikP:~~z;w Jի t']V/_.=z,@@Q~9P[FL4IƏoza sh`.\x6Q^={4@gJ*UdȐ!h Z Hc֙{ e:>B5kꢐ_4yߤ@^y-Z!\O7@Q HoKr=ȏ?h:+kd}>"R.oӦME;ToٲŴ2n{!&mV{"D+A %b a~W$H @:-d7nL  @a&MH^^^  .<@~( $PbJ  `98 @?xgkτ_I rsx;IZz# $P25ʌe"Dcehv='Rޫ$b#'1HJ@s) WK@RN[`)wʩ0MOIKAIi%^6 ryV @zU(rxs$BcIrȁ,22kHFP+* @2'ҖOIgIO8q8F@C<9& ʕ#.8T2ݥ7y}(9$PbJ@ $@Aη-̎G9rj_wX@9r dذa'e]P;ì0aiҼ}%K8 *&O@I>=) @" 8-ZH $6l0?%q-[&ƍ3?{6L"ڵ3fH߾}KnȮG랒 9b\Lt`l$&M$7ŋK˖-pfΜiZ}]׶m[iӦL>ݻ  @io~!˻rJ[n@FɦMϗ-[xܹ  @(p277Wj׮PZj@ ,O<ћsAf  ` 8ERȐ;s:^[||B{'v%s?߮ʑ 9$; W  ٳNPNNT^o%馛f͚U%EH  . 4h`y|[Oѯ]%K~x#zb*<{,{#CkTNS3A@W > uCqܹңGSֵk;-{^IzרeW O M՞;vhÇ˚5k(!CHndQL  @8 deeI-̜ABT@([` ZΦM9~tTXaA7d!  @@ʧ"@@H[`e]I  jƵ+JfT@ uX*!! s9g͑@@ ADP @pN9k  "@9n(FIZF7TE@.@܅(޿[   p ys ,@ P97J%fWTpJٳ&WԅJ  5:Ivޥ:6K˪X4 e*-2dg  @p(# ʔ3wV[{x+zP @@]XZ .Vl @Λ5p^)VNq#ˬz#   9ʣ#:鱊BǎH8 tv" @y   @[G@'  P@}8> 8.@89D@`>?&*6dF@PI'@V|@ 9R" @ !&B@ JD)@@ ]! @r%y  P@eɮ@@ 9 8%?Fu뮻oV6"qˋ4Ns%I}?$SNO?TƏT.Ž3u]wWJu܃>tILif#V֡C)>?r+Ci|mΝ>R믗N;M8㌄.k"_\ܹs")2wqaZja5ao6aO=cF&yT&M$SڸqTT)~X[SN]w.Ja#m#Q/}L(g5 O}! @WPׄ\>O9c|VY CV+HOOvڥ\KSoVׯ/͚5+lSF  hs%JFq@@v1Aim!ڵkeϞ=eS'a3o!oXk 2yRjU9ȇPeW+7j4H܊ W=za$:=/6s}AdF~pIϩտnN=ޚ ڶm+gu'|Ҹ֬YݭR/9p;<2d_f͚%K.5̙#'|rʷiSO=U~m 5-oaxըQÜxVFiN0AgdetR?M裏Lod>#rW<_1(3s&{cmy7姟~2}9sE_K4p@P f/"߽ov;cǎ{Owߕoћ/i^)EMZJQAݡײgyloϹt[[_u@ϟofիի[v e7o_fUrep[Λ?Ѳo}ll ysXĵXgxǎc-:s,߲[\ldRoԩc3*UL2vؒYqƙu|ID^Hq#e裏yp曠yR%[n,Iղgh p6le61a4 &nKORv  g*n+|5ȰA `Isn)T ]{>w\? bio'ײG+ 4}kZd'{R-8i+VHϞ=CEi5}w!Š+>"w1֞:kF\r%fȵ.W+4pbUJ/yL^BD׋ ]xl2ؙC9$hibs '*N~^zo/v:K=@ðʤ{TY/מ>pAn73>5e]&:6e:')~ڹu&*mٲ%Ԫ]NSzA6/rڴi۾}fsbFE vd-:SC}KefU,֭ux\۲$2;<:]TY=XG}Ԭ{%;pvƌc.kƲ[6,rɓ/@(S Jh6H,_Dkڣ(e_4ëu"hՖҡgf=;ej3Z}Aca\ڣ:Λ7Ϻ{,몫~fsKͭjIĵg[Y3%N`[gy[Б#GZH>3d'm6oTxaڷoo6ݞ >/A3x`4i j>;}$k Ά( nV4<4o( GWA9km9:,m)Jd2Pe7Ɇ=L'S/r;bEHT[n:wlFͷDP 乱oߚHσjk7qθNth1-zMjPco}~k\[<Ct1`O4ecp׆~)- vK%,ro ]it2iݤIB:P]cNJK;==k,qN:*8`ю:7>{3J,X>%̕`O*˰פ־,M6uPI~ӖTN!G@[  @ %   Pfl I.@'# @@ $P@  n  @I~)> .@[ @I_nfK$D6ITb?_>^iԨQrmرc~ޞr!b?HtZO&'/#2W%j,0l0,ԩSGƏ/S?0g[ǜ-b}{g?S~Q=@]@:&/ Co]6nhh+sN3s'^u]gZta4y=@ \"z.]ȓO>)7t̚5Kի''OTw G7۷TTI/^O4yy r2$I3Ϙ? 4{W鱤&Md_\һ<<̼@W tR_VZ͛W_c=VxӡSKL]2i͛{GǛ * WN*@r ߿_."EG]r%2m4iٲ,\TjժR2駟*l2ٻwwoN:yEǛ * WN*@r TXQ*T`:=ϛ7Ovm5kHM8sKoi_]&NPq (+V9vWK޽M's4y+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iP %IDATxE] {,,( G(p*,$P;AQ;9A$x%.%ǥ~ ==3<]]W~+JM :  @@q#@ !C4 @@Ch  = !p޽{CDh  G h?B@%!2@44$l DP$p}ѣ8p @M4={ұcn߾vJ 6ݻk8= z(!d?zꩧڵkԭ[7b|'tj֬)RDlll,5mڔvm/ mٲ+wO{ >C?4矧3f+B&MCi߾}t-:t(uЁƏO&L9rvqoJC;G{B@ n',Z>Lb,X@{;w狞'|BN/E)PWծ][-g2e7nݺTreJHH{MF:uUq_7p_ȽKҼyhȐ!t z*]t|M1f7x`|xһ+Gky9iapUl]޼yrFGvoݺƎK|޿+Wq_7p_X^=?1={vJJJB Q^(&&FLfΝ[־} Fxק@i\[g~Zd [;wj֬I'Nu"QpܛZiDF 5.ON#G\8Κ5qr(Ov1fΜIϟ~G+ "2%-[6#C%>^x5mڔx!  t1JNNƍ~8 *]v\r7x}޽Իwow曂EՅP8P̰?xl~b?( P~5sɒ%k.r˖-b|:u2ќ9sׅRJdO$U>įm<ʳeʔcɳrg}x8pO\rp  `U>[ B q@@@&m !@@{@B$`,|eE4h[1xT4z#ԌF A%ΦM"CIff8^;v5tP#i#/0@ժUifn6k׮aÆR)ؑ)D@bSSSM+&LCANjD&;#x Dpxn"NJU ZP6=* UЬD|Qqf һQq'HKKoUTcđ@`Ԯ];rrwxww Y h!*X@޼yV-_8ueJII gӂF `<mݺ>BI.\H;wB G#|@ .P} @@Cg .'u N:;p9oT@ t!& @@]~ 1A\N4tv  rP>@ CL5&3 ch$IEEEozzyfcRbbayft-Zt),XېҥKSrrrDj߾=ըQ#yh%i&ڽ{7Wr/<|3!p)RDO `<Zo6:\ىœݽ{yRR$@ P@f֭t}|W,AjflQ&:ڿY#UZd.-رcu….%ju @@-6ta+{UT7R ,VR@ YӨQhΝtMR,P+yM͕L&gDh מq\L_yA hnhʔ)/_>^:=^=Gm۶ :kצΫltvȐ!@ :ŋ@&z5Zz5͝;n(ҥKԢE *Y$M>z!?~T}UHvСb 6m̙^uѳݵkzpFcPQ{N>M]N o:k,!{!`ԬY3EW\I[5{Ϗ 6y\5kɓU/ziii"]7{mڴQ*UD˗/Wp foA<1L |~ʕ+kl46R&_,T:Nʑ,Xi^H@TA -c7(QZ+WPVhbbS[N=Wxa=v^< F=bX"M8xQ&M|UjٲkR mq|^8S mW_}~gQr[>b9^ ծ];:y$mذA}mڴ)=_oܸ|1JNNwy78mN?~W|苉PV%[@Y>#cʤ (O*Ul":,da۷o%,ϲsOיp8Pț7/-LvE oX~=-s8-g=M_VN^kE>L\0a( (9s户؀3g[HXnɘT*q1޳gOK{zĽY6^CZ˚0'C6l nҥ:Fɏ#;+SNh{`2klx!6 :vHG4b1^{V|]jhپbE^A:Ӳ/*{СCϟ=xu#V|݀^%?.]#u.Hr\ڿ ̘17y(r~-+Vԯ_?? O>~lP'C}߇'NƯ*=78ըQ>s?U^ii U*lwMFL 2c&=#bef޵kWޅּ .Y/<{Ϲ:wp_ʓ57nj%ϝ;g$ W}x'Vt$7S-FS7Bx/`)=e3=v*SP=P%/te LjoFjD#4N끆}buYm;O-{ܫS:WC:JP=P< |0Ç1n!XL 8l(Á?^q* _d4 #lh_g&5  E&5  E&5  E& _fQ*'`l nuUs[l-\bJ%~8:-mUEҺuL)sNx ?{ BH$XAF YH0df@!@HjVCA,Ajf@!@HjVCA,Ajf@!@HjVCA,Ajf@!@HjVCA,Ajf@!@HjVCA,Ajf@!@HjVCA,Ajf@!@HjVCA,Ajf@!@H@j(s+T|,  \G`᮫3*x W  P42 pE . uA# ! W  P42 XƤ$I:B7'+!Ԣ2 h&7رc)::OÆ E:wlx\gBAy꫔/_>{ 9hDaÆQRto@@|(o0pd P%j `0s@@Ӗ  Gv !uN[& 0U@ݻVٌp2,.&駟޽{5iȐ!@ :ŋ@$`޹sC+VЬСCi4m4Zl=z7on;' iǎԽ{wJMMbŊ5ž={hҤIB@5k&ϝ;TB+W֭[ŁA̙3+;wx:YrImڴQ%&&RJh@@l@}*^xzѣGdɒ0XY!Gm۶ P)⋾8I`ҤI[\2<"}:c"X ~`?A^*ɓtR~T?ބUVQ֭M]poDSY.ߐ6QFOM˗/ߠ 8ydS7'9jB:tJ.sR3g8@rObbbX?#cyRB( hRRr*LIICT^x5QG*\W΅ ΝWN#y̴}FN:EM4EpLx/JXܸq^{5JHH^z%M+'I$ZZx"ܹsGD~ĉϫۧOѓL ,ЌO0CQljB ˗r" Z|Z%~$pjժ߿V\I=1,o<XΞ=|WP_9c,Y8H!-[qϵkR#e҇M6ҞomXBQ ny'7իՙy `~jj׮QY[" cd'x܈=x,`D_~gv*f  xI&X~m@hf6ky ޿/wN]jz-]T*R$OIԻwojeb2/JV/ Ɣ}ie|$p  u XÆ IϏ<&ALg\5&"[Htvp~\ʑ#dy G 6'1P7  `y3 @@mހ(>y G 6'y 9ŋ1X#T$)h@ @@@2%X7|#E_g}VfY֍7Rƍ}6˶x;cű1^zI˶m۔_~:1tPwWԽmoۚ!Ք-gBU6?6xVҧNJ:tPýfPL"Ypq?㏋>ؐ˴iӄ53^G-Dw'e#N C+- $dkUjJES+WN{uyG~H C/VD@p^聺Ӗg /ҥz*; jݺu3~M^;v,qM+VfϞM?n:jԨs7&lPu7o_tIRDjb7o$O?֬͜9ڶmK&L㟜{'lr|UOk׮-m;vLI.&=\v:^7o^=x7HƊS|8>>^p-~WyhĈoΝ[l(IlN=`+\F aݳl_q~;X}DzĖʿlZr /вe˄eu!511Q@C̙3XIENDB`rstatix/tools/README-pairwise-comparisons-1.png0000644000176200001440000003164315074710631021100 0ustar liggesusersPNG  IHDRP +iCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iP / IDATx_rK%H(Q$ &"\`@I^@EA$IP$H( Arwݙ]fzfO=tWWWU oW3:  TH;x &@@$@i$@M#8F$@P>$@$F4m$@$J#>$@J xbI>,Yďɓ'R\9ɗ/kN>r%K#{(Ip\xQ'0@|t&D|3M|Ï.tQSNI׮]A0`̘1CƎ+f͒]7nlַywy׋$vΝ^f*xxd?%{kIL$cƌ2yd)X_yb$o޼RZd ֭[u?N3C _Eʕe̘1:_ț?+Oe˖$ׯ#GʰaäQFRn]_~s& Op,SLoF*Tb0~a+ܽ+ǏyicǎI{Z|σ>(v{91kvzz;wSg DjժIG"{/IN,X 3g͛[/_^fϞmEuֲm6ۃf!]tb~O]erȡ{Y ҭE3=|ݐ|tMo.7|$L2ft Z7n]hVTI/.z B'1 y u:t)R$I;vCzɡCd…0:4k&$nV>|pAWQ_C]3<#-Z|t"jՒW^yEƏo{ݻń} ]vuiтˈ#Ztp\@+e˖GyDlْ$x0qP>+()t$K`>2m4ݻu/gΜA" *$1&֬YO?C9zyIx ɒ%K(s)wz8<թSG;v~mƍ, (e>S@X98/d>-_ryLJ@dieVi%pAszV\3hڴʕKaŅR6l`ȑ#&L'g %ȷcq:bDKs gͺՉ_fۂ@Z0l. (M飏>ҭP̮íXBO,9s`N JB#X_ &`Gz\`l3p<*U AH ̜9S?$L~D =ڴiJ!CM6ɸqdLar /a.p]#NU*f1i$cΝ:\I-Zʗjj?].я"B@ #_ܪetjhР< 5oի$֝ CX a}̎;?#XOnvI۶m:Ybbd:Hy@㫾|s`*IZXvwkb{,谡vk-} wioVǫ1W_Ju>T+j:© BBӔ0oIl1ފMװYncƌG} ~&v/k_.{ۿ[a`{ Na3_fv {2K2qDQ6Z6kLݻW(`_-l!L7uT,pik=ؤQF:~i|ᇵ WqYPv+Xn-[ѻSO17LK^o7ǘ'zwMB-c jLROҥKuw;4HvzߩS'iժ,Xŵݢ ݺwMɱK/8k\hҤ`|cׁ{cHnbu +SNYz~iBFk}u_D0b+^{ 6m>Z@M|uu8a {޺ 'ضm]+jt!|ZǪ?eʔ2&+Z.cJ&*"cde`sرc;hbvc%X й@LW1SM#Mcku E{ %ʕ+uIx wM=j(&{oǵѣG},]d eo72Q>ܿG4e4{ܽ{6)k:i׮ bV~qC&^q,Y7|9dH 5"j㊇(1\jlO9dH ?,%$ h2Z YB F,%p? h ױ21k$Oo^a/9 h 6^E#x!ȏ?/ K>)aHHHZgIBH(^uH ,(aHHHZgIBH(^uH ,(aHHHZgIBH(^uH ,(aHHHZgIBH+a.]C 4"x,\PJ(!;v\r%KbղvZ VZ䯿{O^~eWΟ?/͓+WJ*U䮻˥KD $ G (roF޽bŊԩqQ<8qׯQlY#o޼F۶mC;ɚ51tPKۻw?~7za/^\ۗ, %F٨Py|ѤIC=Ǔ\ODž ʕ+g'4- 3J*Yy1)S&Zjf~>}g"FH6đT|WQF cΜ9_|aTXѸ[}BFϞ=x.XXt (Wn<Ξ=k,XPxY7pZIOy-PmQ|yɓ:!%1cFcɒ%IV>.P@#\sտPVR2e۾}_3gδlٲE(W%޾ywe9sȐ!6lؠ[&LumnZP_{5ܹsvX~^x:n5VR{.cI$퓝;w~YǪ[US2g, nZ)2{lˏ)۷qV[ϟ/jղ|6nܨg͚%,/zSNYq_]o| "]jU@@A5 EOeŰ LԤ|`O(={y٥k׮2GyD%nB0}Ԅ>|X&NtaVݺ#1تϔ̰̰&DM@!"t ŋ')?A%mL6Gwx&~X ~)9t$ C(vv5k!K޴iSQC: H?#)Wl޼ٌ馛t[nz]n 6  NN޽[%٠AC#jw}ș3Ħ{~~'BD̵'Ld|r}j}zBõ 03Rez^ufl(a5Ddo5>ڨQMjZa: j8 /MeLU0ϖ-pc.Z Z;O,? ӰaC tjȑGFe@E5dԮ][ZGQgwf 5`{_9rQ@_/  h+R8FKӆ?z;oUo -B;A`ާG17|ㇽq::00@JU\rpSoz!a8 SoѤ)N]bj!P/o.^mڴIN:mU:.rjW'iQ@GI lٲ')L>]ިcQDI@ZdREySuvB6VwruY8g gB$BPV*D$  3 P@]X, 38 gB^rhg$AnݺLQ|HH M#8FL K,RpXbv)O"LEDTbP+Wl]wP,# p uU 8EiC$:PU) D$ S P@]W, S(Nf:$@#@u]@$@N:E uU 8EiC$:|uUȆ J*0 C.]:G=z&Fc߿ppGٳgK"EL/Ǿ+&?SDӃpfʔ)iE믿޽{Av#'O)YΝ;bi$1492(K.ɾ}[n뮻.iJX!Έ#"]}Dž ./UzA2dYFN>-f$oJƍS~@P;w޽{ {o[nOeHvQ,YElٲ8ց4 x@Mϟ/}^r @B6cBw-J*%/ ,.SLH%r1` W^-Soɞ=_mڴ̌_yB$IAI̙ӟ@b˗BI3g+W$?Ti @ 0/.3gtUΞ=+xbs: "*5#]vIƌx!Ф زehG}T'-[ @t }ܹs2`$ .T@_}Uyw{n:s ڵk2dyxOEsЏH@$(@ &&MߥJ ?O^VXAWIu֒%KXf*͚5 @ ,XɓmV\Y/_x)˗/x߷zCx?NhG eʔ1cyɘ}p411Qe&3gLBK-ZH/)blH1Iaijd޼y~ rɓvǸq[nկ̾k;9Ig@ch =#z2CVҸqt@ҴiY`|I&z?Ppނ\RVDŽ LyƎN{0Yvgfr @lY@QzKwlu!h)N>]ΧT\^/݊^ZF -'N~z9r̘1C5j`+ܹs9`^#p@]>H^xٸq?ڜ paQF)7m5g,Xj޼] o9aqNXXx@$eP3K|R :L<(YرC ,D߄%c hHQ@a߉gc0՝:uJ|I=Э[7}[7.!!!޽[Əoxu 4gy&<-Z4dL;l7=o>;b~{W^yD 8E E-^5pcǎm۶!W .,/N$Cq%J+;Kr#@uuRڰaԭ[W/H1PP3! FY P@C̈́HFeyH#@u 5"p j!p߅w 5#0d=zݥak8޷o+(#8 h3;YfVZ]߼y$!!AU|Pp[_"L:ϟ_ꫨu׮][N{p =uɒ 8L0p&G$P%KB$0  {P@S, (gr$@!@uO]$$@: ɑ =uɒ 8L0p&G$P%KB$0  {P@S, (gr'7o^ə3g3=.gU R{ Ó-@mГHg$@$`Kj$@$48#  [P[,$ (1 -+9r„ W<::rN7ߔ?ءT$Ӷm[yxH  h$|RdIɘ9\aH2eb"stw)ʕL\D9Esh˖-Ey)g˒!CH@8ʇHHFpH(|HH (iHHgHH z%9|YY  " (eZj%=X.'Ok[|Iv=d  (;wNq3gm  3f̐cʬYƍ [I$%ү^Z:w,k&Iׯ_/#GڨQ#}>+ܹsYfI D-q7z֬Y_U , $sҼysR |2{lˏ$@$m@_|E)TPޱc,XPo"Eȁ|… ~c @ 8.)'z QKHHH"+WzYAӧ\ktYi?BnY+`BvB 4yjECS&HH@ h…ežyGܹscu}Z~ y@$@&s(؉D1YnHH6~A7;pDŽ @p1' 6/]TׯK{nٴi 80x"TRY4B- @f]҈RJZ8#v풃J=VZҾ}4HH bN@Qɓ'KLtҺwEf_ŌH Rڅ_bmJ(!'f̚lo' 8H 0# X%]X| / /  @*P@SAIHԗIH (Š$@$KK$@$ TbP %v_-v6">#44Nz2 GP@TtvAB26޽ 2DB[Б L28̮4Y3= p)H B$@v(vTG$@!AHHԎ HH  1 Q @$! ;P;*# P@C $@$`GjG~$@$ hHP@ЏHB @    @(!@b #@~ ҴiSILL0 $@vX|1fH 9l&G$@$4 ^& P@#C B/ @r(ɑ? !@ IH 9ПH$@$W! ,'W^ @/2dH6|:%:FWѣ_~>}7/]$gϞ,YHƌSuid͚5yqSppȑ5:xdΜ9J@-e^X|ԩSGO.w}w v\xq]L:5v39۷ >\\& Z T ZD  F+c%vcO<)6m uIΜ9lٲዔ1ɞ={d߾}RF РzYP p`>DSS&1c K|rx#(QkJǎuL2+.*TH?]~w)RY!7o,-ZܹsK٥Zj2o޼qEF&ax=H͚5eѢE/O@:t`?[/L6>zS~7=9p(QDRx5a bJ*}.\X/87kH ;&M6m۶ܹsJ*̎ci + A8pCK7Opƛ~f}"MCRwq\pԪU+IL(TEÆ [s(&g7;1e:<ϷfM~Sk;e޽tR\SID:(T.a xСx[c~ ڷoogZǎ̼y]}H-[o-hbkF&M$7pxbWs 0ӧngR7w?r^K5p%*sWS>}Z|̂Y7NZh!Dk~삪Zzjժotݻ(aÕE9rHv4]BBny;2ek??eyzY-{_}U3j ґ[|7|^7Xt krߛ7o֭J* V*jakiNd֬YZ\:vHPnfϞ]#IGqE@ 1~xCi $7F2TPEjFݸ馛=(ŨX3'N_|uuO<2lb}79y@3)[ 2O@1>|p#W\z7ΑjAZEV㘆2k2԰W2~.]@U^_ϖ-ѲeK"={!qK@ʞ={[ko %SQfM ,XPEA?zYl '`}2 p= 뫘$ h2^ Y@ HF,%p= 뫘$ h2^ Y@ HF,%p=D6t +cIENDB`rstatix/tools/README-unnamed-chunk-9-1.png0000644000176200001440000010003215074310430017603 0ustar liggesusersPNG  IHDRǵ iCCPICC Profile8U]hU>sg#$Sl4t? % V46nI6"dΘ83OEP|1Ŀ (>/ % (>P苦;3ie|{g蹪X-2s=+WQ+]L6O w[C{_F qb Uvz?Zb1@/zcs>~if,ӈUSjF 1_Mjbuݠpamhmçϙ>a\+5%QKFkm}ۖ?ޚD\!~6,-7SثŜvķ5Z;[rmS5{yDyH}r9|-ăFAJjI.[/]mK 7KRDrYQO-Q||6 (0 MXd(@h2_f<:”_δ*d>e\c?~,7?& ك^2Iq2"y@g|UP`o@IDATx]|TEBB =ޕ^ ]D@"(Վ `Q((*{'t{v6\+ݽ8{[f;3;!L#0vݵ0# `/#0v ;xn6#0,`FN``fF#),ٌ#w`;Ev<7`0#`ӎf3#F`vlF`X;0"N;0 ~FSXisF`#0v ;xn6#0,`FN``fF#),ٌ#w`;Ev<7`0#`ӎf3#F`vlF`X;0"N;0 ~FSXisF`#0v ;xn6#0,`FN``fF#),ٌ#w`;Ev<7`0#`ӎf3#F`vlF`X;0"N;0 ~FSXisF`#0v ;xn6#0,`FN``fF#),mvTToߎ+W ##윞`4 vX3g*W֭[B h߾=]56F0Ffoɏ9Ç믿Fxx86n܈W^z2 |aQ۲{nlݺ6l]G&MP|y_G06 ,KZjI1k֬lՓph޼9h@&F=Xd{}fzj(Q˗/ǭ[۸qcݻ#,l,uh"DDDH-[^zI͛7#%%ʕoF1Xdc/^W_Q< VZ%}ɒ%h֬._yĈw/^ݻcƌJ0Juƴi/"==SLӧA3]v!((H{5~Jhر8~8&LQF6m"\,~x.Ȑ!ݻ,;!!ݺu{m6k%,Bٲe a :kV kעCYȂ0[kNg϶m@3|ɓ'q%xxxdhw0m cbDm\Ν+ úJH;w.?xLF6x8ճMklDBf97{a`lrP".`4 Mtv !@FϣZja9aE`p"##_x-aG`$|`@wG?s+Fx<nN>44111c|}}2*#@e(>66'N@*U(je=z\1#yƯAⳗX01"F`|9pZ\MBsV ɚWz2l;r#cfB uo6!6!E| gh:ZD%I ft#1X1ykNyݰkn'#i[e]}`l ^Vug0]@ԹWoF&``T0G/')8 )h%O;pZ s#,Bւ'ʼn߾VUBR}N`Q`TG_wˎH5_Cxt"~{F6``'DHY3MwEdlfX k3@?cHh_=vFs=ve.RˬkKH ן}$Я s;L#mX?Cڵ([ހ;Q!&F6̌1cϺ`(bֈl_GZ%0zhqǞ~c„ Sʕ+?tOBBB0wܬ[?#U///ԯ_SLR޽=ߏfD Eѷo_:t(+?hբ%-=N0F@ɓ1d9]wt;wUVaȑӧ~w NoNN2b54O 6ٳgqEj ]t/bJ XMϟwK~URrIywޘ:u*N8!g4ر#BC˔)ŋKqB89jW8;:jbwrAPaÆ RCjUqeŊRꫯJ5իW *36 \T=D4&&1cp wŞ={3d+#***5+T!n cV)MGӷ~+0~~~}wߡXb *Xҝ 4w7oޜt4Eǧ6m_|cN]=۷gAn*=n!v'ނGlH%KdcE%ˆ \z5((;#H;VsI.oИ9sZʕ+.L=j(cDNIMC"y=}''',ZHzf߱cGodX~T e@!BTDShWͥH3h 8ax%}?}k6hٲ%Ȇpll`ƍXtI#iæTQl 4W4ǗN'TC-Zs(h_Ik%ܤ!IoODw}@~'ӆD'V KبK헌c$#[3mj𙚚*sΡ a@:~"x?RJ -xzj%^\fG@}L3@C9=}r%bOekTĎ[:]KD {;Yy=ZGuI>}Kw^[N_Ufb +ظRD5QjZ6 =h֯M6I,I.l2؏?O?ŋѫW/Xl.;3R'G3˞.x9MpW'Vyq "=[@;iO{r !@[L@aE@!O_n&[[9;A(]8No䁄 ,$0}Ei{B@!fD+6Б wW'|F|7A7/H(8Nt#`o($=M^;.!^ei߱PEePt@zx>rЎW͓_kfbsUZ:?­18:d{2ӥ+' oFө9DWorM8uu}X3:7 Ƹ뀠]Np#ʁ^kI&@; +Ž妊I w5AzyM=g]LF**]vMHtRT֜+reb xXI' 􄧂qi_7~ i6O8/p7#`(Ľ߸Fv1և m*Q|?/Wӯ!v,V-njQ#_sV߮]6ߏf͚e{=#``ϨP Z{O;w,ՓL5jKߌ# ``' }*?q{6] K8! |<]A V 14YBj3(?$$DӇAx {6fN' Z MC'40Ga)p8?L#(xSHt$7C5\0#0FW,e66_ݿqqq6}&˴L316Ћ^A}RYM4vvc^c`` ZVJKvzڹڮ];+qL+WD LV(HLLB\%#<lPS.`@W6Mdn$ܕ8w.n݋BL\"E(l?owOP%8J-;cv aXs7":'%"%50Ga3qsua=/O7} wo *11wF8q&& I;u~3҅̈́z)5u3ޏ \廱1="D٢^(/"~6( h|0u֊f4B-6>Iftr:L}758 Xn4IXpᤔ4eT]Y b-~-+8ZhE6;J,% K0x9yy)Q4,lLc62. SW?O%Ŧ~vpJZ:ReeW ~zӿFuiUG߭v nG2$f}UӇ031[ qo^E kr51g 4;QSמ+0~  5&i_x!,߭c*Y0,7}n2H, io_b#tm.e}!|IgW[>` tLh(Ϙ2{v\mLN4,lrg>M ̃ۊ A4%2x}K)z_Be "P3p'W<,,5pz$Huv4Nߡ*ARφ!-{ Ii[F-^.¢,Zy.[TDZ1kټt;_`>ŷ9s V6+\?#:,Trw0[OREW+H4kYl>~3$~DR w+O a |L8l_ ->$6~OhuՏ-oZ LmB Bҭ?9pІ9};c TnmVFDF``7oĉ̐yF3lf: 5b72#PX``Ş6l~w9Xwfv1-9v줞. [C{,==44y*|ӆ?D!CisbvCW"W`"%x2X@ !9sL,Y7o*_ѣG=z4|}}-[ݴxǰj*,Y2+?h&W=ݱ+'$kb2y[kM0 ^ۣjԨ!'Oʇ4/X@;{6O>%%sEJгgOTX3f ZEQ=BΎ(6B3$UӤ {3j!@!d7o???lڴIx1šTRضm{nƢsrʡL20`L G|n";qAsUD-hWt)<ęK綉 :t$4i-[f kJuO%boў7UKA II[b㗳8Nx-<2F#hSOeVZe]vͻD] c3Y(Q\b]qEJpdmj\9"@cRm׮]:.]ԛΎBҙ+Ae X2B쏠 4hӦMCBB6m www+V ƍ=oذaVf3Ũe ^VޞnV 00%'cl mMm \%/m"oӦ ֯_/~>>> ! * 7 yy%xؔ?O)TpF`p PuDj ꟁ":::u*"]zcc~5CtJXQx|8蓓ڵkHDDD cj$ҝ lQ\ZV+[ku2/8#`k =F*!Sb7RʭȬ"->[Բ&<]5{^LAFV?6`Uz9w`i״T I߾yu ך{uV|пܾ}[:@{M|מ`Pze ՋŨHV!lY?_,|@69s`ٲe\2BCC $h6p]C09(kOՀvtFJCj rUmٰfr&(_RB32# HlFQj̗DGD]!ܬw^P7-̽O;xW1Hj s, I;UAŞw)E#r&!IIoԜ18 };52MjdsϟUO>ߤ:hO-[V"ٹ&<, z:R@.Z Owa_MU ?P{%{9;w#GDxx dlmXOTMaȁ,涇x[m's\YNqC 7fٻwo~).\ $OV6lZQ11"oHPWJV/G *UߪBZ1aLŇT=p PҥA823jݱo>ЉtD"T1 B#*iaJF xw1׫Fu(zO6o=hFADWmlg")S[okVj֬C|PVApdډ#`w9ˣ8v~Łm7ճ3I|7>ʕ+ѢE ƺQ!J= ^GÇ,;88XIr-<|ׯ/-Z(Ə/ύPWvDBz<%x Xz$үb,\0|i7wAEa ĉ2E>'c/Ìe6%,tSGIh G!9%ͨeh'TC;vB<[Bڼk.WXQR 11J w%Zej(lg[3X$]+}Tl ".! tc@ԁM7o[bR sIII,ĵB2pCbPrAB^2tU޼"4پ;*)eSOSF@BP J!X DFLd0u^@keF]P0d޴iS 91^dm`AU@z)^^^ Q5+AM[We ԄJղoݺ%7Z nn<ٶfA Gݴ?f3_/<`‹ ۷2F`E@C k_ͭel[g44G>]{'UDE#=%]] QEsmE10GH#"qq\\Od8ibWiƃS+HONA{q(.Μ Gw7*~{Õ>((=s? Hd *HA\.ΚK+Qypr~dCF w;.n)1/BzbQN(?. A}D<3 _3!+0Cٽ+1'Šti Ϯ~QӏPS#QZt/SH xdNp)]E|&FȎ x/é͚;"6}] JK'cRݠr@JCb2+>Rn\D‘ҸѠ5<wg+<h %X`1N~ET>F}AI&U"N ed##IHA6!VxF!Bn༅e+vřS,"^H8I#z,!ll_Mim+6r8#PiP!(4ZIdg80uĪRur9D-d17eJj pbbOOVg՜8Փ?r񷀘+FBd$'"fb*P\3 zHdEynFV叏M<|7VPK2OnW,Eŗ£TIEN@)BĀxӾ#վ.#f 4h }a 7 c`8z@Om|@WSz-ݴ 1]9Kjc,TWM#T@ Gw5x6I&/YG{pa>B!6 ׎a?Y!4wŋjOAAPWJ;}oY/Tb2AUb%bn=%$*!HdIrX~mνyDGGʼn/J,ʕ+gf[,, ^IpSdJ}w {3)V7<ݴ*a/!#55 }GÊ l}=Ĥd =:ヒSNaݺu?1a„4ʹv %JaÆXzq,]4~Gy*X~}L2%۲466ÇGpp0-={իYѷo_/^m۶Iz]SH35Rw'BK00'eH~|wABC~0OA]!P!c̙Ѿ}{ udF űc q-4$ ^'Ob3f ^z%] UVaȑӧ|)|I曘3g|Nڵ3$ """2˗ѹsg5k Λ}7S/r$0,<"o\-&*W#Zwy>0 ϜrРO3K.L2Z9Sm6䭮]f*zJԩ+'Nĸq`Ŋ{{Uew)\ d HOn8q&BR"WA>g$X~shZ} Xe9PʘhBO=zɓoo` ;|T’ N...Y6iD4ѥK|YϷo?+;vzNW^#GOg;PT@R;p(MDd `[w[ȥE܁cPyj^,1S|8b0&4_O7r'SB .qݺuQBNUwڵѨQ#]˥G=g2C7_ F:ݻ7N r#.IIR-[W\ATTZj˒M6zϝ;HT [3 =:6̸A 8rjH_J;/se&m#ۇoT4߱c"p5](d>lx…?&nܸݻw<ٓ#Mc`! ___DFF)Zí[3"CxQ5FzS&aEwԱUS8 IDM``ߤۤ')M@dݓztrNTR -|~/fJ G9kr oڴ) D% jՒ?{LK~R f͚r[uhB~gፔA ]9L~;ϋWugBH\HgMYZea.KIuf7߀&Qw@^%ҡrF3&e` p6lȵ_͛71_Άp [ʕ+̅fT#FڱIn*"U*E/O~;˘.܊Z5C^YîEz\}@dV _䦧syTL?8r^.N.b1d:y9Г3MHC7{"r(],ba&dժUCHHH6cmǎNyPhٲU.\P,.hJ7J?D4sO>'O"ZMr򄓧)YUC%->%?Tu:]DE~/ v o֭[+OE*UJzəP,g1"Zn2T?I_~4Flڴ)TIUZR}'?! md<]Z}vUc^A a*L@h8x`OEk5 Rp Wj?tPÞTDLGW\)[NݐzCzt zLRwKo:Z.G"hCUJru:b8{;ܪ72c31(X $(&n%;"&&ev3Y]Z]]ĆgD;:bQP)\>g?Rdel "Z ^~B`^>RET5^0vȋv: J_ppeb)lCh*8UGjI=}(D~HX5M|,{hjƦ3C6{zzgv`mU8Sj<˕<ͮXMFí6ltsRp)QEDg8tr/^toJo"x[UOQc"_LBЌHIA}駟Ѩ7_:.~I t $iXʹ(ݭD<+qwv$\Gwa %F êT''ólizM^c+ih7/IOq;CAhw=\ d=XX{LCZR2N;wA )cLV/1'2#` ~~~r/x9w/SH d]XX*6oU2•Z(s6f2[,3# <#nX1#'bMQ䙝XXC̓>Ֆ)YxQG[Hm 徠ӹ(, [EAm jsPlY<\ZoD^9QQQ6>Y0@Ke'PF KUJ=ϟQ mᔵqㆌuc}A1)-K!E&`Ïs3#` fHOsqbBo"96^lnKT"U+"Fex,XW#t> )21p/׮ eZsFMgq±vG8F$$Ș{LHI}G{P>:L-1l.ĝ66}_CđblߐS ab%l= wլ4wǯUCO_Y9!qXt]Z 3kj˼?')?/݂ks>kF@Xm&gV{6jFnAgEnB>Z̙WaIވB5Bo| LciW# g,~4vL>cfE@?c* N~k.ly͋o 8b|]CQ!pPo B~ c˸i-*Rp9<Ka{%nDfT҅-I{ @{}bGg/Us2&mRM&#L$$ayAFjjYO );' &aLTz'">.NbDANt̐0;eRQo4%|@O k_X'O"|փlVk؏7 S3 obv'&w|enlx3S0;_0Rj'./SӱS2gig)$ ٻ1r?.NU =o+!* +tOc菔.֠҄~א}AsKDz򕽆 eT&@{ )K?{'/Hw1y;$fݿ6jT1C M#2! ]á Ad=XX{jݯzE䏿WĆF2H~zjdVE3aX \7oOF6: pz|),?Daz07{849)CyGZSf#)<º|#_qy|9|g~[!(6: hڗ5;GO+5dvYmQ/1sgd_~xg6sHd&#+Zc%pAYkpt7Fqv~u5k7A'bJ[>ZJVo?|K7-%a&+#"m$y}akL? K n{ؙy7 iٮO5k7l{CdP &s$(9DW_}=^~>dYXXok;1?gh弝y49pRP˫7p]R86ZAG̡—?,6YsSN~yp-V X ;pTE f: 'n"O3$)N]yN)Ur~䚂l'mkkzh6 >Z%Z0uQkD:ۤ)Ew Hety|HF|Xa}Il\Gli]VHADÇO̺gM&gǒD;qj0_|\]]f͚{-[jN (.^xOI]Szj… 3{ԩ>, L2Y?رcVzcO2 !(1BLǷcv ` e4d7'cڳk1kRo>k˗ǂ Aag,rt:˕+Ƚl7 DD'$Μ9ZSɒ% gG:jw(f:?_k?#!Y,_k3i@)X="BG6`O:Mڴi///\t ݺu{^Rd 4B'*THDD<!2Ҵ-&$go|Yrag-b,9;6iY^["߾};hOȶGҐ-RYl ikU@:Jn݊[͛7Ǟ={ڵKuyv'*9*Y|ц0|O"YiýQ~k ƶd3g*W֭[~oG/$$˗/^$ Z <رc}t ";Ho d o Aƍ?MiwIAl98:£x`AɬܳLPu1^AdhJwenשg{P8$p|Ë<믿7n"W45y߻ヒ'|yl4ʲַvBČz{);>115kҥKtF{!((H OO}UFmg7V.HqwJeKZ@Պ O!-ηrb`JΞFnEӑuEA+5^]?yK˴oѢ $}_w^ȿqjy+pÆ yo,r@M9鯿y+ߗ~4$ )- }TGxPX1-tm{{!]c~NbP/ӹ]m)| v)ߡuiPmܓp*+676O+=\fi»ܷIO9) |;&W?z)RW-* {|sTŖ-[ (4vXPzPf j*)eG‚hQ`n>ݻLLNmV0EW7zW1ԅ}Q"Mp.+6*< %J[neԼ~ý0'Ր7VX!U2Y[j%}iܹsːPkTGɼӆt:JP֠bfuPF6* S_kkO* &W_V4a0ahCײeˤ&u4KtЦQ] o.]Z[^zgm毫f @! fΜ;wJ#1̡cDv l Ҁg@Vj0;aSwg}U_^!!6ThkgeK:}Drn)? ͏=;}4V\)wo B?of HKh@}[ KHn/ H B&5̣_ZgGU0>1jaύ;8/,}]0eż|IPG )'#9o]R۔-# I+}!@*/]l* uSb h;A`3 MUtj*VM*,hY2 *6|Ԩ,W JQti-6TI7ql0`[Ȉ[[xЇ(2!9$$<](6yo[ :ڕv8P Kp"Z<7g+[\/)vvX<&'yU4:n^ Zu(MB@ڮ=Um3۶TQ#zM߹p{4@6o-:& P7)i3=K/.g$h-~^3碏CQ~[ A~d0٤2"v͠P^ U\\I0rC6|䱠ʝ]_Vk0{ -mHcR4S/iӦKf`ݗ?.bWno>A=Pg'9x00Ȼ`35xTyVቩ, b2Nf6M1:>d%}^]NuzrWM{Rv4߆Rˋo":!xGEj.4%3WZ/^\\'!$ 2D4$ ai I3EgI'_gH?TGg.3Dtˤ"蜡D#CDq,-խǔ[y8|6vw8onɼʔBPF?ZT+)WDI>f;&)*(䝠ґBD,]ə8нxQUUUvzhZdJj;uc~m%.ق2.']Fo3 /djP\wxS;p52;><g wg"LE(]b⌅z//G+5;ZXl*y壍Zk׮mҲѭ [R6#?fD2+}R;.#&&cj&YeV='M.y^}B8$EǂTF` ()l:.&j[C&z0Fe?&??lضgFdx`2tH NlF榳g*[9+)..Vb}AmfzhFiD灗,YjM``5荫Lu;+m-77ccc_-O4r'Nuұ-M,,ѡ3lbg#/ joLY^@FVxr-O Xnֵ;! $"k:b @^2FX@'1# 5P2F`,@❻|בt,BûB0+U4kSIjlb.^BhG0'\||U+WfOHNy/qra%g q"%po tg$p)j)4? !|WE^=Ps'!hk|nod2MMa!OqHQ2%ꀲ9ҝxRvm'o#4,Q2: UrwFiq~qj%ТFUŮt['ރv? 7VS@}—Q>IP."DK8()T<˔=wđc84D9*ϐ+b UĶѧtrsKGB`\u>.[P1l_ wl#1% Iⓚ0Sx@6?61goD( j!O@qjN0=kNw!A0KjS(M X/n^/`C81sٸ%SxЈ !$q( Mg}L(~Ќm0m 1ȐhMֿ︄;/8rdZb`{"|!K"q )"Md$ɹ'\JKrp-]Qeݗ/wӑ @LMxfe-6a{ב*t4+Ad'+T`[:vC)Q"2ލwFx~h ԯhzVsx15/ S|/!vHx\ʅGZ}iE@OE۵+VT?ñqr>3 TLvmȿs p=6}I>/}kM*Zrlߊ:D3 aBB,fIB-cMgB.ODد_ lHg10}?CuU*6oVsF*v7Ǫ23Koo=.܊i[$C zUHU aPۚ@ݣ sq H EK)WތwtLMxR>v,]I IkH{;va!$U,͙Hb^G)7*h J|Dkg13m2}UepC*6JO{GWUOKHѱ\L2M«3[t|h&Tl%KvCH%xZ1;W+QT2pUۅP%s?Q,ɋ!:ߙ5ś5;wxXDlO;,2r[©^ԼY^@֕H<'|3_O3pTT @K!mKLz 1'dqWI9ƮÐovݏIĢ-Bab1(DCL-|X> }T J'}Lnm6#MkR8\WSL7E5xp?BCW7^Q>_z4Q(=)u :CvLș=KXX͛W4Lm&z_TC\$n )FDl"-P8Φ-j*5 -[˗!Ckb%6)Ez̙3ѥK'+?vębØV{fذa -&!NI#;kVU4@.[&))Э5.&t_boNe++ X=cz׮]ѢE \v !!! f MD BD%~\nE%dkIA?qZ`?v\.b~nZ,J,3b M)IwϓI۝SCD:%[@򕆰,6*4e~Iz:j@:v͚5YBDDS"}gKM?W_}USLJQ'nQIe+"@B PN+W@YgDzkWNZ]9"/ %(5Vf K0BMP9S(C#)Cb{?FT [aB#ɣ*9rB*$8^b%@B=p`XZlۼ)k?~D6B#1:;V ވ4*§ Ut'f0 ?.=4[ב?:t <{M~СC2Uܹp9"» uF´֙ ;mH2FZh-Ep6d2-u|'U+)YD$m0):Ddd栧?_I*o"("κy*iOTD TRYߤק;wJ@5kbҤIW+;_ʼnNuHp󪕍N#WJC)UEJQ(n:!PBŬeu·V Uu)&?v'2э7SOK.Exx\!YMV3Dqn}9S[GqLdLZCT"|?'-_^~tG ùdYYn.*ḪNjɕST d͛7gC3ݻwg]c !1}ttEїSA*%\@uMv ]Jl]{G0uFLr?* hnuVTS-zJ1jP(6lMew$10x`  e?FjbFn)rpqgVfU1mmO&TdT/7T~93Wb*UO$t2Sm)z7AۇT&|-;6 ɏ#<\QTQՋDjO5_JB d}o G1ؠ,\ HuЊ¿@Iߥj+4Nb(S ժJɧ:ZiF. o)ш._L`tΜaJB c^k`]A}ՄjYP9{{"5ZqcMC523m4 3#Dbs;\=MZ[lsۻ*4'$@؄}#(Cӣ=G=4Nmiq[##3J̸B{ED6BR}U^w/T[u{3V>f\&8oNJzjٲi'K׿Ec| t7ZvO*29}^傩xeMѽt01w4% zIR:&У/SSRm.'{Μh&q|1')8w9<{NvE0oѺ?׾3ÐQBǰ $_ο]6,\$UXڠ1R~˖R^?'1lJy?? k_|Ec*,Q2/ y᫼ϙ4WW6T& .kZ&;~!|FQ їkY5M+|T*&.0u8M~ zӖ!I#x9:%&tФG|Qy-| E \~rCCIi=?u,+=D*ncr@Ci`벏'-EEo9-\ح&y{;[߲zeꉧo "-`N ҾR:aZ ھ\Ǵǝݦݲaً7\ʢ]\"}[5Z!ʱ knrܾ! iu@.m#%>MّRbv!`440 憀5ͭ_C0 h$ "vʶ3b9oeA9TQSZOͺLy)9m #Qmi?[ bTz7߻w~uܮUԘF m9!2eMC06 \0 C6z֯rwD@Gl9rt?t q|J al:!_'V/1*|V?aGid"P}4Hc iR bX"lաjyfzE 4| *R¤yƖuG]Y'I6ɪ',]ՑC&=P#%T''0Cb7  I 4,^B̉h*DȈq? > _Pv' D: e&OX >B>$نDPwp;I}.z1ͮK唩 @=/>X>^:`"/j&W}QȓG_V tUHAkTAoPy2_`!tdЉP_tfU'(*("lJ~5a ;~W`ytsgD́_a eߤr(_A}"UsV ہߡ>!CE n@ Pu*xC]ڐyBE< ɴ}f2dݿ].Z,>e %s 7miW('{u]<"w.D:`otgAZ!z-P+LhXKRy[WCEX吽|t(N\Ry<G0IL*cʁGM A}RGW@~N~*. vB% Y8yWMyɏO*}`_  xyr,\AڔΝCc×9QGji<{o0 ^Ad 4!Eˆ^G|^J2 =iVioF0rHuQgH1,J'HC&dҺC')n._C^OlC :-}4EJR9 dIΐƓ|zbTUJGKZu qiO:цШ, E'%rVٱ'k\RztG3a( Iظ8.|(\#qu14 uR!Uy<ٴs|@tQ?^U0Ix1 SC&!:iԊIfӫI#mqKQC3Y1ah5 CE=8 0J'o4\L0)hG BCA.V苆g76ӊ=O~BK_aAkNWmS3r+_]lL:U %U0UoIV.tD}7e%c0n,hՕ.|? FO6 4C:YLjJ}YKN1U&ց~X(_XDYPTBRQ^ CR2ٗCK;X! >Z > ᖴ)_ :pURѤG<-`81hpU6NN7TrܘcUCo+x#@'v!ӑAL>B>yL:_;>-+ǎ|'pXjX;c7~Yq1xk׮͚ ,p YOs"mV̚_~ٛ1cFSiYsNM6YO=w饗fرc?62)74lV|9Ѓl8pB/{~ϴa8E,k]^XPBoa@)`vZ!`.XJr֭iӦFz՘'2)7c&Չ-JMkǎ֭['K'~gƍqTCS{\YVq1Z_ KGZRT{/3̡:]v&,i!{noС }]wk۶ow{=zr)'qo6SN^nݼ#FxSd駟u$ӽ}M&N:I劋/JGɐ/_U'0ρ8M4^{Q10^.|/:޸q㼹sw<)'N'^^rk׮]wݕ)nTBz &dbj',5>c 0_~ /g͈;:ꫯ>۾}^xW_]'ZK,|͚5KnOFhޕ3tWzg}6~׷o_7H+FݣFiZj{)3)2`B)_6f j4h#(ڷo_.T{x۶m\~ DŶi߿kx]C> a%V;{TꪫB1/Њ7U108Nç[o;sӱ{]ww5hC NZ/ķeR6Y:!=>w'OQxϟ[ Չ{/$%xll lb>\4}ٳ hR 0#*3}=Ƨ~*Ç~(e>=ǐ<ƀk(B:;Mn @+k<l1oP2蛜8ϡ 2syɂ o&cF*i:} &Cnt7.6:h `c$%: +Ib7oq>`,Zi(ʫL+E,RZWߣ=>!fڰaeGJK'N>R&LFdYgJqpr/dd'&l#ɆL3!>Mbػx=yT`*@Ǐ./nJu8S'_G)++^z%5ŐP<x\C+S sp>dkQ@ud4&FMtY+sF1:L<ƣQ`͐:Ƹ`_t7MȘiӦiC@9V i#w9`R|H!< %L&$xT)j@٨8 0@ωc$J8:BL'3|>qTƵ#^(/ŽM shȽ dͲ.J}7BdSF%+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iPth@IDATxT{_: =Dػ(Qcyߘf4XbXc׿]TD {YX`{Ypwv̞s˹{sNG%JJJJ b dF|=JJJJ@K}(gOj+++(%`4JӬ,gJJJ J XRp4+++ R@=JJJ}(gOj+++(%`4JӬ,gJJJ J XRp4+++ R@=JJJ}^K?ϖ7lIFS_J/ͩff%P]Yͻ+CgNROYWe[t <5מ:)_ %###hDU4%=n>wp W^<`b%a'KK{wϕg߳ҵmͰbR1r%1) X9R(@F]+vGKwE}~O7E2;EuwXPTړ+ -=L tn#790܍ee@/K,9Ã֮]+۷v5D=yAAr>TW!"ݶmTWWK>}k.)//opN-Z$[!C4:,D ,{$I$Vf*ӟ$]vkV9ܹw}H<eB/ղ@<wѣvt%O?uwJ䢋.N:I,=nWKhp}_.ݺu/ǤIdܹ޶wmVxƌ#{yWɠAdrM7IYY & SNrqs==?s\ 3ocQ.{^ϟ//UVɇ~(_u-/T8K({>l78g֭GW\s=OȂ dŊaoo߾vÿ _.)wʔ)'@ =m޼Y:v(ׯoƒ/Vo 른 @})o!~\uUgqFCmS,/5v3Keoy}8wHVY2kyo xݫid޲8yg/璙Qc+{V*7—x"-L{_ :2n^^\p/>=qD)**-5i u˖-i&~_@%Θ1Cj) f_Z&@f֬Y2l0}J6mN뮻NUv[N톼7nsr CfVN},tRUU%'pBkNV^ExC}6`X;ept"+W{7VŦjTz 5#GrX\ _]vٿBm9y7VvZPҶm[}?CeI#8 Pyy衇4넍H%]&. MիYտ'gرz=.7Cn>R~p|!ؾ;"4ﻒF1bٹsV4 3Xyڍw)!bۏևQ|G`/Pli+ލW33v>~YYroݗ~cy裏;C;L|=w68|LgHGn#>4If>^V?r\wjHСϣ+hPq:6d4ɜ#W:L\"_,zx6ٳ=3 jRw1/6p4￿~_@%eVVVj^)om&:oi`?I_}#G4 P+3gTX,W ZڷjnG{ -"8ZgEajK.u50kD{}y>*(r:@ INs x'uo8foYðƤ]}lnn@ '+$c ?OdSO5* =tXϫZ;]`&: 9s4˽뮻T<+'A{1=xQmO?]C~JBq,OD &쬼&<l։ o" -o?_wh7gȦ}C(r $z9KBHG '}H s*x {`B( ̖]s5\\ty#,`PX*6E܈4;hPgsPIӾ}uaٳ4&d@ F :8b7iﶒJˏ O Y~s=YykϚ*J ,\.z3 zi_>J $`4f%/%Uvk-p2mLFY>MolSGEoULmhm@L$`@c"F[@KЖxmb" 1-JJ%JhKVV1Иb%`%%`%uf++HhLh hm@L$`4&bX X D XmwݶJJ &1BZ,Ļnl%`% Xm!VV-Q@[]m,D++( -6[ X D@c"F[@KЖxmb" 1-JJ%JhKVV1Иb%`%%`%uf++HhLh hH+ݲehl%`% H+0`< F{I++(ЖxmO@OVV). )~mO@OVV).PǓ"շHW 4+Θ1C233>k _BG $:t>[VVV-fв2+üdڴiO[o%k׮ɓ'׷hjz뭒K,G}T 'O:U9ySOmta%`%`%h 7j%''GN;4ﱡCw+VVV-~}I=ժUҹsg ΃ݾ}s]hV $\erW7|Ө,#Ծ}FaygYkkkvJJJ H(~+v@riϼ n{rwxѷJJJ QH┗ky9h&9gꫯt;/_.˖-ݻw={4jIIiӦї{bnpnX X X S c/7n(?l5\#Gy̛7Ou&v݀rv֪*9餓[nip>c֎3;<ŋe˖-rKNSNi0x i% iu;S12hnj%f#8 `ر3],|S M>|#CCKbQ䡇Sl32B-n>gJ&77W5eL*ǐTl۶))߷o]qg|Z`By2!iر2dy嗿e_>KO XMb@}y΄Z9LtRaj@kᆱm;!3b6݆:nʱ)§}MV 4H`s}R;>Gr|G#FȂ !1җ9ζ {G(g">tzw3U&G u{]IO ~ 0H55[G QqOYYG9n<*`ۜ+Vx.bz{),,|$== -..+**<*xޣs!Lj-{ΣX̘1bB ie<9s=J(.#qKK 8д(5Gyu0Qzyg믿QTƳj*C&[9:p V=ty('ΧG(@H xܵR1 Eq앪oG@QV凞D\>a4om\KZf|œw@W{n[x~ M-J $PZZ*Cv]/i5]QWä%#0*b5b7VJ 59{,L X/|٬YL44(wk.u6%K`ǎtRDդzzާ,Dh"me%C ۷O4͢MWWE-8G_lj5XrZ'RSoЦJОo%` TUUɷ~U޽{ѣ%777h--@j-㮐}./WAߠك%`4|Q+*5k4xo^&Lx23ʯYUҫd~hNK?K}X xlZx _9nݪݺuk{q ##C[,R~ۨZ;Qv8C@ZIVI3 h~k$L@mJǎhҀ%yQSob*ْL@@#ڲ%`Te@h_mm 9ra(vM6IQQPMݾ/zOJfO^IC({C@°-Kr0f1%:Ѭ$իeʕҩS'4iƦǐqZ٩\¹lSUva fH30?xlck45ǚ lٲE":J:w(ݟ$$7VBN4(ɨ SM@vÃ5ݻu|+,Zb-_\beevmr'_MO<_)Sh5gѢE3B>RQSR#ŽMN9et%ӂI2dĤʠA+9XH g}3FK u6!%Kȣ> 'L:U9ySOM&aM9HޜM'nRvm+_<, kUF,'WϞ=5@m)$Qy x"m۶iغӧkyiy%͈ ;xٕ$O0NN:Α%M4EkG}c`QFigvOK 'B~Fy}gq$ᜩG}v.xn])y9R-4tvaف[O(:IƂ z&P{k{w+H2LQJJJs,j3]?(!3?ѺZXCMh3gG %;`W"ȅ[ cݫ+ĕ!W`vG j{ڵkpNk<.eXS-5%szf[_< g'j/޽{u (}I W}̙&/MMs juM+ 8ByNS#FHځW&vb͐Mb7Ij]Rп^c#@BLAcC%;"w( EwG<֫y'B\-1t…zK.P%sN4I0YB.Mz;!M;YiUg'Jɂ ڦ;1vӵ8Qvi`e$~;,YR)zoU/ t]Wէ88`oT lL36g#C>F lJ> ػ|$jˍŰ'T}*PR ׺6$ 8Jrk+l4m&˰aôobŊf' $ʴg6&FLE3vX=)u$`4uUJU^f,0#q[OM&IT24 M+ {_J^]H/rʋ׍HN WՇcZ-,,6&D0SJ>ؘ#xa5ȦA[kT p}WhBN31Ż1&!G&Fu4mfG-vXM[A [fϞ=Ϩ͙PU@>zD41̸I{s\<6Qߦ&hOOn 2 *y aZ )xaNADէ,^SGvx9qvܨ8o6|  g̜N gCHh8RJKh5k#O}cn@ \fR@>6 ۷<5bPvoHVX_EgEn2YRo5,> daRTTmY`oF(jnv͑qd!CAOp09U}~X=< ldna$Ϲa~GreXM_SNF77W Z{P#(-F)T=xӴG̗5@p5kh› L1|p&aDv^`̋, FdbA%@~z/?j5uH񀉲 Po~80&X;hτ@I%Qިu5n1cF`d6*4Ujng;Ћ1^(0`! ̀893qs^z2 (tAΧBB.|L̂#Źm֫+N Nf&}-&-mF~WҠP5ˇ;Txi;%$.fqSe`M:6fK@f/,=9횰ydAfI|(h 0| ̶,/RatIv(%,#GYאLŴL8A./Cwj2% Jhl|) b|f}Nӛ}С! Qg3$1\ !@W )Q3`g}` r'D˥dԄUvv]Ω6O X "xr~~~ͺ0RM/ښjٹyܪ[\׾koi߹dܻo pd[ҪMZ)ݻ[JKt_ԩz) `) M.@@A hRՀ&,|bN|>$yQ :wJ>_ 4XȦl_bv3M2s;8% $ũȊUW493+#uM5m|#C>\))g>s[얅[3dRW 7ZU߿tۋLhߥR=>oGתH^GwA{f~ h+WLꓰZ|ՎFژ_YS 3ֹj)/m<{|k B^{ d҇KvʧJdef71J JvPG8No)~ -Nãf,ԃ,\ǨsUTYWq>|}\y 22K}O3뎰&Cv;, X KLpg{#}wX/~y139BpF'5z5CbV:HzqNqkUrm@H(FΉgNb01=a9~ <\/Ts{ٕREJ^Jurv= XBh|JQ]]_d58rxpXI8oV\:L1WTz*jA@񌣆z"q2J`cqz`\A*36r棃| S?1籞T8gjsdd51hwVÖ@AQl8%Qa&cn`'6D H@ ;!af;ۍ2Uul.wt ̱S'\^6V ܨW<LJOR5sMxR %ϾWjUvOW^)`큰$`4,1O5 |ӎ: r ԧO T^C {D7"`eU_[Kv;uL_@ "Qb 3>SO@B'uHdX;dAEUطM' wϚTZ3 V>nڴI`:S;}*+ qVJy LTZ)gf^  #lXka\ fM2mPI=`,#F'X>2LYP nI#m \Qq^fb"&:fX7_"}úvAI_~S@ ``~0_p(lD mX-}'Y:Tؚ2a)6`SrJhrޗ=y[1)?;e|@k+){#`_htԨQd ;`Vq`5~bۻU>xf8d>8/aX&ŬA>:hi VOՇ̀6%,&ϽHHM& $_6B~ڷ(L?G?kÊpR3L>e  G_~'K,Z.d涒̺J j\x͠I=ײF8zaLuxۆ}FV_QegUhd,boދԩ@nuj=.!F709^}n'C?j%ešVs_+9e0x%J;ŋԀ R:}0u1X %>^thSX)3&@rrW}K)_d;JH(,'5}NEP:iƳCaxyyas9SMV/Leu(!k׮cMo$ʧ,T@jkD/vJ]SR. 6`| _· 0`\+@怽aW~u3}yO.)tԆ3!a)˿fm'H_) hA $r}њ~i5 & ŋǐu&^~,Su޼yz`NѲhyo wl԰S#]%Gg}#o}c]T@#X[Ѱ-{kB]a0a?jj7s.9G%a_DLYjx8r#(aKQ[KNkcYH6i괝FNmvI+80d@O=UjHCg`Õp%&\ h-_9χvRuɔe8)[x:6-ϔ3O#'p& ċ z1/0&m@`+ LY pBQ'7wھu<)m ٽg7vJo{cUҕR2O͉TMݺL)"VŇU?:UP։I)l_~YUW]ÉjnhبlJ% xyuK>p s\gHWiї%VٵVRة[U\p[p÷9V׺Y5_lwjB8f͚Hj>ͣ:J(.f Q) 6]!5LYT+uُ"{~H F=hD?}ˡv}Z7oxr\W?&ː[ɢ{']:/(] 9WV;~*4)=κdv zbFq82=`,+P S`Qy'`|0 ;)u\~ԝPv:)^$ w:aN]UѪd=K lCnӶ%O?f 6% &r"4 0; 7zf^P FGm@ysk<:jm olp0j ;##u PP~}=_ Vtjud?e@J{~?h?|I݋7ވ\ǦH9HՁDnc0@WLE‹ vS^` {!E%Z<F<(k&r, k^?vP{\r`8@ӧ5(JO'UG*6Th*Q |6uzف@<_NRS2O\}-t>TMX@>^? j8fՄS$3J;R^C,a8q`<;-P֛sшhRX1K`g}Лp(ZaĔO 5 %w7 [yA ev`"^+ջ>Wni}ډdi@DaL]"qgZ?P(ЗzH0Nb$yv^\Qrၧ@K)F F`p(N\r(,pHJ'hQf* NQ?S>' (;?J7If_"gF2N' @MսÄ%j0^&-: zZM $=D'L?~7K37 @aw,"nܸIᑲ d5`qQ_f_Icqj]cnw ` Ö# 4:RQa+ 18m|ȩTVR-;3>%kl2`"D|fD*<__h&+΃E$6%J} ²FߕCr\./g;*/^F3gLWgmքCarqFYxu}LADFefgv pNͱ{ZywS=!Q=r4G?|/2~3ٝI!,zF;S3fh+ ,%LL_b溉>үTx5If>)J]/" ɓ'ޓK. |Acx}=/j#-ޡ󠮙JUXL TX`s%vB)o=7aG0C@ c9u ;q ﰇbg3 8(0)`W쥀7 Zh~V G/UN$^ )( U)Tg<` N¨;&@ 6m6O4IV‹fS$p)9[er y9.yƱ]SYBH';j_a)1σS p~7?ob=쒱{B6'h&<<`<.E*y g8=)LaNUxvj*E_zxa<]D@jF(79u;&!#O<Ȕ)Ska@Yw+,ۥt #:IaA-^hl070hJ*KR{,\A3*7c:GP5)k}zpZ fXa 㥇cbN>dcԄNLE™oJ _ V`c'G*PD7PB~ 'L:Umv {,\Jo?0s? cDE%  a WLV*fFחQ.uJ8yt*>>0=|0Ku & C0]QѴO)!_:ªM8S^-W@IDAT9iSS+rcI U) 'e7eeviKR ;@R~me۫NW 1]6F_ kˊ可͗u2P0@>(g:+FTCIkM> xS>h_|\@ :/ft(MOӿ,hMSJ |ynBG Pg1`%a;3CMMe2w@:(Qr.< [4s@HTn@{d-MK!a P3Z q#QarQM==0;`8'á3L>&řxt-vI2V6n.֦+>8ԟzFRGgvy$ԁ-7&M0=Vsj_U8X<_a5Kw6S}ys $[@Y6/; ٔb_00pB <|gN6fU$N/X)zh,<_)@J}Rù""C82#))3H[@(zMkQdڷk#;ZEԍ1ʷ v[$(EňGBa`f^OPx `K 65<—ݕj6Ɔd*P '0/@{'8 bpmL)a-]g c5=zR/>T|Un0yʹc? 2 p_PY (!~>d6%h$U6߰KJ~ }Èc)&@`þ=e6ߗPX8)@8Gq{l}a4`uul\V 0A5u\f_00 q"vak5LkR&t@=b_(ϻCYc¡0Q`CLr)y$@ >j))s89'? :^ff9w!kdnG*ڰ꘧?,0V3%^NTT^f .RN2Ǩ Li/SӈV`Csf {`8.:ϴSd{Lyk>H~ꞒUw ޸Uz-+Wo>6& S2|ԗLumK "<ɋ0~xv>0qړK|!wQ9n&ao~nG(N'/ؤHh^v<1vٮ=][=XV\Y*}dLQ ƚ}lc+er3_|E t8х^(_|/C^G+1;ĉ.~yqK/+7WDpvspw0+O#c)8$~`i80ur/W9 俷)vh lkLMN%Ky?!~Sl8^8nbu:gnä0OR9*QWe`>?竳,O][4vtJz:g6pEa;Kt;Nzf (=H~f~#?DMkhԝEfT9 DUմƮVeÔ@P{1:9guVP0i5f,/_VpvםZ$_jpy HQJ4Cx)YPq1l :qꐨvJ pn0Ss>?4v鵯~4j'z{/ iחfQ#f>9ݯjKjv=J Pʤ  #32]tEk/`ȦԐ5%ΉVG HD)` H9ߨkn6: s5 S58 S 8JwdoL.l$b@sq-/ Œafa?/+ =VB)/y睧—^zI?)yW| ԒyomS&ga`cŒ}au,sF 4TTX3:fȻA?u}Tq~Y SL77(uy`W|B3j$m _|dㆩì1P?ԭRgb՘YRx}_3}H luɃv뭷ꅇz]DK %.֩xv2TL /ydB8x)YeLFWWG^g՝@9z7 $`ʭ:3tT=2:(A46V--{5˜nX)K 0mסp<#?9ޡQ2 ܬ>@&N$ 3G=45`9RR@K: v -RTR" 4cԟW߽`U #8) 4LO<f\(wn]*'";+=7f @r-f(;0N1 L,0fk)9=//lK偿>mע@PE5“*hK GiSJwȟZ\Bxdg;(,@jV0"r 5ϭ:`yL! 3t&΃2:}+N*_PY+M(p8@/|F&_/wTo}]JXJA/-"=%rǿWj;ye&&G~kHqN% ex@&#&F X6-F0c";ր08q˗J68Ruptb][e1* QY&=rHa6a,'|)Dաb#eTT܌C 6mNm{Ii?JզXqM2r?( ۔>6oc w="ٙ%R)ݥC/eS*D Qi@=ԐzM҂4WKvW(>y]Nh̾HMJQ0R얨F0OX2nk'6Rf m@x $q}Ѯ.S岳XzA:fkp52(qyQ'ʦe\,]2?U`e`7C](j@-R?)1 eq-%0~M@J>:GGU$) w2!DNq%C v`3$L UcA9/  exf)=z Qx[VnQvdʰR_ov֡8D!ஒ:ٰ퇲L%}eI..*}usdWOdhQtt._UN^:wzwKpiԌh[- Ӕ^Q]'?RM&~H5H <8F #¢)MoTqlh@)A8h b Uab=YR\>FV-ޫ@i=mr}=JTj-NekKzܭst勺*z0i@>l G2~ԕ.z*֊x/ X@XJZgx\$2{zt5 @աC K0h^:GRw*uϨ $*ӕHl> -Bp6HPNd10? X91cd(gR]j\0k՝TmZax"_T8R9XRX )+3C .T1vʉ*ekmG^NE6vvP/iAfrTH] -_u +sKP6)յ2O.= 0H2%0Rfaq `)l^FTׄS$}>Wx5ŔkUfՌ&W?8\ê 0M>"UHݲ>|#)лUR-jFGyA4lY6 3'tvѷS'?ud(,?P5ќMMЦ/>Wr\R]g^(f5 i`:@Ò|UqV(G 5ވHH_| u KdP0T>LtQD H^?VMT3ٵPJBivU.-L:>`ńAbK3bxA uK P1 yQIPHyHqmlN'f 5}a:/a3`JaHX j;R6lMXM[ִ LJ'%PP٭FI? 4@ě: L0R`Œ( 2U6*(@O&w,֑^Hiad֘ m>}[mS›ό{vs5\ZR@[VmeZ|+dTN8aN Pa@ď~GV8 hr.6=۶M0rfzM;#tYRzhi0ݼIv<~kjToxTŔi73a„㽽ojVɰh,+ Ǐmr8=| q  Ŷ`W)^>DѶW#>|| aݻu]9B\s`hhmqݮRv!l/V N/_^`2塶 I 66X\H a=g3&=( d8Nۍ%>rKϤ`J΋Yu/QPJu+])uvp)G<~CߗXUjkjRb5/bUdcoAb+0o[ΐC^8a?û(E6# U P/yyR3M *Q6oOU Ń: n+i%Yu[À$3Lܑ܈^u=]}*}d%mFOW~KS#ڞHM}*RRZO?0A xAA ;@JȘ-QU}J ;Añ҆s)M Ta· Zr3n{!C*6IIr7RR9JOJn3qـeڞHEcxQY`fPU`#K0&F<4yFO <)}t<* fݷct(GJ{N7 8}b |&NX߭siRʾEI_/)XKJ%R-<ċ/4` j(88/DdqH ާJrQ-;%1҃(Yc. &HHY]+ә]x[uJ%u K菕 ᅇYC  { E Lg)P9* g"<Q6=pښUjđݭlEm,F#|/+e& mD8,4+LNub0@# p<s3eR&#Rj% d41MK--O=Rmx f8[XpMAnj=e<NT|$y#@ c6vy.g-ʞ琀P0jtyb'+ <`+  adA¥L&$3E!O[*)Cg'Z u)t(jS$`4fchDEC')PQM:(o R) yFa;c& M=;Q 0i,_b>o<&}њ)KDaA7 &Tich޹7/?^yJ{)xixTwbG\@VΉD%s1w@J*vVL &bd "w(vRdflJXM廗buG}FI)vR@O-`фm@%4`Ftw)eN .LRJZM[BgMz9aj?VJ'LEg)+:.#=1rӴ`fCK7@mI'h*޵43`@0I;4bHaY6>+NGSC1b=&~p*8!, - ukO]Hf^L{;U3,F%6{R,%=E<gX),70e.86G0`q@ ޱlw<2m! E6>̕eD&rB*hXv=0K@i$@ p`Cux&3}$&$cXP Ä[kgw _siZ2T=`"ШEgOPjϠ%*6>J5؍H`)O7@5 srK(YvlZv3&[mQq20Jpc;v:8/y 5 =n*왭7'nI"Ih,M AE 2X 0%ʰRQQt4GBvi$u-8۹٤:OHSmV*TxR'2[^DDv"լ4,N/oQ"eeԗj8!KհO*iX)T〪q41A8|R$3hz-`?6zJ@\}`4Z?fnTuRN#j|x*3ry}U#2%vP WZ/ @3{A-P;iӦi¤I䩧J94nLt9ro,M(;(#ƃ rs8_b#\ %Z @@ `jwWhaL7ccU|,XŌbAҥ?އvv%: 4 rL"\z饍j~mcOa8X + at$`΁Dh9b*@y,e_`dGw'8yT`2ZF~J3ޗHvQgXsP|nb_~)_|p裏jy 'SNlߗSO=݂%JN0o\Шd-vv.PT_r쫨ic*.L8`xq,a4i  +%`9/Yx易)D:pmE$` IR70䋧vqJt5+7O?NFFpHx8yy9MM {+=rXq=VpFՅ :"129s$M L|)7,g D_(a\:Oc+RSGo_JՖWuɞYį%3+uf5>'*ξ U@'.f) H|m 8 lc$_:nE`},A3=3~Y/\`$? /$3 +DbkJm/8M_W)ߑXc7xX>Y6ͥ2,ukUс&[g`k$Ed@U="&F&XHEPIad]M=M7ZRRlS^BØ3oCBꙂI: DŽdWbH5)_vsXFI*Ɛ'T sΔkGt}t:6lz\8uX 0TӦhb;I@:4sT\a(_l5j: Uŵ׽̠(y8r|S4ƧC0)cTZe)ѤbC^SPy/g S b.U*3tܹ@HE?&Q$aǗ H?~|FgKr(OI1N!MQ!#vr4;Nq@x1Y &k8I  1r/{ر&H k?U.n/)@iNzxF-۵h+>[W1y{C!Mas)CZ̳ce)*ڄH)&i _ JWk_oMRluCBCi0 :Ѹ*+,}*\I7ruH,)x>.ҧ0Myqg%yG~Џv DϏ2JDdRpi,@Ck—[jr^#OշwKđoz6@:!A,PƳiHJAB+$ť@L!|+?$'uXBx?0 amg`zv!bRH~СqcA b%"%*R$@\GGF7+#B=)jHHHi)R), Hy~ BPÑ:T!L nHaM)GWʽH<1B RHvFTWh ťUƪgjj4Beq>+ #Nn! C<υh"M"`Gb-&qD <ܧ@ukubRF6.~V3**HYT {BC`H'V%e!U 2BHXL a,iϕY%'wu?%_(ѱ De[Z?HOX!D,U *D dn$XtlD \!zH$T$V YA= ;ZVN٧_޶p:xoKC@Vp]|UT1@hYT!VtL!M,Y B (R#dD?>iIAz ɞ1f";̑Re@+OwL1 ]fT9=>#͛#r=71uIhkΜ9~<&ȐD?0H.|t1O?Yn[ɓFJ"@qcUV)G2刊"F"-Ff!E#X},8JѿŔw7uW+~Meʕdt( #FK(G \%hY  >BЧToTǺfnT& YpD4L͑4 ɒ=,7Hw` F*|iQ$Ұ)a =z>^*u:Mx4 ߬uE:*tE2nBs=iD "BLY3g(k{ l+h\ogRZ|өre! - 6$~?LێnH*e>B10\r> tvG7v-m\esco[G@Z>vSTϾn_BZ%!IX`&G=r%XJ,--Ra %H T,_f:K̖Uns(ҡ1D_b.A:Ι3g%O=1,a9ΙHs~ֻ=k?3GGh6!R`i'b-;0CS|~Kv#mSO=Glʔ)֮];ׯ۾[{ CB )$Έ0}yynkdf "8Q* hix~jGP>Jpv 7ӹW1s{x*[`AN˺>`֭wVޥKBSj;_O/=vگ~+;s-NfۡC{67ߴ>;s'?]wu{̓/eSN/ '"jp-r!t pI'E" AE֮]M4ɿw u]SO= " 4^F@A Tn:ӼwtRk~_4+ h@ڿ/Ƣ"eRJ?m۶R&:xD[!C{Wh&} S| GjLT\:,cY|'(SN>& VaZw}}ҥKÇ B`С^ iӦ~zf Lo C@ZN5l0z' MmƞyUe-*IIJ$3}?ꨣsO{饗.cƌ&"jwa2mr-YA3g_.pܹ ͐{=yé)AiO>3fhxW^rwyXŽ>K:χ@ÕM*i 8GnE]IDATItwDn!}BEG_}F\pAf/_|ӟE)?2uI"n my;GN7.rQ΋h/x_j1^"$誫ǥ-Y(r:OOn5oܖȅ2Ⱥ CK.`uOޝ1r@#g/x.d# oLVXB0/+6_~ꪼ Eg3,{{/@KKdD@B4DB@ " ! JC@Z^- @LK!-[)"Je#!%quժU~ ^x>̟?ߞ{yejh;xCJcQ5 -64KJoԏ@{q\H 3{-n~63VZӯe_jH DeՀm351_>@އpFQ<<8N)おvV;3 Dxl'4gs9z#fy *Bg xBbJhxE)!%-ZdF]ɓtzwۉ'3DɵkO,'!xͶn;7BW>vG/=:NB~g+/FxBʶHaOt]tE̅m0ҙ:o/#2R߾T%8|\1UF"Gt!}>b8REΝp ?Oܴ`Cg.dr-7S<ߎ;5kī(RD)}qiv)!%1Dǘ(#oH.ycq@jzH#':!ܔ/#Rnņ䉇)$qڠJa*_>ND|ou!%"wi'#yxH췿mq, CXse]{ŝU/˭V@`A(6#14r-B mĭѠA|XC Vxd)SFo9L'D@[cULH Ҭt%r羦pM%œltRk,*T_hy7s8! @ZMB@$h^:$@ZMB@$h^:$@ZMB@$h^:$@ZMB@$h^:$@Z_ kO]IENDB`rstatix/tools/README-unpaired-two-sample-t-test-1.png0000644000176200001440000003362415074710630022035 0ustar liggesusersPNG  IHDRP:iCCPkCGColorSpaceGenericRGB8U]hU>+$΃Ԧ5lRфem,lAݝi&3i)>A['!j-P(G 3k~s ,[%,-:t} }-+*&¿ gPG݅ج8"eŲ]A b ;l õWϙ2_E,(ۈ#Zsێ<5)"E6N#ӽEkۃO0}*rUt.iei #]r >cU{t7+ԙg߃xuWB_-%=^ t0uvW9 %/VBW'_tMۓP\>@y0`D i|[` hh)Tj0B#ЪhU# ~yhu fp#1I/I"0! 'Sdd:J5ǖ"sdy#R7wAgdJ7kʕn^:}nWFVst$gj-tԝr_װ_7Z ~V54V }o[G=Nd>-UlaY5V}xg[?k&>srq߀].r_r_qsGjy4k iQܟBZ-<(d=dKO a/zv7]ǰod}sn?TF'|3Nn#I?"mzv~K=گsl<b|_|4>?pߋQrib 2* (Ѧh{28oIyes8';Z9h6g>xRx'b8ՃWOϫ[xn%|^z}%x c8eXIfMM*iPth2IDATx |E$$!@ * A$aAxEW]YDTkE$*\.E9Vr5b \ 9Ss$tOIoM~$]N  _pMpH P|@@MP7!@@7 @@d  w@$upMpH P|@@MP7!@@7 @@d  w@$u8WTJCgӊm'u_Vw Xx *?ɝHcPW_3Jt#0Fy>8c"FRW}42aŒ +,& ) 8޼)UTQT#Jپr,ͫ6^@P} [m.*]x=6^Z?BȠzQϞ=ʢjܸ}! z}:5i҄^2duԉk><Vǐw hر%8 D۷oWlygTt{ϋpzꩧwߥ;R(%%t /FM͚5ӂ zpBڱcݻ233iڵk￯WY$k֬s)Zn="|̙4o<ڹs'/M?\pL]x\ :i$mܹbw jڴ)q7ѣV6Ӯ]\/BҥK裏R^^",:,C+VƍiÇʿK唶+hU?x{n\pA>W\I]vU\}Gј1c@mg7PE!9x*K]ۭ[.5/^LzRvf̘!Z⸅zI:~h[1CnڴIwKq駟&cuֱԥK$<<GUlݺ5-]TcLj\]{ۙ9x P||]~-UW]ewߝ⃏4ƍox|6q~{\g{p:Px뭷#G~FE<9mBBݻ喎z_WPO8b";.')uC]xU`(,8͛7~M3m km,g*Jrphg*q%ݹsgZjq{-D4jHԧ @@]FL(ZleygyGvWAő?Q ŒM<~yiO믧^zILY,=wɓQqQ,'&ͨ/YD Oǐ-ɒ۟;HOO<‚jq۷XW^m <=7x* @@s1l˗W_},OIKK#fv 4 Y =t~F`Xܾ}EG \Ȟ-[)S'x֚ş|(>w%-ӑ#G5l# =/ORp?C|o-q֘sBoO^HP#%jyy@xŋy]wmh߾}΃?,-[ٟOV7x}=Opp}\' xǎ?X0aӇ~'gReeUKOLܯ_ƭT8@ :pdpBZ|4H&l"w90x@@u.]쵴۵kG111^݅PЊ+[B۷/%''[Zh"1ɢM̀7knvcg޳֭,~.5ӧOӪUܹsÞ={oSNN{׎9x18@ |un(y'뮻Nf'L4*mp&;C7|3_nݪG+rx 7x{%TN{)SXnLݐխ[WO{`$k|$"pdeeIuԑ6oOM喣ߓe˖)'N( :Tիc)o$ TVV&† "q7Jaaa g.8TbH{NfzXUW]eY:Q:uJP|F'//OX(V/(sqE`n¯ om[Ծ}{ `YY.j81~y뭷!]M,9">-'$G39|R+ԫWOePT tIE,$s&>={詧n:vHO<";P'#QDD8Mĉވ#'O }4p@qr: O_dž[z|"Ϫ]II 5jH$įÇ %|q̙3Phh(N~.By^xzEzSeYHD~ZgCZg`1׼HΙ<޻woE<9nM^|u٪U+beT;39=;Pr~\NÙ\m8k q>C _SnݺQvvY\ P֭E[ eK,L>Y600P`-y8׍ڞ:kO?&OSdӖNMiJ/hBqv<+Hr Q\???_<)]tIC]Jcǎ<9$ɓCT*.. &5JwJ=z$/c%\\mHk )$$Djذ.I- -ARu9%yH[bMT&^,_eGbab=*Ӗ[^Iy3ib&yL|yͧ%H{O9rr :vh!  `lPcJ CPǣAMHƮ?KRllИM&3fWj@W'^)Dd{ΏW@eI.,>+=o5 {@JKRSYe p5^   p5^   p5^   p5^   p5^   p5^   p5^   p5^    ${:ᜍDV OEcƌ .XUTTDSN%>I&DyyyVqpQ;[O.𺀎;nJϧsҮ][n>eʕ4o>^Yt)uܙ֬YC f3 ^m2 oOf#PSHH%&&kG:uիW+a x@111悂Ѣ5k >ڵk'¹%)DT UV@|J4w)&>Vaas#""v̙Jrx455N8Ao&уx|W^D# z---qYZbVYZxRy>Esذabŋg-[ە"??íKnS8 hvv6QFtӶmD8 喥mk?-V@|D'źN~Ծ}{4h [lDGҁhJ<  k^QFQhhx'O=c=&Xt]eJJ 9rΜ9C&L zQ8  (j*ڳgXb.A0YhP^M<ΓN< z!Yx~m_Pmoݺ ~O[<+Áx]@$۶m[# ^P z%.^!\  ;Ԑ@dP| @@MP7!@@7 @@d  w@$upMpH P|@@MP7!@@7 @@d  w@$upOvwN_Bt]Fu.SYE%e*RDm麌(@@5ge?(7es{X-%MA@;PXR zuTg sDVsdYjXa!A6戬,ܑC9/[.  I$]T  `DP#  P]T  `DP#  P]T  `DP#  P]T  `DP#  P]T  `DP#  P]T  `DP#  P]T  `D؍Ɉ2낀T^Ly,( .>./ VuP"@@홸R.'鑰jI#D$RP.TaW)UQoI[C!V G sDVjq-/uwn/(>Ldճke5@5 0Gde!p'Têh\?aB‘ tuS(@@Vc(/n@@uS(@@Vc(/n@@uS(4 zWhtE7CfΜIch_@=. ѣiB$ccc)@^v5R_ ~Mi-,,uҥKJee%V?? &G&  PKի*su]4l0 zQ޽iڵVԩScǎԤIJJJ<8_pZ@YG˖-sΝ!C~Zj%u׮]JӦM+WҼy(--İvQ ) 8݅g:<裏"v*Zjj#G+Rd/ɓğ}:! ,^zQFF͙3Gh||;w5kPBBU_pI@}Y ^SN W_M"aÆԬY3٭_^<#11Q>..8իWC@*K[mݺ9B'O)DT}:?A@\P***թSZlIn͔ĉdE<G.""N@8//++Mk',q@{=ڶm 8~7 3#FÇP>((&^TZj'˗ѣʏK@d%Z/2;+ݶm[V 7 Z,5 .СC_C\s[6mR-#jǓNA@n7x.\(>۵k' }vjLOOt-!~k&**Ξ=K^xLu8  +N SҴu<ڳgO e6Asq7; ` '-C"N[C7n$nVx' N;v%K(?B"Z~„ ,聀cq(wy355Ν+rfu?gϞMv'-ZHo#f9w 믋?leǯd;+V٥WM6dv  rO>{~g:XJZ;^P z%P$Ν;.K>@@Z嵗SLqCtt4iZ `t h֭6  N/cӑ)ԷtPt? ``PW [PA LjCA|K[x: T&BAk.eϧ}rV}Phz4ZA E@*=C o: @ T#ƼB[%SQ!+/Pd Ն#r11z)$fŇ= !Ld `.hjX|lsyyfo꬘-T+*c0Gd&%~9FUسE5Qn&mW.(qxa=EPrB6 6Zx6shg 05 @nQx}x+SaC=BFW wգk|FA͛7 XON+WgҠAhԴiSx_C-.=$GįӰ풑^IzouhiӄxΛ7(++Lz t׮]4f:uh}ڂȠ9s.]J;w5kPBBm\OxJѴ{nj߾ׯcʽ8ԩ^Z @|M-^xZhQݙi7ԪU+ͭ2n x]@O64ib!""N@CL &uɠ YLVɃQ8`u  IЖ-[ҦMlϧpnݺڵk0x}SO!(׉kN?B-[G%0pPНv]eJJ 9rΜ9C&L}RrrO N@ƢE'bbbĚrx'ާ<@O'me6mqg-kr  E>Кp  W jP5 A@P`!* z T]P%T^UFjr @^; @d &p  v,@@MV0@@;PX"'a.v ڱDN &#5Y\@@c@LFj j9dsA#Վ%r0*hGK `2PU8ЎT; @d &p  v,@@MV0@@;PX"'a.v ڱDN ou(^{ nrt8@@m4MHkC-P g @@%x  `Cj  ,@l@@m@%u  \ ΒB<!KpYR 6 6@p  :K @@.A@YPgI!%8K,)P g @@%x  `C@*IMq   K-**SRǎI&Dyyy RR@MF+WyQZZeee Q|oAD@wrfddМ9s VK.Ν;Ӛ5k(!!AOP] tBJQNhJ<  kL"ӪU+U >%;-,,GT"""t۶mԬY3姴6A@ct7D@3ÇW,^X &;mٲ%mڴ|  q (a˗/W 7<򏊊gReeULl׮U.@@t' "^HeѣG4`% 5 h݅PБ#G̙34a۷/%''   (lѢEL111M唚J< z!I$ӦMJOOOv8] /e^P.Pi . QA@@M@c:By7'W>I8  `K7v\,:~sf|@O>w`˗/իgV/^(v:ep5u輽fUί*#nOIٳg.B@NN^f͢ɓ'^ c^G $:t὎\gϞ(Jqeee{nwjOZ{@Ѕ7Iş:uJlhsa xEoɛF/Cžp?^LJR7pݹjW#{|w*駟,l;rHoߟ7n,6+_p:p;FݺuZ޽{ᆪo^{5zȏ~,0J˖-s-{t+~izg/r؊+SS^H?*InqJrθ%KdwpM7Ig wqtWHQ8v~'$ZDܛ7ow}.9sĽo Z?#FEgLٺ{GpB[6(?N?|-oԬZ:zG?Lܵw`*>_*w׋?8>yd{2ƍɓV;w׿HۜJ@@eh(nu;c3>:uV&aOk誫kFɳ|- W{3]H(樀ǮfC~ o#~}ӦM򘧘 p ^~ gZQÇWY,qO>U cEkҍ_zX;zh/zx"8@@dX{[|MM۷M7ߴ˭ XBx2%x:nBGk.x;^cuPB*A"4jԈa e]֭[g%M;qZ.i<<[jcu}:>} f{ ׎دlB?wYxI~D={$/䣢^7ӕ|A;v$IzJxC@v*ǁKk ./qp)%%EOq?ƍ }Vaf&f<["Ҕ)S$y%I^"F<)DTYY=c !?YI~O2 XtB?X!Ēr˓TgLfY&}UҥKbmhLL Yf髊p!3 /{CVPx!6(0@\#ubB@\#ubB@\#ubB@\#ubB( hرb!}oyG)Qw-7P]x vӧOzscǎԡC '>i i͇F$0i$Rai4w\q3 ^Qs۾q~5G}h"3qπ| s[;3&N(l=ލYwq[.]Dpⳅ5ns&_$.)FKɇi:0*oa.UdONț|9#5_T᯼ϩ#*}NSs֭[EkѢeff*Q"c:PU 㗼s~*}饗Ąź2W|;w/x2qPչ-[.I#q$#G_~6>%h?,tA1sCQ||hZ";&$`A=@@ERRR8I9NrR1&|+>sqlq8[oX yI1)Dǔ# iɲ`Rvv6mۖ;SKmgdJgVmÆ 9*.LG@MWc|HMU9D[Qt䜉SSm@ [![R build status](https://github.com/kassambara/rstatix/workflows/R-CMD-check/badge.svg)](https://github.com/kassambara/rstatix/actions) [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/rstatix)](https://cran.r-project.org/package=rstatix) [![CRAN Checks](https://cranchecks.info/badges/summary/rstatix)](https://cran.r-project.org/web/checks/check_results_rstatix.html) [![Downloads](https://cranlogs.r-pkg.org/badges/rstatix)](https://cran.r-project.org/package=rstatix) [![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/rstatix?color=orange)](https://cran.r-project.org/package=rstatix) # rstatix Provides a simple and intuitive pipe-friendly framework, coherent with the ‘tidyverse’ design philosophy, for performing basic statistical tests, including t-test, Wilcoxon test, ANOVA, Kruskal-Wallis and correlation analyses. The output of each test is automatically transformed into a tidy data frame to facilitate visualization. Additional functions are available for reshaping, reordering, manipulating and visualizing correlation matrix. Functions are also included to facilitate the analysis of factorial experiments, including purely ‘within-Ss’ designs (repeated measures), purely ‘between-Ss’ designs, and mixed ‘within-and-between-Ss’ designs. It’s also possible to compute several effect size metrics, including “eta squared” for ANOVA, “Cohen’s d” for t-test and “Cramer’s V” for the association between categorical variables. The package contains helper functions for identifying univariate and multivariate outliers, assessing normality and homogeneity of variances. ## Key functions ### Descriptive statistics - `get_summary_stats()`: Compute summary statistics for one or multiple numeric variables. Can handle grouped data. - `freq_table()`: Compute frequency table of categorical variables. - `get_mode()`: Compute the mode of a vector, that is the most frequent values. - `identify_outliers()`: Detect univariate outliers using boxplot methods. - `mahalanobis_distance()`: Compute Mahalanobis Distance and Flag Multivariate Outliers. - `shapiro_test()` and `mshapiro_test()`: Univariate and multivariate Shapiro-Wilk normality test. ### Comparing means - `t_test()`: perform one-sample, two-sample and pairwise t-tests - `wilcox_test()`: perform one-sample, two-sample and pairwise Wilcoxon tests - `sign_test()`: perform sign test to determine whether there is a median difference between paired or matched observations. - `anova_test()`: an easy-to-use wrapper around `car::Anova()` to perform different types of ANOVA tests, including **independent measures ANOVA**, **repeated measures ANOVA** and **mixed ANOVA**. - `get_anova_test_table()`: extract ANOVA table from `anova_test()` results. Can apply sphericity correction automatically in the case of within-subject (repeated measures) designs. - `welch_anova_test()`: Welch one-Way ANOVA test. A pipe-friendly wrapper around the base function `stats::oneway.test()`. This is is an alternative to the standard one-way ANOVA in the situation where the homogeneity of variance assumption is violated. - `kruskal_test()`: perform kruskal-wallis rank sum test - `friedman_test()`: Provides a pipe-friendly framework to perform a Friedman rank sum test, which is the non-parametric alternative to the one-way repeated measures ANOVA test. - `get_comparisons()`: Create a list of possible pairwise comparisons between groups. - `get_pvalue_position()`: autocompute p-value positions for plotting significance using ggplot2. ### Facilitating ANOVA computation in R - `factorial_design()`: build factorial design for easily computing ANOVA using the `car::Anova()` function. This might be very useful for repeated measures ANOVA, which is hard to set up with the `car` package. - `anova_summary()`: Create beautiful summary tables of ANOVA test results obtained from either `car::Anova()` or `stats::aov()`. The results include ANOVA table, generalized effect size and some assumption checks, such as Mauchly’s test for sphericity in the case of repeated measures ANOVA. ### Post-hoc analyses - `tukey_hsd()`: performs tukey post-hoc tests. Can handle different inputs formats: aov, lm, formula. - `dunn_test()`: compute multiple pairwise comparisons following Kruskal-Wallis test. - `games_howell_test()`: Performs Games-Howell test, which is used to compare all possible combinations of group differences when the assumption of homogeneity of variances is violated. - `emmeans_test()`: pipe-friendly wrapper arround `emmeans` function to perform pairwise comparisons of estimated marginal means. Useful for post-hoc analyses following up ANOVA/ANCOVA tests. ### Comparing proportions - `prop_test()`, `pairwise_prop_test()` and `row_wise_prop_test()`. Performs one-sample and two-samples z-test of proportions. Wrappers around the R base function `prop.test()` but have the advantage of performing pairwise and row-wise z-test of two proportions, the post-hoc tests following a significant chi-square test of homogeneity for 2xc and rx2 contingency tables. - `fisher_test()`, `pairwise_fisher_test()` and `row_wise_fisher_test()`: Fisher’s exact test for count data. Wrappers around the R base function `fisher.test()` but have the advantage of performing pairwise and row-wise fisher tests, the post-hoc tests following a significant chi-square test of homogeneity for 2xc and rx2 contingency tables. - `chisq_test()`, `pairwise_chisq_gof_test()`, `pairwise_chisq_test_against_p()`: Performs chi-squared tests, including goodness-of-fit, homogeneity and independence tests. - `binom_test()`, `pairwise_binom_test()`, `pairwise_binom_test_against_p()`: Performs exact binomial test and pairwise comparisons following a significant exact multinomial test. Alternative to the chi-square test of goodness-of-fit-test when the sample. - `multinom_test()`: performs an exact multinomial test. Alternative to the chi-square test of goodness-of-fit-test when the sample size is small. - `mcnemar_test()`: performs McNemar chi-squared test to compare paired proportions. Provides pairwise comparisons between multiple groups. - `cochran_qtest()`: extension of the McNemar Chi-squared test for comparing more than two paired proportions. - `prop_trend_test()`: Performs chi-squared test for trend in proportion. This test is also known as Cochran-Armitage trend test. ### Comparing variances - `levene_test()`: Pipe-friendly framework to easily compute Levene’s test for homogeneity of variance across groups. Handles grouped data. - `box_m()`: Box’s M-test for homogeneity of covariance matrices ### Effect Size - `cohens_d()`: Compute cohen’s d measure of effect size for t-tests. - `wilcox_effsize()`: Compute Wilcoxon effect size (r). - `eta_squared()` and `partial_eta_squared()`: Compute effect size for ANOVA. - `kruskal_effsize()`: Compute the effect size for Kruskal-Wallis test as the eta squared based on the H-statistic. - `friedman_effsize()`: Compute the effect size of Friedman test using the Kendall’s W value. - `cramer_v()`: Compute Cramer’s V, which measures the strength of the association between categorical variables. ### Correlation analysis **Computing correlation**: - `cor_test()`: correlation test between two or more variables using Pearson, Spearman or Kendall methods. - `cor_mat()`: compute correlation matrix with p-values. Returns a data frame containing the matrix of the correlation coefficients. The output has an attribute named “pvalue”, which contains the matrix of the correlation test p-values. - `cor_get_pval()`: extract a correlation matrix p-values from an object of class `cor_mat()`. - `cor_pmat()`: compute the correlation matrix, but returns only the p-values of the correlation tests. - `as_cor_mat()`: convert a `cor_test` object into a correlation matrix format. **Reshaping correlation matrix**: - `cor_reorder()`: reorder correlation matrix, according to the coefficients, using the hierarchical clustering method. - `cor_gather()`: takes a correlation matrix and collapses (or melt) it into long format data frame (paired list) - `cor_spread()`: spread a long correlation data frame into wide format (correlation matrix). **Subsetting correlation matrix**: - `cor_select()`: subset a correlation matrix by selecting variables of interest. - `pull_triangle()`, `pull_upper_triangle()`, `pull_lower_triangle()`: pull upper and lower triangular parts of a (correlation) matrix. - `replace_triangle()`, `replace_upper_triangle()`, `replace_lower_triangle()`: replace upper and lower triangular parts of a (correlation) matrix. **Visualizing correlation matrix**: - `cor_as_symbols()`: replaces the correlation coefficients, in a matrix, by symbols according to the value. - `cor_plot()`: visualize correlation matrix using base plot. - `cor_mark_significant()`: add significance levels to a correlation matrix. ### Adjusting p-values, formatting and adding significance symbols - `adjust_pvalue()`: add an adjusted p-values column to a data frame containing statistical test p-values - `add_significance()`: add a column containing the p-value significance level - `p_round(), p_format(), p_mark_significant()`: rounding and formatting p-values ### Extract information from statistical tests Extract information from statistical test results. Useful for labelling plots with test outputs. - `get_pwc_label()`: Extract label from pairwise comparisons. - `get_test_label()`: Extract label from statistical tests. - `create_test_label()`: Create labels from user specified test results. ### Data manipulation helper functions These functions are internally used in the `rstatix` and in the `ggpubr` R package to make it easy to program with tidyverse packages using non standard evaluation. - `df_select()`, `df_arrange()`, `df_group_by()`: wrappers arround dplyr functions for supporting standard and non standard evaluations. - `df_nest_by()`: Nest a tibble data frame using grouping specification. Supports standard and non standard evaluations. - `df_split_by()`: Split a data frame by groups into subsets or data panel. Very similar to the function `df_nest_by()`. The only difference is that, it adds labels to each data subset. Labels are the combination of the grouping variable levels. - `df_unite()`: Unite multiple columns into one. - `df_unite_factors()`: Unite factor columns. First, order factors levels then merge them into one column. The output column is a factor. - `df_label_both()`, `df_label_value()`: functions to label data frames rows by by one or multiple grouping variables. - `df_get_var_names()`: Returns user specified variable names. Supports standard and non standard evaluation. ### Others - `doo()`: alternative to dplyr::do for doing anything. Technically it uses `nest(...) %>% mutate(...) %>% map(...)` to apply arbitrary computation to a grouped data frame. - `sample_n_by()`: sample n rows by group from a table - `convert_as_factor(), set_ref_level(), reorder_levels()`: Provides pipe-friendly functions to convert simultaneously multiple variables into a factor variable. - `make_clean_names()`: Pipe-friendly function to make syntactically valid column names (for input data frame) or names (for input vector). - `counts_to_cases()`: converts a contingency table or a data frame of counts into a data frame of individual observations. ## Installation and loading - Install the latest developmental version from [GitHub](https://github.com/kassambara/rstatix) as follow: ``` r if(!require(devtools)) install.packages("devtools") devtools::install_github("kassambara/rstatix") ``` - Or install from [CRAN](https://cran.r-project.org/package=ggpubr) as follow: ``` r install.packages("rstatix") ``` - Loading packages ``` r library(rstatix) library(ggpubr) # For easy data-visualization ``` ## Descriptive statistics ``` r # Summary statistics of some selected variables #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: iris %>% get_summary_stats(Sepal.Length, Sepal.Width, type = "common") #> # A tibble: 2 × 10 #> variable n min max median iqr mean sd se ci #> #> 1 Sepal.Length 150 4.3 7.9 5.8 1.3 5.84 0.828 0.068 0.134 #> 2 Sepal.Width 150 2 4.4 3 0.5 3.06 0.436 0.036 0.07 # Whole data frame #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: iris %>% get_summary_stats(type = "common") #> # A tibble: 4 × 10 #> variable n min max median iqr mean sd se ci #> #> 1 Sepal.Length 150 4.3 7.9 5.8 1.3 5.84 0.828 0.068 0.134 #> 2 Sepal.Width 150 2 4.4 3 0.5 3.06 0.436 0.036 0.07 #> 3 Petal.Length 150 1 6.9 4.35 3.5 3.76 1.76 0.144 0.285 #> 4 Petal.Width 150 0.1 2.5 1.3 1.5 1.20 0.762 0.062 0.123 # Grouped data #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: iris %>% group_by(Species) %>% get_summary_stats(Sepal.Length, type = "mean_sd") #> # A tibble: 3 × 5 #> Species variable n mean sd #> #> 1 setosa Sepal.Length 50 5.01 0.352 #> 2 versicolor Sepal.Length 50 5.94 0.516 #> 3 virginica Sepal.Length 50 6.59 0.636 ``` ## Comparing two means To compare the means of two groups, you can use either the function `t_test()` (parametric) or `wilcox_test()` (non-parametric). In the following example the t-test will be illustrated. ### Data Preparing the demo data set: ``` r df <- ToothGrowth df$dose <- as.factor(df$dose) head(df) #> len supp dose #> 1 4.2 VC 0.5 #> 2 11.5 VC 0.5 #> 3 7.3 VC 0.5 #> 4 5.8 VC 0.5 #> 5 6.4 VC 0.5 #> 6 10.0 VC 0.5 ``` ### One-sample test The one-sample test is used to compare the mean of one sample to a known standard (or theoretical / hypothetical) mean (`mu`). ``` r df %>% t_test(len ~ 1, mu = 0) #> # A tibble: 1 × 7 #> .y. group1 group2 n statistic df p #> * #> 1 len 1 null model 60 19.1 59 6.94e-27 # One-sample test of each dose level df %>% group_by(dose) %>% t_test(len ~ 1, mu = 0) #> # A tibble: 3 × 8 #> dose .y. group1 group2 n statistic df p #> * #> 1 0.5 len 1 null model 20 10.5 19 2.24e- 9 #> 2 1 len 1 null model 20 20.0 19 3.22e-14 #> 3 2 len 1 null model 20 30.9 19 1.03e-17 ``` ### Compare two independent groups - Create a simple box plot with p-values: ``` r # T-test stat.test <- df %>% t_test(len ~ supp, paired = FALSE) stat.test #> # A tibble: 1 × 8 #> .y. group1 group2 n1 n2 statistic df p #> * #> 1 len OJ VC 30 30 1.92 55.3 0.0606 # Create a box plot p <- ggboxplot( df, x = "supp", y = "len", color = "supp", palette = "jco", ylim = c(0,40) ) # Add the p-value manually p + stat_pvalue_manual(stat.test, label = "p", y.position = 35) ``` ![](tools/README-unpaired-two-sample-t-test-1.png) - Customize labels using [glue expression](https://github.com/tidyverse/glue): ``` r p +stat_pvalue_manual(stat.test, label = "T-test, p = {p}", y.position = 36) ``` ![](tools/README-custoize-p-value-labels-1.png) - Grouped data: compare supp levels after grouping the data by “dose” ``` r # Statistical test stat.test <- df %>% group_by(dose) %>% t_test(len ~ supp) %>% adjust_pvalue() %>% add_significance("p.adj") stat.test #> # A tibble: 3 × 11 #> dose .y. group1 group2 n1 n2 statistic df p p.adj #> #> 1 0.5 len OJ VC 10 10 3.17 15.0 0.00636 0.0127 #> 2 1 len OJ VC 10 10 4.03 15.4 0.00104 0.00312 #> 3 2 len OJ VC 10 10 -0.0461 14.0 0.964 0.964 #> # ℹ 1 more variable: p.adj.signif # Visualization ggboxplot( df, x = "supp", y = "len", color = "supp", palette = "jco", facet.by = "dose", ylim = c(0, 40) ) + stat_pvalue_manual(stat.test, label = "p.adj", y.position = 35) ``` ![](tools/README-grouped-two-sample-t-test-1.png) ### Compare paired samples ``` r # T-test stat.test <- df %>% t_test(len ~ supp, paired = TRUE) stat.test #> # A tibble: 1 × 8 #> .y. group1 group2 n1 n2 statistic df p #> * #> 1 len OJ VC 30 30 3.30 29 0.00255 # Box plot p <- ggpaired( df, x = "supp", y = "len", color = "supp", palette = "jco", line.color = "gray", line.size = 0.4, ylim = c(0, 40) ) p + stat_pvalue_manual(stat.test, label = "p", y.position = 36) ``` ![](tools/README-paired-t-test-1.png) ### Multiple pairwise comparisons - Pairwise comparisons: if the grouping variable contains more than two categories, a pairwise comparison is automatically performed. ``` r # Pairwise t-test pairwise.test <- df %>% t_test(len ~ dose) pairwise.test #> # A tibble: 3 × 10 #> .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif #> * #> 1 len 0.5 1 20 20 -6.48 38.0 1.27e- 7 2.54e- 7 **** #> 2 len 0.5 2 20 20 -11.8 36.9 4.40e-14 1.32e-13 **** #> 3 len 1 2 20 20 -4.90 37.1 1.91e- 5 1.91e- 5 **** # Box plot ggboxplot(df, x = "dose", y = "len")+ stat_pvalue_manual( pairwise.test, label = "p.adj", y.position = c(29, 35, 39) ) ``` ![](tools/README-pairwise-comparisons-1.png) - Multiple pairwise comparisons against reference group: each level is compared to the ref group ``` r # Comparison against reference group #:::::::::::::::::::::::::::::::::::::::: # T-test: each level is compared to the ref group stat.test <- df %>% t_test(len ~ dose, ref.group = "0.5") stat.test #> # A tibble: 2 × 10 #> .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif #> * #> 1 len 0.5 1 20 20 -6.48 38.0 1.27e- 7 1.27e- 7 **** #> 2 len 0.5 2 20 20 -11.8 36.9 4.40e-14 8.80e-14 **** # Box plot ggboxplot(df, x = "dose", y = "len", ylim = c(0, 40)) + stat_pvalue_manual( stat.test, label = "p.adj.signif", y.position = c(29, 35) ) ``` ![](tools/README-comaprison-against-reference-group-1.png) ``` r # Remove bracket ggboxplot(df, x = "dose", y = "len", ylim = c(0, 40)) + stat_pvalue_manual( stat.test, label = "p.adj.signif", y.position = c(29, 35), remove.bracket = TRUE ) ``` ![](tools/README-comaprison-against-reference-group-2.png) - Multiple pairwise comparisons against all (base-mean): Comparison of each group against base-mean. ``` r # T-test stat.test <- df %>% t_test(len ~ dose, ref.group = "all") stat.test #> # A tibble: 3 × 10 #> .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif #> * #> 1 len all 0.5 60 20 5.82 56.4 2.90e-7 8.70e-7 **** #> 2 len all 1 60 20 -0.660 57.5 5.12e-1 5.12e-1 ns #> 3 len all 2 60 20 -5.61 66.5 4.25e-7 8.70e-7 **** # Box plot with horizontal mean line ggboxplot(df, x = "dose", y = "len") + stat_pvalue_manual( stat.test, label = "p.adj.signif", y.position = 35, remove.bracket = TRUE ) + geom_hline(yintercept = mean(df$len), linetype = 2) ``` ![](tools/README-comparison-against-base-mean-1.png) ## ANOVA test ``` r # One-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: df %>% anova_test(len ~ dose) #> ANOVA Table (type II tests) #> #> Effect DFn DFd F p p<.05 ges #> 1 dose 2 57 67.416 9.53e-16 * 0.703 # Two-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: df %>% anova_test(len ~ supp*dose) #> ANOVA Table (type II tests) #> #> Effect DFn DFd F p p<.05 ges #> 1 supp 1 54 15.572 2.31e-04 * 0.224 #> 2 dose 2 54 92.000 4.05e-18 * 0.773 #> 3 supp:dose 2 54 4.107 2.20e-02 * 0.132 # Two-way repeated measures ANOVA #::::::::::::::::::::::::::::::::::::::::: df$id <- rep(1:10, 6) # Add individuals id # Use formula # df %>% anova_test(len ~ supp*dose + Error(id/(supp*dose))) # or use character vector df %>% anova_test(dv = len, wid = id, within = c(supp, dose)) #> ANOVA Table (type III tests) #> #> $ANOVA #> Effect DFn DFd F p p<.05 ges #> 1 supp 1 9 34.866 2.28e-04 * 0.224 #> 2 dose 2 18 106.470 1.06e-10 * 0.773 #> 3 supp:dose 2 18 2.534 1.07e-01 0.132 #> #> $`Mauchly's Test for Sphericity` #> Effect W p p<.05 #> 1 dose 0.807 0.425 #> 2 supp:dose 0.934 0.761 #> #> $`Sphericity Corrections` #> Effect GGe DF[GG] p[GG] p[GG]<.05 HFe DF[HF] p[HF] #> 1 dose 0.838 1.68, 15.09 2.79e-09 * 1.008 2.02, 18.15 1.06e-10 #> 2 supp:dose 0.938 1.88, 16.88 1.12e-01 1.176 2.35, 21.17 1.07e-01 #> p[HF]<.05 #> 1 * #> 2 # Use model as arguments #::::::::::::::::::::::::::::::::::::::::: .my.model <- lm(yield ~ block + N*P*K, npk) anova_test(.my.model) #> ANOVA Table (type II tests) #> #> Effect DFn DFd F p p<.05 ges #> 1 block 4 12 4.959 0.014 * 0.623 #> 2 N 1 12 12.259 0.004 * 0.505 #> 3 P 1 12 0.544 0.475 0.043 #> 4 K 1 12 6.166 0.029 * 0.339 #> 5 N:P 1 12 1.378 0.263 0.103 #> 6 N:K 1 12 2.146 0.169 0.152 #> 7 P:K 1 12 0.031 0.863 0.003 #> 8 N:P:K 0 12 NA NA NA ``` ## Correlation tests ``` r # Data preparation mydata <- mtcars %>% select(mpg, disp, hp, drat, wt, qsec) head(mydata, 3) #> mpg disp hp drat wt qsec #> Mazda RX4 21.0 160 110 3.90 2.620 16.46 #> Mazda RX4 Wag 21.0 160 110 3.90 2.875 17.02 #> Datsun 710 22.8 108 93 3.85 2.320 18.61 # Correlation test between two variables mydata %>% cor_test(wt, mpg, method = "pearson") #> # A tibble: 1 × 8 #> var1 var2 cor statistic p conf.low conf.high method #> #> 1 wt mpg -0.87 -9.56 1.29e-10 -0.934 -0.744 Pearson # Correlation of one variable against all mydata %>% cor_test(mpg, method = "pearson") #> # A tibble: 5 × 8 #> var1 var2 cor statistic p conf.low conf.high method #> #> 1 mpg disp -0.85 -8.75 9.38e-10 -0.923 -0.708 Pearson #> 2 mpg hp -0.78 -6.74 1.79e- 7 -0.885 -0.586 Pearson #> 3 mpg drat 0.68 5.10 1.78e- 5 0.436 0.832 Pearson #> 4 mpg wt -0.87 -9.56 1.29e-10 -0.934 -0.744 Pearson #> 5 mpg qsec 0.42 2.53 1.71e- 2 0.0820 0.670 Pearson # Pairwise correlation test between all variables mydata %>% cor_test(method = "pearson") #> # A tibble: 36 × 8 #> var1 var2 cor statistic p conf.low conf.high method #> #> 1 mpg mpg 1 Inf 0 1 1 Pearson #> 2 mpg disp -0.85 -8.75 9.38e-10 -0.923 -0.708 Pearson #> 3 mpg hp -0.78 -6.74 1.79e- 7 -0.885 -0.586 Pearson #> 4 mpg drat 0.68 5.10 1.78e- 5 0.436 0.832 Pearson #> 5 mpg wt -0.87 -9.56 1.29e-10 -0.934 -0.744 Pearson #> 6 mpg qsec 0.42 2.53 1.71e- 2 0.0820 0.670 Pearson #> 7 disp mpg -0.85 -8.75 9.38e-10 -0.923 -0.708 Pearson #> 8 disp disp 1 Inf 0 1 1 Pearson #> 9 disp hp 0.79 7.08 7.14e- 8 0.611 0.893 Pearson #> 10 disp drat -0.71 -5.53 5.28e- 6 -0.849 -0.481 Pearson #> # ℹ 26 more rows ``` ## Correlation matrix ``` r # Compute correlation matrix #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: cor.mat <- mydata %>% cor_mat() cor.mat #> # A tibble: 6 × 7 #> rowname mpg disp hp drat wt qsec #> * #> 1 mpg 1 -0.85 -0.78 0.68 -0.87 0.42 #> 2 disp -0.85 1 0.79 -0.71 0.89 -0.43 #> 3 hp -0.78 0.79 1 -0.45 0.66 -0.71 #> 4 drat 0.68 -0.71 -0.45 1 -0.71 0.091 #> 5 wt -0.87 0.89 0.66 -0.71 1 -0.17 #> 6 qsec 0.42 -0.43 -0.71 0.091 -0.17 1 # Show the significance levels #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: cor.mat %>% cor_get_pval() #> # A tibble: 6 × 7 #> rowname mpg disp hp drat wt qsec #> #> 1 mpg 0 9.38e-10 0.000000179 1.78e- 5 1.29e-10 0.0171 #> 2 disp 9.38e-10 0 0.0000000714 5.28e- 6 1.22e-11 0.0131 #> 3 hp 1.79e- 7 7.14e- 8 0 9.99e- 3 4.15e- 5 0.00000577 #> 4 drat 1.78e- 5 5.28e- 6 0.00999 7.44e-232 4.78e- 6 0.62 #> 5 wt 1.29e-10 1.22e-11 0.0000415 4.78e- 6 0 0.339 #> 6 qsec 1.71e- 2 1.31e- 2 0.00000577 6.2 e- 1 3.39e- 1 0 # Replacing correlation coefficients by symbols #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: cor.mat %>% cor_as_symbols() %>% pull_lower_triangle() #> rowname mpg disp hp drat wt qsec #> 1 mpg #> 2 disp * #> 3 hp * * #> 4 drat + + . #> 5 wt * * + + #> 6 qsec . . + # Mark significant correlations #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: cor.mat %>% cor_mark_significant() #> rowname mpg disp hp drat wt qsec #> 1 mpg #> 2 disp -0.85**** #> 3 hp -0.78**** 0.79**** #> 4 drat 0.68**** -0.71**** -0.45** #> 5 wt -0.87**** 0.89**** 0.66**** -0.71**** #> 6 qsec 0.42* -0.43* -0.71**** 0.091 -0.17 # Draw correlogram using R base plot #:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: cor.mat %>% cor_reorder() %>% pull_lower_triangle() %>% cor_plot() ``` ![](tools/README-unnamed-chunk-10-1.png) ## Related articles - [How to Add P-Values onto Basic GGPLOTS](https://www.datanovia.com/en/blog/how-to-add-p-values-onto-basic-ggplots/) - [How to Add Adjusted P-values to a Multi-Panel GGPlot](https://www.datanovia.com/en/blog/ggpubr-how-to-add-adjusted-p-values-to-a-multi-panel-ggplot/) - [How to Add P-values to GGPLOT Facets](https://www.datanovia.com/en/blog/how-to-add-p-values-to-ggplot-facets/) - [How to Add P-Values Generated Elsewhere to a GGPLOT](https://www.datanovia.com/en/blog/ggpubr-how-to-add-p-values-generated-elsewhere-to-a-ggplot/) - [How to Add P-Values onto a Grouped GGPLOT using the GGPUBR R Package](https://www.datanovia.com/en/blog/how-to-add-p-values-onto-a-grouped-ggplot-using-the-ggpubr-r-package/) - [How to Create Stacked Bar Plots with Error Bars and P-values](https://www.datanovia.com/en/blog/how-to-create-stacked-bar-plots-with-error-bars-and-p-values/) - [How to Add P-Values onto Horizontal GGPLOTS](https://www.datanovia.com/en/blog/how-to-add-p-values-onto-horizontal-ggplots/) - [Add P-values and Significance Levels to ggplots](https://www.sthda.com/english/articles/24-ggpubr-publication-ready-plots/76-add-p-values-and-significance-levels-to-ggplots/) - [Comparing Means of Two Groups in R](https://www.datanovia.com/en/courses/comparing-means-of-two-groups-in-r/) - [T-test in R](https://www.datanovia.com/en/lessons/t-test-in-r/) - [Wilcoxon Test in R](https://www.datanovia.com/en/lessons/wilcoxon-test-in-r/) - [Sign Test in R](https://www.datanovia.com/en/lessons/sign-test-in-r/) - [Comparing Multiple Means in R](https://www.datanovia.com/en/courses/comparing-multiple-means-in-r/) - [ANOVA in R](https://www.datanovia.com/en/lessons/anova-in-r/) - [Repeated Measures ANOVA in R](https://www.datanovia.com/en/lessons/repeated-measures-anova-in-r/) - [Mixed ANOVA in R](https://www.datanovia.com/en/lessons/mixed-anova-in-r/) - [ANCOVA in R](https://www.datanovia.com/en/lessons/ancova-in-r/) - [One-Way MANOVA in R](https://www.datanovia.com/en/lessons/one-way-manova-in-r/) - [Kruskal-Wallis Test in R](https://www.datanovia.com/en/lessons/kruskal-wallis-test-in-r/) - [Friedman Test in R](https://www.datanovia.com/en/lessons/friedman-test-in-r/) rstatix/man/0000755000176200001440000000000015074313474012533 5ustar liggesusersrstatix/man/pipe.Rd0000644000176200001440000000040515074310430013743 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils-pipe.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} \usage{ lhs \%>\% rhs } \description{ See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. } \keyword{internal} rstatix/man/prop_trend_test.Rd0000644000176200001440000000314615074310430016226 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/prop_trend_test.R \name{prop_trend_test} \alias{prop_trend_test} \title{Test for Trend in Proportions} \usage{ prop_trend_test(xtab, score = NULL) } \arguments{ \item{xtab}{a cross-tabulation (or contingency table) with two columns and multiple rows (rx2 design). The columns give the counts of successes and failures respectively.} \item{score}{group score. If \code{NULL}, the default is group number.} } \value{ return a data frame with some the following columns: \itemize{ \item \code{n}: the number of participants. \item \code{statistic}: the value of Chi-squared trend test statistic. \item \code{df}: the degrees of freedom. \item \code{p}: p-value. \item \code{method}: the used statistical test. \item \code{p.signif}: the significance level of p-values and adjusted p-values, respectively.} The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs chi-squared test for trend in proportion. This test is also known as Cochran-Armitage trend test. Wrappers around the R base function \code{\link[stats]{prop.trend.test}()} but returns a data frame for easy data visualization. } \examples{ # Proportion of renal stone (calculi) across age #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data xtab <- as.table(rbind( c(384, 536, 335), c(951, 869, 438) )) dimnames(xtab) <- list( stone = c("yes", "no"), age = c("30-39", "40-49", "50-59") ) xtab # Compare the proportion of survived between groups prop_trend_test(xtab) } rstatix/man/cor_select.Rd0000644000176200001440000000203115074310430015125 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_select.R \name{cor_select} \alias{cor_select} \title{Subset Correlation Matrix} \usage{ cor_select(x, ..., vars = NULL) } \arguments{ \item{x}{a correlation matrix. Particularly, an object of class \code{cor_mat}.} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select variables of interest.} \item{vars}{a character vector containing the variable names of interest.} } \value{ a data frame } \description{ Subset Correlation Matrix } \examples{ # Compute correlation matrix #:::::::::::::::::::::::::::::::::::::::::: cor.mat <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_mat() # Subsetting correlation matrix #:::::::::::::::::::::::::::::::::::::::::: # Select some variables of interest cor.mat \%>\% cor_select(mpg, drat, wt) # Remove variables cor.mat \%>\% cor_select(-mpg, -wt) } \seealso{ \code{\link{cor_mat}()}, \code{\link{pull_triangle}()}, \code{\link{replace_triangle}()} } rstatix/man/dunn_test.Rd0000644000176200001440000000626715074310430015025 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dunn_test.R \name{dunn_test} \alias{dunn_test} \title{Dunn's Test of Multiple Comparisons} \usage{ dunn_test(data, formula, p.adjust.method = "holm", detailed = FALSE) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y (outcome) variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n1,n2}: Sample counts. \item \code{estimate}: mean ranks difference. \item \code{estimate1, estimate2}: show the mean rank values of the two groups, respectively. \item \code{statistic}: Test statistic (z-value) used to compute the p-value. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the statistical test used to compare groups. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs Dunn's test for pairwise multiple comparisons of the ranked data. The mean rank of the different groups is compared. Used for post-hoc test following Kruskal-Wallis test. The default of the \code{rstatix::dunn_test()} function is to perform a two-sided Dunn test like the well known commercial softwares, such as SPSS and GraphPad. This is not the case for some other R packages (\code{dunn.test} and \code{jamovi}), where the default is to perform one-sided test. This discrepancy is documented at \href{https://github.com/kassambara/rstatix/issues/50}{https://github.com/kassambara/rstatix/issues/50}. } \details{ DunnTest performs the post hoc pairwise multiple comparisons procedure appropriate to follow up a Kruskal-Wallis test, which is a non-parametric analog of the one-way ANOVA. The Wilcoxon rank sum test, itself a non-parametric analog of the unpaired t-test, is possibly intuitive, but inappropriate as a post hoc pairwise test, because (1) it fails to retain the dependent ranking that produced the Kruskal-Wallis test statistic, and (2) it does not incorporate the pooled variance estimate implied by the null hypothesis of the Kruskal-Wallis test. } \examples{ # Simple test ToothGrowth \%>\% dunn_test(len ~ dose) # Grouped data ToothGrowth \%>\% group_by(supp) \%>\% dunn_test(len ~ dose) } \references{ Dunn, O. J. (1964) Multiple comparisons using rank sums Technometrics, 6(3):241-252. } rstatix/man/df_get_var_names.Rd0000644000176200001440000000140115074310430016266 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_get_var_names} \alias{df_get_var_names} \title{Get User Specified Variable Names} \usage{ df_get_var_names(data, ..., vars = NULL) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest.} \item{vars}{a character vector containing the variable names of interest.} } \value{ a character vector } \description{ Returns user specified variable names. Supports standard and non standard evaluation. } \examples{ # Non standard evaluation ToothGrowth \%>\% df_get_var_names(dose, len) # Standard evaluation ToothGrowth \%>\% df_get_var_names(vars = c("len", "dose")) } rstatix/man/multinom_test.Rd0000644000176200001440000000327715074310430015723 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/multinom_test.R \name{multinom_test} \alias{multinom_test} \title{Exact Multinomial Test} \usage{ multinom_test(x, p = rep(1/length(x), length(x)), detailed = FALSE) } \arguments{ \item{x}{numeric vector containing the counts.} \item{p}{a vector of probabilities of success. The length of p must be the same as the number of groups specified by x, and its elements must be greater than 0 and less than 1.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} } \value{ return a data frame containing the p-value and its significance. The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs an exact multinomial test. Alternative to the chi-square test of goodness-of-fit-test when the sample size is small. } \examples{ # Data tulip <- c(red = 81, yellow = 50, white = 27) # Question 1: are the color equally common ? #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # this is a test of homogeneity res <- multinom_test(tulip) res attr(res, "descriptives") # Pairwise comparisons between groups pairwise_binom_test(tulip, p.adjust.method = "bonferroni") # Question 2: comparing observed to expected proportions #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # this is a goodness-of-fit test expected.p <- c(red = 0.5, yellow = 0.33, white = 0.17) res <- multinom_test(tulip, expected.p) res attr(res, "descriptives") # Pairwise comparisons against a given probabilities pairwise_binom_test_against_p(tulip, expected.p) } \seealso{ \link{binom_test} } rstatix/man/cor_as_symbols.Rd0000644000176200001440000000217715074310430016034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_as_symbols.R \name{cor_as_symbols} \alias{cor_as_symbols} \title{Replace Correlation Coefficients by Symbols} \usage{ cor_as_symbols( x, cutpoints = c(0, 0.25, 0.5, 0.75, 1), symbols = c(" ", ".", "+", "*") ) } \arguments{ \item{x}{a correlation matrix. Particularly, an object of class \code{cor_mat}.} \item{cutpoints}{numeric vector used for intervals. Default values are \code{c(0, 0.25, 0.5, 0.75, 1)}.} \item{symbols}{character vector, one shorter than cutpoints, used as correlation coefficient symbols. Default values are \code{c(" ", ".", "+", "*")}.} } \description{ Take a correlation matrix and replace the correlation coefficients by symbols according to the level of the correlation. } \examples{ # Compute correlation matrix #:::::::::::::::::::::::::::::::::::::::::: cor.mat <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_mat() # Replace correlation coefficient by symbols #:::::::::::::::::::::::::::::::::::::::::: cor.mat \%>\% cor_as_symbols() \%>\% pull_lower_triangle() } \seealso{ \code{\link{cor_mat}()} } rstatix/man/mcnemar_test.Rd0000644000176200001440000000710515074310430015473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mcnemar_test.R \name{mcnemar_test} \alias{mcnemar_test} \alias{pairwise_mcnemar_test} \title{McNemar's Chi-squared Test for Count Data} \usage{ mcnemar_test(x, y = NULL, correct = TRUE) pairwise_mcnemar_test( data, formula, type = c("mcnemar", "exact"), correct = TRUE, p.adjust.method = "bonferroni" ) } \arguments{ \item{x}{either a two-dimensional contingency table in matrix form, or a factor object.} \item{y}{a factor object; ignored if \code{x} is a matrix.} \item{correct}{a logical indicating whether to apply continuity correction when computing the test statistic.} \item{data}{a data frame containing the variables in the formula.} \item{formula}{a formula of the form \code{a ~ b | c}, where \code{a} is the outcome variable name; b is the within-subjects factor variables; and c (factor) is the column name containing individuals/subjects identifier. Should be unique per individual.} \item{type}{type of statistical tests used for pairwise comparisons. Allowed values are one of \code{c("mcnemar", "exact")}.} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} } \value{ return a data frame with the following columns: \itemize{ \item \code{n}: the number of participants. \item \code{statistic}: the value of McNemar's statistic. \item \code{df} the degrees of freedom of the approximate chi-squared distribution of the test statistic. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the used statistical test. \item \code{p.signif}: the significance level of p-values.} The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs McNemar chi-squared test to compare paired proportions. Wrappers around the R base function \code{\link[stats]{mcnemar.test}()}, but provide pairwise comparisons between multiple groups } \section{Functions}{ \itemize{ \item \code{mcnemar_test()}: performs McNemar's chi-squared test for comparing two paired proportions \item \code{pairwise_mcnemar_test()}: performs pairwise McNemar's chi-squared test between multiple groups. Could be used for post-hoc tests following a significant Cochran's Q test. }} \examples{ # Comparing two paired proportions #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: frequencies of smokers before and after interventions xtab <- as.table( rbind(c(25, 6), c(21,10)) ) dimnames(xtab) <- list( before = c("non.smoker", "smoker"), after = c("non.smoker", "smoker") ) xtab # Compare the proportion of smokers mcnemar_test(xtab) # Comparing multiple related proportions # \%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Generate a demo data mydata <- data.frame( outcome = c(0,1,1,0,0,1,0,1,1,1,1,1,0,0,1,1,0,1,0,1,1,0,0,1,0,1,1,0,0,1), treatment = gl(3,1,30,labels=LETTERS[1:3]), participant = gl(10,3,labels=letters[1:10]) ) mydata$outcome <- factor( mydata$outcome, levels = c(1, 0), labels = c("success", "failure") ) # Cross-tabulation xtabs(~outcome + treatment, mydata) # Compare the proportion of success between treatments cochran_qtest(mydata, outcome ~ treatment|participant) # pairwise comparisons between groups pairwise_mcnemar_test(mydata, outcome ~ treatment|participant) } rstatix/man/kruskal_test.Rd0000644000176200001440000000261315074310430015524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/kruskal_test.R \name{kruskal_test} \alias{kruskal_test} \title{Kruskal-Wallis Test} \usage{ kruskal_test(data, formula, ...) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{...}{other arguments to be passed to the function \code{\link[stats]{kruskal.test}}.} } \value{ return a data frame with the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{n}: sample count. \item \code{statistic}: the kruskal-wallis rank sum statistic used to compute the p-value. \item \code{p}: p-value. \item \code{method}: the statistical test used to compare groups.} } \description{ Provides a pipe-friendly framework to perform Kruskal-Wallis rank sum test. Wrapper around the function \code{\link[stats]{kruskal.test}()}. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # Kruskal-wallis rank sum test #::::::::::::::::::::::::::::::::::::::::: df \%>\% kruskal_test(len ~ dose) # Grouped data df \%>\% group_by(supp) \%>\% kruskal_test(len ~ dose) } rstatix/man/kruskal_effsize.Rd0000644000176200001440000000512415074310430016200 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/kruskal_effesize.R \name{kruskal_effsize} \alias{kruskal_effsize} \title{Kruskal-Wallis Effect Size} \usage{ kruskal_effsize( data, formula, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000 ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{ci}{If TRUE, returns confidence intervals by bootstrap. May be slow.} \item{conf.level}{The level for the confidence interval.} \item{ci.type}{The type of confidence interval to use. Can be any of "norm", "basic", "perc", or "bca". Passed to \code{boot::boot.ci}.} \item{nboot}{The number of replications to use for bootstrap.} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{n}: Sample counts. \item \code{effsize}: estimate of the effect size. \item \code{magnitude}: magnitude of effect size. \item \code{conf.low,conf.high}: lower and upper bound of the effect size confidence interval.} } \description{ Compute the effect size for Kruskal-Wallis test as the eta squared based on the H-statistic: \code{eta2[H] = (H - k + 1)/(n - k)}; where \code{H} is the value obtained in the Kruskal-Wallis test; \code{k} is the number of groups; \code{n} is the total number of observations. The eta-squared estimate assumes values from 0 to 1 and multiplied by 100% indicates the percentage of variance in the dependent variable explained by the independent variable. The interpretation values commonly in published litterature are: \code{0.01- < 0.06} (small effect), \code{0.06 - < 0.14} (moderate effect) and \code{>= 0.14} (large effect). Confidence intervals are calculated by bootstap. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # Kruskal-wallis rank sum test #::::::::::::::::::::::::::::::::::::::::: df \%>\% kruskal_effsize(len ~ dose) # Grouped data df \%>\% group_by(supp) \%>\% kruskal_effsize(len ~ dose) } \references{ Maciej Tomczak and Ewa Tomczak. The need to report effect size estimates revisited. An overview of some recommended measures of effect size. Trends in Sport Sciences. 2014; 1(21):19-25. http://imaging.mrc-cbu.cam.ac.uk/statswiki/FAQ/effectSize http://www.psy.gla.ac.uk/~steve/best/effect.html } rstatix/man/df_arrange.Rd0000644000176200001440000000205115074310430015075 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_arrange} \alias{df_arrange} \title{Arrange Rows by Column Values} \usage{ df_arrange(data, ..., vars = NULL, .by_group = FALSE) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest. Use \code{\link[dplyr]{desc}()} to sort a variable in descending order.} \item{vars}{a character vector containing the variable names of interest.} \item{.by_group}{If TRUE, will sort first by grouping variable. Applies to grouped data frames only.} } \value{ a data frame } \description{ Order the rows of a data frame by values of specified columns. Wrapper arround the \code{\link[dplyr]{arrange}()} function. Supports standard and non standard evaluation. } \examples{ df <- head(ToothGrowth) df # Select column using standard evaluation df \%>\% df_arrange(vars = c("dose", "len")) # Select column using non-standard evaluation df \%>\% df_arrange(dose, desc(len)) } rstatix/man/adjust_pvalue.Rd0000644000176200001440000000173415074310430015662 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adjust_pvalue.R \name{adjust_pvalue} \alias{adjust_pvalue} \title{Adjust P-values for Multiple Comparisons} \usage{ adjust_pvalue(data, p.col = NULL, output.col = NULL, method = "holm") } \arguments{ \item{data}{a data frame containing a p-value column} \item{p.col}{column name containing p-values} \item{output.col}{the output column name to hold the adjusted p-values} \item{method}{method for adjusting p values (see \code{\link[stats]{p.adjust}}). Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} } \value{ a data frame } \description{ A pipe-friendly function to add an adjusted p-value column into a data frame. Supports grouped data. } \examples{ # Perform pairwise comparisons and adjust p-values ToothGrowth \%>\% t_test(len ~ dose) \%>\% adjust_pvalue() } rstatix/man/df_unite.Rd0000644000176200001440000000271415074310430014610 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_unite} \alias{df_unite} \alias{df_unite_factors} \title{Unite Multiple Columns into One} \usage{ df_unite(data, col, ..., vars = NULL, sep = "_", remove = TRUE, na.rm = FALSE) df_unite_factors( data, col, ..., vars = NULL, sep = "_", remove = TRUE, na.rm = FALSE ) } \arguments{ \item{data}{a data frame} \item{col}{the name of the new column as a string or a symbol.} \item{...}{a selection of columns. One or more unquoted expressions (or variable names) separated by commas.} \item{vars}{a character vector containing the column names of interest.} \item{sep}{Separator to use between values.} \item{remove}{If \code{TRUE}, remove input columns from output data frame.} \item{na.rm}{If \code{TRUE}, missing values will be removed prior to uniting each value.} } \description{ Paste together multiple columns into one. Wrapper arround \code{\link[tidyr]{unite}()} that supports standard and non standard evaluation. } \section{Functions}{ \itemize{ \item \code{df_unite()}: Unite multiple columns into one. \item \code{df_unite_factors()}: Unite factor columns. First, order factors levels then merge them into one column. The output column is a factor. }} \examples{ # Non standard evaluation head(ToothGrowth) \%>\% df_unite(col = "dose_supp", dose, supp) # Standard evaluation head(ToothGrowth) \%>\% df_unite(col = "dose_supp", vars = c("dose", "supp")) } rstatix/man/get_mode.Rd0000644000176200001440000000114015074310430014566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get_mode.R \name{get_mode} \alias{get_mode} \title{Compute Mode} \usage{ get_mode(x) } \arguments{ \item{x}{a vector. Can be numeric, factor or character vector.} } \description{ Compute the mode in a given vector. Mode is the most frequent value. } \examples{ # Mode of numeric vector x <- c(1:5, 6, 6, 7:10) get_mode(x) # Bimodal x <- c(1:5, 6, 6, 7, 8, 9, 9, 10) get_mode(x) # No mode x <- c(1, 2, 3, 4, 5) get_mode(x) # Nominal vector fruits <- c(rep("orange", 10), rep("apple", 5), rep("lemon", 2)) get_mode(fruits) } rstatix/man/freq_table.Rd0000644000176200001440000000131215074310430015110 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/freq_table.R \name{freq_table} \alias{freq_table} \title{Compute Frequency Table} \usage{ freq_table(data, ..., vars = NULL, na.rm = TRUE) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to specify variables of interest.} \item{vars}{optional character vector containing variable names.} \item{na.rm}{logical value. If TRUE (default), remove missing values in the variables used to create the frequency table.} } \value{ a data frame } \description{ compute frequency table. } \examples{ data("ToothGrowth") ToothGrowth \%>\% freq_table(supp, dose) } rstatix/man/mahalanobis_distance.Rd0000644000176200001440000000404615074310430017143 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mahalanobis_distance.R \name{mahalanobis_distance} \alias{mahalanobis_distance} \title{Compute Mahalanobis Distance and Flag Multivariate Outliers} \usage{ mahalanobis_distance(data, ...) } \arguments{ \item{data}{a data frame. Columns are variables.} \item{...}{One unquoted expressions (or variable name). Used to select a variable of interest. Can be also used to ignore a variable that are not needed for the computation. For example specify \code{-id} to ignore the id column.} } \value{ Returns the input data frame with two additional columns: 1) "mahal.dist": Mahalanobis distance values; and 2) "is.outlier": logical values specifying whether a given observation is a multivariate outlier } \description{ Pipe-friendly wrapper around to the function \code{\link[stats]{mahalanobis}()}, which returns the squared Mahalanobis distance of all rows in x. Compared to the base function, it automatically flags multivariate outliers. Mahalanobis distance is a common metric used to identify multivariate outliers. The larger the value of Mahalanobis distance, the more unusual the data point (i.e., the more likely it is to be a multivariate outlier). The distance tells us how far an observation is from the center of the cloud, taking into account the shape (covariance) of the cloud as well. To detect outliers, the calculated Mahalanobis distance is compared against a chi-square (X^2) distribution with degrees of freedom equal to the number of dependent (outcome) variables and an alpha level of 0.001. The threshold to declare a multivariate outlier is determined using the function \code{qchisq(0.999, df) }, where df is the degree of freedom (i.e., the number of dependent variable used in the computation). } \examples{ # Compute mahalonobis distance and flag outliers if any iris \%>\% doo(~mahalanobis_distance(.)) # Compute distance by groups and filter outliers iris \%>\% group_by(Species) \%>\% doo(~mahalanobis_distance(.)) \%>\% filter(is.outlier == TRUE) } rstatix/man/factorial_design.Rd0000644000176200001440000000541015074310430016304 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/factorial_design.R \name{factorial_design} \alias{factorial_design} \title{Build Factorial Designs for ANOVA} \usage{ factorial_design(data, dv, wid, between, within, covariate) } \arguments{ \item{data}{a data frame containing the variables} \item{dv}{(numeric) dependent variable name.} \item{wid}{(factor) column name containing individuals/subjects identifier. Should be unique per individual.} \item{between}{(optional) between-subject factor variables.} \item{within}{(optional) within-subjects factor variables} \item{covariate}{(optional) covariate names (for ANCOVA)} } \value{ a list with the following components: \itemize{ \item \strong{the specified arguments}: \code{dv, wid, between, within} \item \strong{data}: the original data (long format) or independent ANOVA. The wide format is returned for repeated measures ANOVA. \item \strong{idata}: an optional data frame giving the levels of factors defining the intra-subject model for multivariate repeated-measures data. \item \strong{idesign}: a one-sided model formula using the “data” in idata and specifying the intra-subject design. \item \strong{repeated}: logical. Value is TRUE when the data is a repeated design. \item \strong{lm_formula}: the formula used to build the \code{lm} model. \item \strong{lm_data}: the data used to build the \code{lm} model. Can be either in a long format (i.e., the original data for independent measures ANOVA) or in a wide format (case of repeated measures ANOVA). \item \strong{model}: the \code{lm} model } } \description{ Provides helper functions to build factorial design for easily computing ANOVA using the \code{\link[car]{Anova}()} function. This might be very useful for repeated measures ANOVA, which is hard to set up with the \code{car} package. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth head(df) # Repeated measures designs #::::::::::::::::::::::::::::::::::::::::: # Prepare the data df$id <- rep(1:10, 6) # Add individuals id head(df) # Build factorial designs design <- factorial_design(df, dv = len, wid = id, within = c(supp, dose)) design # Easily perform repeated measures ANOVA using the car package res.anova <- Anova(design$model, idata = design$idata, idesign = design$idesign, type = 3) summary(res.anova, multivariate = FALSE) # Independent measures designs #::::::::::::::::::::::::::::::::::::::::: # Build factorial designs df$id <- 1:nrow(df) design <- factorial_design(df, dv = len, wid = id, between = c(supp, dose)) design # Perform ANOVA Anova(design$model, type = 3) } \seealso{ \code{\link{anova_test}()}, \code{\link{anova_summary}()} } \author{ Alboukadel Kassambara, \email{alboukadel.kassambara@gmail.com} } rstatix/man/get_comparisons.Rd0000644000176200001440000000237715074310430016214 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get_comparisons.R \name{get_comparisons} \alias{get_comparisons} \title{Create a List of Possible Comparisons Between Groups} \usage{ get_comparisons(data, variable, ref.group = NULL) } \arguments{ \item{data}{a data frame} \item{variable}{the grouping variable name. Can be unquoted.} \item{ref.group}{a character string specifying the reference group. Can be unquoted. If numeric, then it should be quoted. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group). If \code{ref.group = "all"}, pairwise comparisons are performed between each grouping variable levels against all (i.e. basemean).} } \value{ a list of all possible pairwise comparisons. } \description{ Create a list of possible pairwise comparisons between groups. If a reference group is specified, only comparisons against reference will be kept. } \examples{ # All possible pairwise comparisons ToothGrowth \%>\% get_comparisons("dose") # Comparisons against reference groups ToothGrowth \%>\% get_comparisons("dose", ref.group = "0.5") # Comparisons against all (basemean) ToothGrowth \%>\% get_comparisons("dose", ref.group = "all") } rstatix/man/make_clean_names.Rd0000644000176200001440000000115315074310430016251 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/make_clean_names.R \name{make_clean_names} \alias{make_clean_names} \title{Make Clean Names} \usage{ make_clean_names(data) } \arguments{ \item{data}{a data frame or vector} } \value{ a data frame or a vector depending on the input data } \description{ Pipe-friendly function to make syntactically valid names out of character vectors. } \examples{ # Vector make_clean_names(c("a and b", "a-and-b")) make_clean_names(1:10) # data frame df <- data.frame( `a and b` = 1:4, `c and d` = 5:8, check.names = FALSE ) df make_clean_names(df) } rstatix/man/friedman_test.Rd0000644000176200001440000000317015074310430015634 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/friedman_test.R \name{friedman_test} \alias{friedman_test} \title{Friedman Rank Sum Test} \usage{ friedman_test(data, formula, ...) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{a ~ b | c}, where \code{a} (numeric) is the dependent variable name; \code{b} is the within-subjects factor variables; and \code{c} (factor) is the column name containing individuals/subjects identifier. Should be unique per individual.} \item{...}{other arguments to be passed to the function \code{\link[stats]{friedman.test}}.} } \value{ return a data frame with the following columns: \itemize{ \item \code{.y.}: the y (dependent) variable used in the test. \item \code{n}: sample count. \item \code{statistic}: the value of Friedman's chi-squared statistic, used to compute the p-value. \item \code{p}: p-value. \item \code{method}: the statistical test used to compare groups.} } \description{ Provides a pipe-friendly framework to perform a Friedman rank sum test, which is the non-parametric alternative to the one-way repeated measures ANOVA test. Wrapper around the function \code{\link[stats]{friedman.test}()}. Read more: \href{https://www.datanovia.com/en/lessons/friedman-test-in-r/}{Friedman test in R}. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth \%>\% filter(supp == "VC") \%>\% mutate(id = rep(1:10, 3)) head(df) # Friedman rank sum test #::::::::::::::::::::::::::::::::::::::::: df \%>\% friedman_test(len ~ dose | id) } rstatix/man/get_pvalue_position.Rd0000644000176200001440000001312415074310430017067 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get_pvalue_position.R \name{get_y_position} \alias{get_y_position} \alias{add_y_position} \alias{add_x_position} \alias{add_xy_position} \title{Autocompute P-value Positions For Plotting Significance} \usage{ get_y_position( data, formula, fun = "max", ref.group = NULL, comparisons = NULL, step.increase = 0.12, y.trans = NULL, stack = FALSE, scales = c("fixed", "free", "free_y") ) add_y_position( test, fun = "max", step.increase = 0.12, data = NULL, formula = NULL, ref.group = NULL, comparisons = NULL, y.trans = NULL, stack = FALSE, scales = c("fixed", "free", "free_y") ) add_x_position(test, x = NULL, group = NULL, dodge = 0.8) add_xy_position( test, x = NULL, group = NULL, dodge = 0.8, stack = FALSE, fun = "max", step.increase = 0.12, scales = c("fixed", "free", "free_y"), ... ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{fun}{summary statistics functions used to compute automatically suitable y positions of p-value labels and brackets. Possible values include: \code{"max", "mean", "mean_sd", "mean_se", "mean_ci", "median", "median_iqr", "median_mad"}. For example, if \code{fun = "max"}, the y positions are guessed as follow: \itemize{ \item 1. Compute the maximum of each group (groups.maximum) \item 2. Use the highest groups maximum as the first bracket y position \item 3. Add successively a step increase for remaining bracket y positions. } When the main plot is a boxplot, you need the option \code{fun = "max"}, to have the p-value bracket displayed at the maximum point of the group. In some situations the main plot is a line plot or a barplot showing the \code{mean+/-error bars} of the groups, where error can be SE (standard error), SD (standard deviation) or CI (confidence interval). In this case, to correctly compute the bracket y position you need the option \code{fun = "mean_se"}, etc.} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group).} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{step.increase}{numeric vector with the increase in fraction of total height for every additional comparison to minimize overlap.} \item{y.trans}{a function for transforming y axis scale. Value can be \code{log2}, \code{log10} and \code{sqrt}. Can be also any custom function that can take a numeric vector as input and returns a numeric vector, example: \code{y.trans = function(x){log2(x+1)}}} \item{stack}{logical. If TRUE, computes y position for a stacked plot. Useful when dealing with stacked bar plots.} \item{scales}{Should scales be fixed (\code{"fixed"}, the default), free (\code{"free"}), or free in one dimension (\code{"free_y"})?. This option is considered only when determining the y position. If the specified value is \code{"free"} or \code{"free_y"}, then the step increase of y positions will be calculated by plot panels. Note that, using \code{"free"} or \code{"free_y"} gives the same result. A global step increase is computed when \code{scales = "fixed"}.} \item{test}{an object of class \code{rstatix_test} as returned by \code{\link{t_test}()}, \code{\link{wilcox_test}()}, \code{\link{sign_test}()}, \code{\link{tukey_hsd}()}, \code{\link{dunn_test}()}.} \item{x}{variable on x axis.} \item{group}{group variable (legend variable).} \item{dodge}{dodge width for grouped ggplot/test. Default is 0.8. Used only when \code{x} specified.} \item{...}{other arguments to be passed to the function \code{\link[stats]{t.test}}.} } \description{ Compute p-value x and y positions for plotting significance levels. Many examples are provided at : \itemize{ \item \href{https://www.datanovia.com/en/blog/how-to-add-p-values-onto-a-grouped-ggplot-using-the-ggpubr-r-package/}{How to Add P-Values onto a Grouped GGPLOT using the GGPUBR R Package} \item \href{https://www.datanovia.com/en/blog/ggpubr-how-to-add-adjusted-p-values-to-a-multi-panel-ggplot/}{How to Add Adjusted P-values to a Multi-Panel GGPlot} \item \href{https://www.datanovia.com/en/blog/ggpubr-how-to-add-p-values-generated-elsewhere-to-a-ggplot/}{How to Add P-Values Generated Elsewhere to a GGPLOT} } } \section{Functions}{ \itemize{ \item \code{get_y_position()}: compute the p-value y positions \item \code{add_y_position()}: add p-value y positions to an object of class \code{rstatix_test} \item \code{add_x_position()}: compute and add p-value x positions. \item \code{add_xy_position()}: compute and add both x and y positions. }} \examples{ # Data preparation #:::::::::::::::::::::::::::::::::::: df <- ToothGrowth df$dose <- as.factor(df$dose) df$group <- factor(rep(c(1, 2), 30)) head(df) # Stat tests #:::::::::::::::::::::::::::::::::::: stat.test <- df \%>\% t_test(len ~ dose) stat.test # Add the test into box plots #:::::::::::::::::::::::::::::::::::: stat.test <- stat.test \%>\% add_y_position() \donttest{ if(require("ggpubr")){ ggboxplot(df, x = "dose", y = "len") + stat_pvalue_manual(stat.test, label = "p.adj.signif", tip.length = 0.01) } } } rstatix/man/df_nest_by.Rd0000644000176200001440000000163315074310430015126 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_nest_by} \alias{df_nest_by} \title{Nest a Tibble By Groups} \usage{ df_nest_by(data, ..., vars = NULL) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used as grouping variables.} \item{vars}{a character vector containing the grouping variables of interest.} } \value{ A tbl with one row per unique combination of the grouping variables. The first columns are the grouping variables, followed by a list column of tibbles with matching rows of the remaining columns. } \description{ Nest a tibble data frame using grouping specification. Supports standard and non standard evaluation. } \examples{ # Non standard evaluation ToothGrowth \%>\% df_nest_by(dose, supp) # Standard evaluation ToothGrowth \%>\% df_nest_by(vars = c("dose", "supp")) } rstatix/man/prop_test.Rd0000644000176200001440000001542015074310430015030 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/prop_test.R \name{prop_test} \alias{prop_test} \alias{pairwise_prop_test} \alias{row_wise_prop_test} \title{Proportion Test} \usage{ prop_test( x, n, p = NULL, alternative = c("two.sided", "less", "greater"), correct = TRUE, conf.level = 0.95, detailed = FALSE ) pairwise_prop_test(xtab, p.adjust.method = "holm", ...) row_wise_prop_test(xtab, p.adjust.method = "holm", detailed = FALSE, ...) } \arguments{ \item{x}{a vector of counts of successes, a one-dimensional table with two entries, or a two-dimensional table (or matrix) with 2 columns, giving the counts of successes and failures, respectively.} \item{n}{a vector of counts of trials; ignored if \code{x} is a matrix or a table.} \item{p}{a vector of probabilities of success. The length of \code{p} must be the same as the number of groups specified by \code{x}, and its elements must be greater than 0 and less than 1.} \item{alternative}{a character string specifying the alternative hypothesis, must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter. Only used for testing the null that a single proportion equals a given value, or that two proportions are equal; ignored otherwise.} \item{correct}{a logical indicating whether Yates' continuity correction should be applied where possible.} \item{conf.level}{confidence level of the returned confidence interval. Must be a single number between 0 and 1. Only used when testing the null that a single proportion equals a given value, or that two proportions are equal; ignored otherwise.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{xtab}{a cross-tabulation (or contingency table) with two columns and multiple rows (rx2 design). The columns give the counts of successes and failures respectively.} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{...}{Other arguments passed to the function \code{prop_test()}.} } \value{ return a data frame with some the following columns: \itemize{ \item \code{n}: the number of participants. \item \code{group}: the categories in the row-wise proportion tests. \item \code{statistic}: the value of Pearson's chi-squared test statistic. \item \code{df}: the degrees of freedom of the approximate chi-squared distribution of the test statistic. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the used statistical test. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: a vector with the sample proportions x/n. \item \code{estimate1, estimate2}: the proportion in each of the two populations. \item \code{alternative}: a character string describing the alternative hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a confidence interval. a confidence interval for the true proportion if there is one group, or for the difference in proportions if there are 2 groups and p is not given, or NULL otherwise. In the cases where it is not NULL, the returned confidence interval has an asymptotic confidence level as specified by conf.level, and is appropriate to the specified alternative hypothesis.} The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs proportion tests to either evaluate the homogeneity of proportions (probabilities of success) in several groups or to test that the proportions are equal to certain given values. Wrappers around the R base function \code{\link[stats]{prop.test}()} but have the advantage of performing pairwise and row-wise z-test of two proportions, the post-hoc tests following a significant chi-square test of homogeneity for 2xc and rx2 contingency tables. } \section{Functions}{ \itemize{ \item \code{prop_test()}: performs one-sample and two-samples z-test of proportions. Wrapper around the function \code{\link[stats]{prop.test}()}. \item \code{pairwise_prop_test()}: pairwise comparisons between proportions, a post-hoc tests following a significant chi-square test of homogeneity for 2xc design. Wrapper around \code{\link[stats]{pairwise.prop.test}()} \item \code{row_wise_prop_test()}: performs row-wise z-test of two proportions, a post-hoc tests following a significant chi-square test of homogeneity for rx2 contingency table. The z-test of two proportions is calculated for each category (row). }} \examples{ # Comparing an observed proportion to an expected proportion #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% prop_test(x = 95, n = 160, p = 0.5, detailed = TRUE) # Comparing two proportions #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: frequencies of smokers between two groups xtab <- as.table(rbind(c(490, 10), c(400, 100))) dimnames(xtab) <- list( group = c("grp1", "grp2"), smoker = c("yes", "no") ) xtab # compare the proportion of smokers prop_test(xtab, detailed = TRUE) # Homogeneity of proportions between groups #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # H0: the proportion of smokers is similar in the four groups # Ha: this proportion is different in at least one of the populations. # # Data preparation grp.size <- c( 106, 113, 156, 102 ) smokers <- c( 50, 100, 139, 80 ) no.smokers <- grp.size - smokers xtab <- as.table(rbind( smokers, no.smokers )) dimnames(xtab) <- list( Smokers = c("Yes", "No"), Groups = c("grp1", "grp2", "grp3", "grp4") ) xtab # Compare the proportions of smokers between groups prop_test(xtab, detailed = TRUE) # Pairwise comparison between groups pairwise_prop_test(xtab) # Pairwise proportion tests #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: Titanic xtab <- as.table(rbind( c(122, 167, 528, 673), c(203, 118, 178, 212) )) dimnames(xtab) <- list( Survived = c("No", "Yes"), Class = c("1st", "2nd", "3rd", "Crew") ) xtab # Compare the proportion of survived between groups pairwise_prop_test(xtab) # Row-wise proportion tests #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: Titanic xtab <- as.table(rbind( c(180, 145), c(179, 106), c(510, 196), c(862, 23) )) dimnames(xtab) <- list( Class = c("1st", "2nd", "3rd", "Crew"), Gender = c("Male", "Female") ) xtab # Compare the proportion of males and females in each category row_wise_prop_test(xtab) } rstatix/man/remove_ns.Rd0000644000176200001440000000232415074310430015005 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/remove_ns.R \name{remove_ns} \alias{remove_ns} \title{Remove Non-Significant from Statistical Tests} \usage{ remove_ns(stat.test, col = NULL, signif.cutoff = 0.05) } \arguments{ \item{stat.test}{statistical test results returned by \code{rstatix} functions or any data frame containing a p-value column.} \item{col}{(optional) character specifying the column containing the p-value or the significance information, to be used for the filtering step. Possible values include: \code{"p"}, \code{"p.adj"}, \code{"p.signif"}, \code{"p.adj.signif"}. If missing, the function will automatically look for p.adj.signif, p.adj, p.signif, p in this order.} \item{signif.cutoff}{the significance cutoff; default is 0.05. Significance is declared at \code{p-value <= signif.cutoff}} } \value{ a data frame } \description{ Filter out non-significant (NS) p-values from a statistical test. Can detect automatically p-value columns } \examples{ # Statistical test stat.test <- PlantGrowth \%>\% wilcox_test(weight ~ group) # Remove ns: automatic detection of p-value columns stat.test \%>\% remove_ns() # Remove ns by the column p stat.test \%>\% remove_ns(col ="p") } rstatix/man/cohens_d.Rd0000644000176200001440000001131215074310430014567 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cohens_d.R \name{cohens_d} \alias{cohens_d} \title{Compute Cohen's d Measure of Effect Size} \usage{ cohens_d( data, formula, comparisons = NULL, ref.group = NULL, paired = FALSE, mu = 0, var.equal = FALSE, hedges.correction = FALSE, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000 ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group). If \code{ref.group = "all"}, pairwise two sample tests are performed for comparing each grouping variable levels against all (i.e. basemean).} \item{paired}{a logical indicating whether you want a paired test.} \item{mu}{theoretical mean, use for one-sample t-test. Default is 0.} \item{var.equal}{a logical variable indicating whether to treat the two variances as being equal. If TRUE then the pooled variance is used to estimate the variance otherwise the Welch (or Satterthwaite) approximation to the degrees of freedom is used. Used only for unpaired or independent samples test.} \item{hedges.correction}{logical indicating whether apply the Hedges correction by multiplying the usual value of Cohen's d by \code{(N-3)/(N-2.25)} (for unpaired t-test) and by \code{(n1-2)/(n1-1.25)} for paired t-test; where \code{N} is the total size of the two groups being compared (N = n1 + n2).} \item{ci}{If TRUE, returns confidence intervals by bootstrap. May be slow.} \item{conf.level}{The level for the confidence interval.} \item{ci.type}{The type of confidence interval to use. Can be any of "norm", "basic", "perc", or "bca". Passed to \code{boot::boot.ci}.} \item{nboot}{The number of replications to use for bootstrap.} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. \item \code{effsize}: estimate of the effect size (\code{d} value). \item \code{magnitude}: magnitude of effect size. \item \code{conf.low,conf.high}: lower and upper bound of the effect size confidence interval.} } \description{ Compute the effect size for t-test. T-test conventional effect sizes, proposed by Cohen, are: 0.2 (small effect), 0.5 (moderate effect) and 0.8 (large effect). Cohen's \code{d} is calculated as the difference between means or mean minus \code{mu} divided by the estimated standardized deviation. For independent samples t-test, there are two possibilities implemented. If the t-test did not make a homogeneity of variance assumption, (the Welch test), the variance term will mirror the Welch test, otherwise a pooled estimate is used. If a paired samples t-test was requested, then effect size desired is based on the standard deviation of the differences. It can also returns confidence intervals by bootstap. } \details{ Quantification of the effect size magnitude is performed using the thresholds defined in Cohen (1992). The magnitude is assessed using the thresholds provided in (Cohen 1992), i.e. \code{|d| < 0.2} "negligible", \code{|d| < 0.5} "small", \code{|d| < 0.8} "medium", otherwise "large". } \examples{ # One-sample t test effect size ToothGrowth \%>\% cohens_d(len ~ 1, mu = 0) # Two indepedent samples t-test effect size ToothGrowth \%>\% cohens_d(len ~ supp, var.equal = TRUE) # Paired samples effect size df <- data.frame( id = 1:5, pre = c(110, 122, 101, 120, 140), post = c(150, 160, 110, 140, 155) ) df <- df \%>\% gather(key = "treatment", value = "value", -id) head(df) df \%>\% cohens_d(value ~ treatment, paired = TRUE) } \references{ \itemize{ \item Cohen, J. (1988). Statistical power analysis for the behavioral sciences (2nd ed.). New York:Academic Press. \item Cohen, J. (1992). A power primer. Psychological Bulletin, 112, 155-159. \item Hedges, Larry & Olkin, Ingram. (1985). Statistical Methods in Meta-Analysis. 10.2307/1164953. \item Navarro, Daniel. 2015. Learning Statistics with R: A Tutorial for Psychology Students and Other Beginners (Version 0.5). } } rstatix/man/cor_plot.Rd0000644000176200001440000001020015074314420014624 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_plot.R \name{cor_plot} \alias{cor_plot} \title{Visualize Correlation Matrix Using Base Plot} \usage{ cor_plot( cor.mat, method = "circle", type = "full", palette = NULL, p.mat = NULL, significant.level = 0.05, insignificant = c("cross", "blank"), label = FALSE, font.label = list(), ... ) } \arguments{ \item{cor.mat}{the correlation matrix to visualize} \item{method}{Character, the visualization method of correlation matrix to be used. Currently, it supports seven methods, named \code{'circle'} (default), \code{'square'}, \code{'ellipse'}, \code{'number'}, \code{'pie'}, \code{'shade'} and \code{'color'}. See examples for details. The areas of circles or squares show the absolute value of corresponding correlation coefficients. Method \code{'pie'} and \code{'shade'} came from Michael Friendly's job (with some adjustment about the shade added on), and \code{'ellipse'} came from D.J. Murdoch and E.D. Chow's job, see in section References.} \item{type}{Character, \code{'full'} (default), \code{'upper'} or \code{'lower'}, display full matrix, lower triangular or upper triangular matrix.} \item{palette}{character vector containing the color palette.} \item{p.mat}{matrix of p-value corresponding to the correlation matrix.} \item{significant.level}{significant level, if the p-value is bigger than \code{significant.level}, then the corresponding correlation coefficient is regarded as insignificant.} \item{insignificant}{character, specialized insignificant correlation coefficients, "cross" (default), "blank". If "blank", wipe away the corresponding glyphs; if "cross", add crosses (X) on corresponding glyphs.} \item{label}{logical value. If TRUE, shows the correlation coefficient labels.} \item{font.label}{a list with one or more of the following elements: size (e.g., 1), color (e.g., "black") and style (e.g., "bold"). Used to customize the correlation coefficient labels. For example \code{font.label = list(size = 1, color = "black", style = "bold")}.} \item{...}{additional options not listed (i.e. "tl.cex") here to pass to corrplot.} } \description{ Provide a tibble-friendly framework to visualize a correlation matrix. Wrapper around the R base function \code{\link[corrplot]{corrplot}()}. Compared to \code{\link[corrplot]{corrplot}()}, it can handle directly the output of the functions \code{\link{cor_mat}() (in rstatix)}, \code{rcorr() (in Hmisc)}, \code{correlate() (in corrr)} and \code{cor() (in stats)}. The p-values contained in the outputs of the functions \code{\link{cor_mat}()} and \code{rcorr()} are automatically detected and used in the visualization. } \examples{ # Compute correlation matrix #:::::::::::::::::::::::::::::::::::::::::: cor.mat <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_mat() # Visualize correlation matrix #:::::::::::::::::::::::::::::::::::::::::: # Full correlation matrix, # insignificant correlations are marked by crosses cor.mat \%>\% cor_plot() # Reorder by correlation coefficient # pull lower triangle and visualize cor.lower.tri <- cor.mat \%>\% cor_reorder() \%>\% pull_lower_triangle() cor.lower.tri \%>\% cor_plot() # Change visualization methods #:::::::::::::::::::::::::::::::::::::::::: cor.lower.tri \%>\% cor_plot(method = "pie") cor.lower.tri \%>\% cor_plot(method = "color") cor.lower.tri \%>\% cor_plot(method = "number") # Show the correlation coefficient: label = TRUE # Blank the insignificant correlation #:::::::::::::::::::::::::::::::::::::::::: cor.lower.tri \%>\% cor_plot( method = "color", label = TRUE, insignificant = "blank" ) # Change the color palettes #:::::::::::::::::::::::::::::::::::::::::: # Using custom color palette # Require ggpubr: install.packages("ggpubr") if(require("ggpubr")){ my.palette <- get_palette(c("red", "white", "blue"), 200) cor.lower.tri \%>\% cor_plot(palette = my.palette) } # Using RcolorBrewer color palette if(require("ggpubr")){ my.palette <- get_palette("PuOr", 200) cor.lower.tri \%>\% cor_plot(palette = my.palette) } } \seealso{ \code{\link{cor_as_symbols}()} } rstatix/man/eta_squared.Rd0000644000176200001440000000150015074310430015300 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/eta_squared.R \name{eta_squared} \alias{eta_squared} \alias{partial_eta_squared} \title{Effect Size for ANOVA} \usage{ eta_squared(model) partial_eta_squared(model) } \arguments{ \item{model}{an object of class aov or anova.} } \value{ a numeric vector with the effect size statistics } \description{ Compute eta-squared and partial eta-squared for all terms in an ANOVA model. } \section{Functions}{ \itemize{ \item \code{eta_squared()}: compute eta squared \item \code{partial_eta_squared()}: compute partial eta squared. }} \examples{ # Data preparation df <- ToothGrowth df$dose <- as.factor(df$dose) # Compute ANOVA res.aov <- aov(len ~ supp*dose, data = df) summary(res.aov) # Effect size eta_squared(res.aov) partial_eta_squared(res.aov) } rstatix/man/add_significance.Rd0000644000176200001440000000166115074310430016245 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/add_significance.R \name{add_significance} \alias{add_significance} \title{Add P-value Significance Symbols} \usage{ add_significance( data, p.col = NULL, output.col = NULL, cutpoints = c(0, 1e-04, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "ns") ) } \arguments{ \item{data}{a data frame containing a p-value column.} \item{p.col}{column name containing p-values.} \item{output.col}{the output column name to hold the adjusted p-values.} \item{cutpoints}{numeric vector used for intervals.} \item{symbols}{character vector, one shorter than cutpoints, used as significance symbols.} } \value{ a data frame } \description{ Add p-value significance symbols into a data frame. } \examples{ # Perform pairwise comparisons and adjust p-values ToothGrowth \%>\% t_test(len ~ dose) \%>\% adjust_pvalue() \%>\% add_significance("p.adj") } rstatix/man/df_split_by.Rd0000644000176200001440000000363515074310430015314 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_split_by} \alias{df_split_by} \title{Split a Data Frame into Subset} \usage{ df_split_by( data, ..., vars = NULL, label_col = "label", labeller = df_label_both, sep = c(", ", ":") ) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used as grouping variables.} \item{vars}{a character vector containing the grouping variables of interest.} \item{label_col}{column to hold the label of the data subsets. Default column name is "label".} \item{labeller}{A function that takes a data frame, the grouping variables, label_col and label_sep arguments, and add labels into the data frame. Example of possible values are: \code{\link{df_label_both}()} and \code{\link{df_label_value}()}.} \item{sep}{String separating labelling variables and values. Should be of length 2 in the function \code{df_label_both()}. 1) One sep is used to separate groups, for example ','; 2) The other sep between group name and levels; for example ':'.} } \value{ A tbl with one row per unique combination of the grouping variables. The first columns are the grouping variables, followed by a list column of tibbles with matching rows of the remaining columns, and a column named label, containing labels. } \description{ Split a data frame by groups into subsets or data panel. Very similar to the function \code{\link{df_nest_by}()}. The only difference is that, it adds label to each data subset. Labels are the combination of the grouping variable levels. The column holding labels are named "label". } \examples{ # Split a data frame # ::::::::::::::::::::::::::::::::::::::::::::::::: # Create a grouped data res <- ToothGrowth \%>\% df_split_by(dose, supp) res # Show subsets res$data # Add panel/subset labels res <- ToothGrowth \%>\% df_split_by(dose, supp) res } rstatix/man/anova_test.Rd0000644000176200001440000001744115074310430015161 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anova_test.R \name{anova_test} \alias{anova_test} \alias{get_anova_table} \alias{print.anova_test} \alias{plot.anova_test} \title{Anova Test} \usage{ anova_test( data, formula, dv, wid, between, within, covariate, type = NULL, effect.size = "ges", error = NULL, white.adjust = FALSE, observed = NULL, detailed = FALSE ) get_anova_table(x, correction = c("auto", "GG", "HF", "none")) \method{print}{anova_test}(x, ...) \method{plot}{anova_test}(x, ...) } \arguments{ \item{data}{a data.frame or a model to be analyzed.} \item{formula}{a formula specifying the ANOVA model similar to \link[stats]{aov}. Can be of the form \code{y ~ group} where \code{y} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}. Examples of supported formula include: \itemize{ \item Between-Ss ANOVA (independent measures ANOVA): \code{y ~ b1*b2} \item Within-Ss ANOVA (repeated measures ANOVA): \code{y ~ w1*w2 + Error(id/(w1*w2))} \item Mixed ANOVA: \code{y ~ b1*b2*w1 + Error(id/w1)} } If the formula doesn't contain any within vars, a linear model is directly fitted and passed to the ANOVA function. For repeated designs, the ANOVA variables are parsed from the formula.} \item{dv}{(numeric) dependent variable name.} \item{wid}{(factor) column name containing individuals/subjects identifier. Should be unique per individual.} \item{between}{(optional) between-subject factor variables.} \item{within}{(optional) within-subjects factor variables} \item{covariate}{(optional) covariate names (for ANCOVA)} \item{type}{the type of sums of squares for ANOVA. Allowed values are either 1, 2 or 3. \code{type = 2} is the default because this will yield identical ANOVA results as type = 1 when data are balanced but type = 2 will additionally yield various assumption tests where appropriate. When the data are unbalanced the \code{type = 3} is used by popular commercial softwares including SPSS.} \item{effect.size}{the effect size to compute and to show in the ANOVA results. Allowed values can be either "ges" (generalized eta squared) or "pes" (partial eta squared) or both. Default is "ges".} \item{error}{(optional) for a linear model, an lm model object from which the overall error sum of squares and degrees of freedom are to be calculated. Read more in \code{\link[car]{Anova}()} documentation.} \item{white.adjust}{Default is FALSE. If TRUE, heteroscedasticity correction is applied to the coefficient of covariance matrix. Used only for independent measures ANOVA.} \item{observed}{Variables that are observed (i.e, measured) as compared to experimentally manipulated. The default effect size reported (generalized eta-squared) requires correct specification of the observed variables.} \item{detailed}{If TRUE, returns extra information (sums of squares columns, intercept row, etc.) in the ANOVA table.} \item{x}{an object of class \code{anova_test}} \item{correction}{character. Used only in repeated measures ANOVA test to specify which correction of the degrees of freedom should be reported for the within-subject factors. Possible values are: \itemize{ \item{"GG"}: applies Greenhouse-Geisser correction to all within-subjects factors even if the assumption of sphericity is met (i.e., Mauchly's test is not significant, p > 0.05). \item{"HF"}: applies Hyunh-Feldt correction to all within-subjects factors even if the assumption of sphericity is met, \item{"none"}: returns the ANOVA table without any correction and \item{"auto"}: apply automatically GG correction to only within-subjects factors violating the sphericity assumption (i.e., Mauchly's test p-value is significant, p <= 0.05). }} \item{...}{additional arguments} } \value{ return an object of class \code{anova_test} a data frame containing the ANOVA table for independent measures ANOVA. However, for repeated/mixed measures ANOVA, a list containing the following components are returned: ANOVA table, Mauchly's Test for Sphericity, Sphericity Corrections. These table are described more in the documentation of the function \code{\link{anova_summary}()}. The \strong{returned object has an attribute} called \code{args}, which is a list holding the arguments used to fit the ANOVA model, including: data, dv, within, between, type, model, etc. } \description{ Provides a pipe-friendly framework to perform different types of ANOVA tests, including: \itemize{ \item \strong{\href{https://www.datanovia.com/en/lessons/anova-in-r/}{Independent measures ANOVA}}: between-Subjects designs, \item \strong{\href{https://www.datanovia.com/en/lessons/repeated-measures-anova-in-r/}{Repeated measures ANOVA}}: within-Subjects designs \item \strong{\href{https://www.datanovia.com/en/lessons/mixed-anova-in-r/}{Mixed ANOVA}}: Mixed within within- and between-Subjects designs, also known as split-plot ANOVA and \item \strong{\href{https://www.datanovia.com/en/lessons/ancova-in-r/}{ANCOVA: Analysis of Covariance}}. } The function is an easy to use wrapper around \code{\link[car]{Anova}()} and \code{\link[stats]{aov}()}. It makes ANOVA computation handy in R and It's highly flexible: can support model and formula as input. Variables can be also specified as character vector using the arguments \code{dv, wid, between, within, covariate}. The results include ANOVA table, generalized effect size and some assumption checks. } \details{ The setting in \code{anova_test()} is done in such a way that it gives the same results as SPSS, one of the most used commercial software. By default, R uses treatment contrasts, where each of the levels is compared to the first level used as baseline. The default contrast can be checked using \code{options('contrasts')}. In the function \code{anova_test()}, the following setting is used \code{options(contrasts=c('contr.sum','contr.poly'))}, which gives orthogonal contrasts where you compare every level to the overall mean. This setting gives the same output as the most commonly used commercial softwares, like SPSS. If you want to obtain the same result with the function \code{car::Anova()} as the one obtained with \code{rstatix::anova_test()}, then don't forget to set \code{options(contrasts=c('contr.sum','contr.poly'))}. } \section{Functions}{ \itemize{ \item \code{anova_test()}: perform anova test \item \code{get_anova_table()}: extract anova table from an object of class \code{anova_test}. When within-subject factors are present, either sphericity corrected or uncorrected degrees of freedom can be reported. }} \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # One-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: df \%>\% anova_test(len ~ dose) # Grouped One-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: df \%>\% group_by(supp) \%>\% anova_test(len ~ dose) # Two-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: df \%>\% anova_test(len ~ supp*dose) # Two-way repeated measures ANOVA #::::::::::::::::::::::::::::::::::::::::: df$id <- rep(1:10, 6) # Add individuals id # Use formula \donttest{ df \%>\% anova_test(len ~ supp*dose + Error(id/(supp*dose))) } # or use character vector df \%>\% anova_test(dv = len, wid = id, within = c(supp, dose)) # Extract ANOVA table and apply correction #::::::::::::::::::::::::::::::::::::::::: res.aov <- df \%>\% anova_test(dv = len, wid = id, within = c(supp, dose)) get_anova_table(res.aov, correction = "GG") # Use model as arguments #::::::::::::::::::::::::::::::::::::::::: .my.model <- lm(yield ~ block + N*P*K, npk) anova_test(.my.model) } \seealso{ \code{\link{anova_summary}()}, \code{\link{factorial_design}()} } \author{ Alboukadel Kassambara, \email{alboukadel.kassambara@gmail.com} } rstatix/man/friedman_effsize.Rd0000644000176200001440000000506015074310430016310 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/friedman_effsize.R \name{friedman_effsize} \alias{friedman_effsize} \title{Friedman Test Effect Size (Kendall's W Value)} \usage{ friedman_effsize( data, formula, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ... ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{a ~ b | c}, where \code{a} (numeric) is the dependent variable name; \code{b} is the within-subjects factor variables; and \code{c} (factor) is the column name containing individuals/subjects identifier. Should be unique per individual.} \item{ci}{If TRUE, returns confidence intervals by bootstrap. May be slow.} \item{conf.level}{The level for the confidence interval.} \item{ci.type}{The type of confidence interval to use. Can be any of "norm", "basic", "perc", or "bca". Passed to \code{boot::boot.ci}.} \item{nboot}{The number of replications to use for bootstrap.} \item{...}{other arguments passed to the function \code{\link[stats]{friedman.test}()}} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{n}: Sample counts. \item \code{effsize}: estimate of the effect size. \item \code{magnitude}: magnitude of effect size. \item \code{conf.low,conf.high}: lower and upper bound of the effect size confidence interval.} } \description{ Compute the effect size estimate (referred to as \code{w}) for Friedman test: \code{W = X2/N(K-1)}; where \code{W} is the Kendall's W value; \code{X2} is the Friedman test statistic value; \code{N} is the sample size. \code{k} is the number of measurements per subject. The Kendall’s W coefficient assumes the value from 0 (indicating no relationship) to 1 (indicating a perfect relationship). Kendalls uses the Cohen’s interpretation guidelines of \code{0.1 - < 0.3} (small effect), \code{0.3 - < 0.5} (moderate effect) and \code{>= 0.5} (large effect) Confidence intervals are calculated by bootstap. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth \%>\% filter(supp == "VC") \%>\% mutate(id = rep(1:10, 3)) head(df) # Friedman test effect size #::::::::::::::::::::::::::::::::::::::::: df \%>\% friedman_effsize(len ~ dose | id) } \references{ Maciej Tomczak and Ewa Tomczak. The need to report effect size estimates revisited. An overview of some recommended measures of effect size. Trends in Sport Sciences. 2014; 1(21):19-25. } rstatix/man/p_value.Rd0000644000176200001440000000731015074310430014443 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/p_value.R \name{p_round} \alias{p_round} \alias{p_format} \alias{p_mark_significant} \alias{p_detect} \alias{p_names} \alias{p_adj_names} \title{Rounding and Formatting p-values} \usage{ p_round(x, ..., digits = 3) p_format( x, ..., new.col = FALSE, digits = 2, accuracy = 1e-04, decimal.mark = ".", leading.zero = TRUE, trailing.zero = FALSE, add.p = FALSE, space = FALSE ) p_mark_significant( x, ..., new.col = FALSE, cutpoints = c(0, 1e-04, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "") ) p_detect(data, type = c("all", "p", "p.adj")) p_names() p_adj_names() } \arguments{ \item{x}{a numeric vector of p-values or a data frame containing a p value column. If data frame, the p-value column(s) will be automatically detected. Known p-value column names can be obtained using the functions \code{p_names()} and \code{p_adj_names()}} \item{...}{column names to manipulate in the case where \code{x} is a data frame. P value columns are automatically detected if not specified.} \item{digits}{the number of significant digits to be used.} \item{new.col}{logical, used only when \code{x} is a data frame. If TRUE, add a new column to hold the results. The new column name is created by adding, to the p column, the suffix "format" (for \code{p_format()}), "signif" (for \code{p_mak_significant()}).} \item{accuracy}{number to round to, that is the threshold value above wich the function will replace the pvalue by "<0.0xxx".} \item{decimal.mark}{the character to be used to indicate the numeric decimal point.} \item{leading.zero}{logical. If FALSE, remove the leading zero.} \item{trailing.zero}{logical. If FALSE (default), remove the training extra zero.} \item{add.p}{logical value. If TRUE, add "p=" before the value.} \item{space}{logical. If TRUE (default) use space as separator between different elements and symbols.} \item{cutpoints}{numeric vector used for intervals} \item{symbols}{character vector, one shorter than cutpoints, used as significance symbols.} \item{data}{a data frame} \item{type}{the type of p-value to detect. Can be one of \code{c("all", "p", "p.adj")}.} } \value{ a vector or a data frame containing the rounded/formatted p-values. } \description{ Round and format p-values. Can also mark significant p-values with stars. } \section{Functions}{ \itemize{ \item \code{p_round()}: round p-values \item \code{p_format()}: format p-values. Add a symbol "<" for small p-values. \item \code{p_mark_significant()}: mark p-values with significance levels \item \code{p_detect()}: detects and returns p-value column names in a data frame. \item \code{p_names()}: returns known p-value column names \item \code{p_adj_names()}: returns known adjust p-value column names }} \examples{ # Round and format a vector of p-values # :::::::::::::::::::::::::::::::::::::::::::: # Format p <- c(0.5678, 0.127, 0.045, 0.011, 0.009, 0.00002, NA) p_format(p) # Specify the accuracy p_format(p, accuracy = 0.01) # Add p and remove the leading zero p_format(p, add.p = TRUE, leading.zero = FALSE) # Remove space before and after "=" or "<". p_format(p, add.p = TRUE, leading.zero = FALSE, space = FALSE) # Mark significant p-values # :::::::::::::::::::::::::::::::::::::::::::: p_mark_significant(p) # Round, the mark significant p \%>\% p_round(digits = 2) \%>\% p_mark_significant() # Format, then mark significant p \%>\% p_format(digits = 2) \%>\% p_mark_significant() # Perform stat test, format p and mark significant # :::::::::::::::::::::::::::::::::::::::::::: ToothGrowth \%>\% group_by(dose) \%>\% t_test(len ~ supp) \%>\% p_format(digits = 2, leading.zero = FALSE) \%>\% p_mark_significant() } rstatix/man/cor_test.Rd0000644000176200001440000001073515074310430014637 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_test.R \name{cor_test} \alias{cor_test} \title{Correlation Test} \usage{ cor_test( data, ..., vars = NULL, vars2 = NULL, alternative = "two.sided", method = "pearson", conf.level = 0.95, use = "pairwise.complete.obs" ) } \arguments{ \item{data}{a data.frame containing the variables.} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest. Alternative to the argument \code{vars}.} \item{vars}{optional character vector containing variable names for correlation analysis. Ignored when dot vars are specified. \itemize{ \item If \code{vars} is NULL, multiple pairwise correlation tests is performed between all variables in the data. \item If \code{vars} contain only one variable, a pairwise correlation analysis is performed between the specified variable vs either all the remaining numeric variables in the data or variables in \code{vars2} (if specified). \item If \code{vars} contain two or more variables: i) if \code{vars2} is not specified, a pairwise correlation analysis is performed between all possible combinations of variables. ii) if \code{vars2} is specified, each element in \code{vars} is tested against all elements in \code{vars2}}. Accept unquoted variable names: \code{c(var1, var2)}.} \item{vars2}{optional character vector. If specified, each element in \code{vars} is tested against all elements in \code{vars2}. Accept unquoted variable names: \code{c(var1, var2)}.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"two.sided"}, \code{"greater"} or \code{"less"}. You can specify just the initial letter. \code{"greater"} corresponds to positive association, \code{"less"} to negative association.} \item{method}{a character string indicating which correlation coefficient is to be used for the test. One of \code{"pearson"}, \code{"kendall"}, or \code{"spearman"}, can be abbreviated.} \item{conf.level}{confidence level for the returned confidence interval. Currently only used for the Pearson product moment correlation coefficient if there are at least 4 complete pairs of observations.} \item{use}{an optional character string giving a method for computing covariances in the presence of missing values. This must be (an abbreviation of) one of the strings \code{"everything"}, \code{"all.obs"}, \code{"complete.obs"}, \code{"na.or.complete"}, or \code{"pairwise.complete.obs"}.} } \value{ return a data frame with the following columns: \itemize{ \item \code{var1, var2}: the variables used in the correlation test. \item \code{cor}: the correlation coefficient. \item \code{statistic}: Test statistic used to compute the p-value. \item \code{p}: p-value. \item \code{conf.low,conf.high}: Lower and upper bounds on a confidence interval. \item \code{method}: the method used to compute the statistic.} } \description{ Provides a pipe-friendly framework to perform correlation test between paired samples, using Pearson, Kendall or Spearman method. Wrapper around the function \code{\link[stats]{cor.test}()}. Can also performs multiple pairwise correlation analyses between more than two variables or between two different vectors of variables. Using this function, you can also compute, for example, the correlation between one variable vs many. } \section{Functions}{ \itemize{ \item \code{cor_test()}: correlation test between two or more variables. }} \examples{ # Correlation between the specified variable vs # the remaining numeric variables in the data #::::::::::::::::::::::::::::::::::::::::: mtcars \%>\% cor_test(mpg) # Correlation test between two variables #::::::::::::::::::::::::::::::::::::::::: mtcars \%>\% cor_test(wt, mpg) # Pairwise correlation between multiple variables #::::::::::::::::::::::::::::::::::::::::: mtcars \%>\% cor_test(wt, mpg, disp) # Grouped data #::::::::::::::::::::::::::::::::::::::::: iris \%>\% group_by(Species) \%>\% cor_test(Sepal.Width, Sepal.Length) # Multiple correlation test #::::::::::::::::::::::::::::::::::::::::: # Correlation between one variable vs many mtcars \%>\% cor_test( vars = "mpg", vars2 = c("disp", "hp", "drat") ) # Correlation between two vectors of variables # Each element in vars is tested against all elements in vars2 mtcars \%>\% cor_test( vars = c("mpg", "wt"), vars2 = c("disp", "hp", "drat") ) } \seealso{ \code{\link{cor_mat}()}, \code{\link{as_cor_mat}()} } rstatix/man/df_group_by.Rd0000644000176200001440000000137415074310430015313 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_group_by} \alias{df_group_by} \title{Group a Data Frame by One or more Variables} \usage{ df_group_by(data, ..., vars = NULL) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest.} \item{vars}{a character vector containing the variable names of interest.} } \description{ Group a data frame by one or more variables. Supports standard and non standard evaluation. } \examples{ # Non standard evaluation by_dose <- head(ToothGrowth) \%>\% df_group_by(dose) by_dose # Standard evaluation head(ToothGrowth) \%>\% df_group_by(vars = c("dose", "supp")) } rstatix/man/get_summary_stats.Rd0000644000176200001440000000500615074310430016562 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get_summary_stats.R \name{get_summary_stats} \alias{get_summary_stats} \title{Compute Summary Statistics} \usage{ get_summary_stats( data, ..., type = c("full", "common", "robust", "five_number", "mean_sd", "mean_se", "mean_ci", "median_iqr", "median_mad", "quantile", "mean", "median", "min", "max"), show = NULL, probs = seq(0, 1, 0.25) ) } \arguments{ \item{data}{a data frame} \item{...}{(optional) One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest. If no variable is specified, then the summary statistics of all numeric variables in the data frame is computed.} \item{type}{type of summary statistics. Possible values include: \code{"full", "common", "robust", "five_number", "mean_sd", "mean_se", "mean_ci", "median_iqr", "median_mad", "quantile", "mean", "median", "min", "max"}} \item{show}{a character vector specifying the summary statistics you want to show. Example: \code{show = c("n", "mean", "sd")}. This is used to filter the output after computation.} \item{probs}{numeric vector of probabilities with values in [0,1]. Used only when type = "quantile".} } \value{ A data frame containing descriptive statistics, such as: \itemize{ \item \strong{n}: the number of individuals \item \strong{min}: minimum \item \strong{max}: maximum \item \strong{median}: median \item \strong{mean}: mean \item \strong{q1, q3}: the first and the third quartile, respectively. \item \strong{iqr}: interquartile range \item \strong{mad}: median absolute deviation (see ?MAD) \item \strong{sd}: standard deviation of the mean \item \strong{se}: standard error of the mean \item \strong{ci}: 95 percent confidence interval of the mean } } \description{ Compute summary statistics for one or multiple numeric variables. } \examples{ # Full summary statistics data("ToothGrowth") ToothGrowth \%>\% get_summary_stats(len) # Summary statistics of grouped data # Show only common summary ToothGrowth \%>\% group_by(dose, supp) \%>\% get_summary_stats(len, type = "common") # Robust summary statistics ToothGrowth \%>\% get_summary_stats(len, type = "robust") # Five number summary statistics ToothGrowth \%>\% get_summary_stats(len, type = "five_number") # Compute only mean and sd ToothGrowth \%>\% get_summary_stats(len, type = "mean_sd") # Compute full summary statistics but show only mean, sd, median, iqr ToothGrowth \%>\% get_summary_stats(len, show = c("mean", "sd", "median", "iqr")) } rstatix/man/df_label_value.Rd0000644000176200001440000000312515074310430015734 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_label_both} \alias{df_label_both} \alias{df_label_value} \title{Functions to Label Data Frames by Grouping Variables} \usage{ df_label_both(data, ..., vars = NULL, label_col = "label", sep = c(", ", ":")) df_label_value(data, ..., vars = NULL, label_col = "label", sep = ", ") } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used as grouping variables.} \item{vars}{a character vector containing the grouping variables of interest.} \item{label_col}{column to hold the label of the data subsets. Default column name is "label".} \item{sep}{String separating labelling variables and values. Should be of length 2 in the function \code{df_label_both()}. 1) One sep is used to separate groups, for example ','; 2) The other sep between group name and levels; for example ':'.} } \value{ a modified data frame with a column containing row labels. } \description{ Functions to label data frame rows by one or multiple grouping variables. } \section{Functions}{ \itemize{ \item \code{df_label_both()}: Displays both the variable name and the factor value. \item \code{df_label_value()}: Displays only the value of a factor. }} \examples{ # Data preparation df <- head(ToothGrowth) # Labelling: Non standard evaluation df \%>\% df_label_both(dose, supp) # Standard evaluation df \%>\% df_label_both(dose, supp) # Nesting the data then label each subset by groups ToothGrowth \%>\% df_nest_by(dose, supp) \%>\% df_label_both(supp, dose) } rstatix/man/cor_reshape.Rd0000644000176200001440000000357515074310430015313 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_reshape.R \name{cor_gather} \alias{cor_gather} \alias{cor_spread} \title{Reshape Correlation Data} \usage{ cor_gather(data, drop.na = TRUE) cor_spread(data, value = "cor") } \arguments{ \item{data}{a data frame or matrix.} \item{drop.na}{logical. If TRUE, drop rows containing missing values after gathering the data.} \item{value}{column name containing the value to spread.} } \description{ Reshape correlation analysis results. Key functions: \itemize{ \item \code{cor_gather()}: takes a correlation matrix and collapses (i.e. melt) it into a paired list (long format). \item \code{cor_spread()}: spread a long correlation data format across multiple columns. Particularly, it takes the results of \code{\link{cor_test}} and transforms it into a correlation matrix. } } \section{Functions}{ \itemize{ \item \code{cor_gather()}: takes a correlation matrix and collapses (or melt) it into long format data frame (paired list) \item \code{cor_spread()}: spread a long correlation data frame into wide format. Expects the columns "var1", "var2" and "cor" in the data. (correlation matrix). }} \examples{ # Data preparation #:::::::::::::::::::::::::::::::::::::::::: mydata <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) head(mydata, 3) # Reshape a correlation matrix #:::::::::::::::::::::::::::::::::::::::::: # Compute a correlation matrix cor.mat <- mydata \%>\% cor_mat() cor.mat # Collapse the correlation matrix into long format # paired list data frame long.format <- cor.mat \%>\% cor_gather() long.format # Spread a correlation data format #:::::::::::::::::::::::::::::::::::::::::: # Spread the correlation coefficient value long.format \%>\% cor_spread(value = "cor") # Spread the p-value long.format \%>\% cor_spread(value = "p") } \seealso{ \code{\link{cor_mat}()}, \code{\link{cor_reorder}()} } rstatix/man/reexports.Rd0000644000176200001440000000166315074310430015050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reexports.R \docType{import} \name{reexports} \alias{reexports} \alias{tibble} \alias{mutate} \alias{filter} \alias{group_by} \alias{select} \alias{desc} \alias{drop_na} \alias{gather} \alias{spread} \alias{tidy} \alias{augment} \alias{Anova} \title{Objects exported from other packages} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{car}{\code{\link[car]{Anova}}} \item{dplyr}{\code{\link[dplyr]{desc}}, \code{\link[dplyr]{filter}}, \code{\link[dplyr]{group_by}}, \code{\link[dplyr]{mutate}}, \code{\link[dplyr]{select}}} \item{generics}{\code{\link[generics]{augment}}, \code{\link[generics]{tidy}}} \item{tibble}{\code{\link[tibble]{tibble}}} \item{tidyr}{\code{\link[tidyr]{drop_na}}, \code{\link[tidyr]{gather}}, \code{\link[tidyr]{spread}}} }} rstatix/man/cor_mat.Rd0000644000176200001440000000645015074310430014440 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_mat.R \name{cor_mat} \alias{cor_mat} \alias{cor_pmat} \alias{cor_get_pval} \title{Compute Correlation Matrix with P-values} \usage{ cor_mat( data, ..., vars = NULL, method = "pearson", alternative = "two.sided", conf.level = 0.95 ) cor_pmat( data, ..., vars = NULL, method = "pearson", alternative = "two.sided", conf.level = 0.95 ) cor_get_pval(x) } \arguments{ \item{data}{a data.frame containing the variables.} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest.} \item{vars}{a character vector containing the variable names of interest.} \item{method}{a character string indicating which correlation coefficient is to be used for the test. One of \code{"pearson"}, \code{"kendall"}, or \code{"spearman"}, can be abbreviated.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"two.sided"}, \code{"greater"} or \code{"less"}. You can specify just the initial letter. \code{"greater"} corresponds to positive association, \code{"less"} to negative association.} \item{conf.level}{confidence level for the returned confidence interval. Currently only used for the Pearson product moment correlation coefficient if there are at least 4 complete pairs of observations.} \item{x}{an object of class \code{cor_mat}} } \value{ a data frame } \description{ Compute correlation matrix with p-values. Numeric columns in the data are detected and automatically selected for the analysis. You can also specify variables of interest to be used in the correlation analysis. } \section{Functions}{ \itemize{ \item \code{cor_mat()}: compute correlation matrix with p-values. Returns a data frame containing the matrix of the correlation coefficients. The output has an attribute named "pvalue", which contains the matrix of the correlation test p-values. \item \code{cor_pmat()}: compute the correlation matrix but returns only the p-values of the tests. \item \code{cor_get_pval()}: extract a correlation matrix p-values from an object of class \code{cor_mat()}. P-values are not adjusted. }} \examples{ # Data preparation #::::::::::::::::::::::::::::::::::::::::::: mydata <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) head(mydata, 3) # Compute correlation matrix #:::::::::::::::::::::::::::::::::::::::::: # Correlation matrix between all variables cor.mat <- mydata \%>\% cor_mat() cor.mat # Specify some variables of interest mydata \%>\% cor_mat(mpg, hp, wt) # Or remove some variables in the data # before the analysis mydata \%>\% cor_mat(-mpg, -hp) # Significance levels #:::::::::::::::::::::::::::::::::::::::::: cor.mat \%>\% cor_get_pval() # Visualize #:::::::::::::::::::::::::::::::::::::::::: # Insignificant correlations are marked by crosses cor.mat \%>\% cor_reorder() \%>\% pull_lower_triangle() \%>\% cor_plot(label = TRUE) # Gather/collapse correlation matrix into long format #:::::::::::::::::::::::::::::::::::::::::: cor.mat \%>\% cor_gather() } \seealso{ \code{\link{cor_test}()}, \code{\link{cor_reorder}()}, \code{\link{cor_gather}()}, \code{\link{cor_select}()}, \code{\link{cor_as_symbols}()}, \code{\link{pull_triangle}()}, \code{\link{replace_triangle}()} } rstatix/man/shapiro_test.Rd0000644000176200001440000000306515074310430015517 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/shapiro_test.R \name{shapiro_test} \alias{shapiro_test} \alias{mshapiro_test} \title{Shapiro-Wilk Normality Test} \usage{ shapiro_test(data, ..., vars = NULL) mshapiro_test(data) } \arguments{ \item{data}{a data frame. Columns are variables.} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest.} \item{vars}{optional character vector containing variable names. Ignored when dot vars are specified.} } \value{ a data frame containing the value of the Shapiro-Wilk statistic and the corresponding p.value. } \description{ Provides a pipe-friendly framework to performs Shapiro-Wilk test of normality. Support grouped data and multiple variables for multivariate normality tests. Wrapper around the R base function \code{\link[stats]{shapiro.test}()}. Can handle grouped data. Read more: \href{https://www.datanovia.com/en/lessons/normality-test-in-r/}{Normality Test in R}. } \section{Functions}{ \itemize{ \item \code{shapiro_test()}: univariate Shapiro-Wilk normality test \item \code{mshapiro_test()}: multivariate Shapiro-Wilk normality test. This is a modified copy of the \code{mshapiro.test()} function of the package mvnormtest, for internal convenience. }} \examples{ # Shapiro Wilk normality test for one variable iris \%>\% shapiro_test(Sepal.Length) # Shapiro Wilk normality test for two variables iris \%>\% shapiro_test(Sepal.Length, Petal.Width) # Multivariate normality test mshapiro_test(iris[, 1:3]) } rstatix/man/replace_triangle.Rd0000644000176200001440000000370315074310430016312 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/replace_triangle.R \name{replace_triangle} \alias{replace_triangle} \alias{replace_upper_triangle} \alias{replace_lower_triangle} \title{Replace Lower and Upper Triangular Part of a Matrix} \usage{ replace_triangle(x, triangle = c("lower", "upper"), by = "", diagonal = FALSE) replace_upper_triangle(x, by = "", diagonal = FALSE) replace_lower_triangle(x, by = "", diagonal = FALSE) } \arguments{ \item{x}{a (correlation) matrix} \item{triangle}{the triangle to replace. Allowed values are one of "upper" and "lower".} \item{by}{a replacement argument. Appropriate values are either "" or NA. Used to replace the upper, lower or the diagonal part of the matrix.} \item{diagonal}{logical. Default is FALSE. If TRUE, the matrix diagonal is included.} } \value{ an object of class \code{cor_mat_tri}, which is a data frame } \description{ Replace the lower or the upper triangular part of a (correlation) matrix. } \section{Functions}{ \itemize{ \item \code{replace_triangle()}: replaces the specified triangle by empty or NA. \item \code{replace_upper_triangle()}: replaces the upper triangular part of a matrix. Returns an object of class \code{lower_tri}. \item \code{replace_lower_triangle()}: replaces the lower triangular part of a matrix. Returns an object of class \code{lower_tri} }} \examples{ # Compute correlation matrix and pull triangles #:::::::::::::::::::::::::::::::::::::::::: # Correlation matrix cor.mat <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_mat() cor.mat # Replace upper triangle by NA #:::::::::::::::::::::::::::::::::::::::::: cor.mat \%>\% replace_upper_triangle(by = NA) # Replace upper triangle by NA and reshape the # correlation matrix to have unique combinations of variables #:::::::::::::::::::::::::::::::::::::::::: cor.mat \%>\% replace_upper_triangle(by = NA) \%>\% cor_gather() } \seealso{ \code{\link{pull_triangle}()} } rstatix/man/outliers.Rd0000644000176200001440000000513415074310430014660 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/outliers.R \name{identify_outliers} \alias{identify_outliers} \alias{is_outlier} \alias{is_extreme} \title{Identify Univariate Outliers Using Boxplot Methods} \usage{ identify_outliers(data, ..., variable = NULL) is_outlier(x, coef = 1.5) is_extreme(x) } \arguments{ \item{data}{a data frame} \item{...}{One unquoted expressions (or variable name). Used to select a variable of interest. Alternative to the argument \code{variable}.} \item{variable}{variable name for detecting outliers} \item{x}{a numeric vector} \item{coef}{coefficient specifying how far the outlier should be from the edge of their box. Possible values are 1.5 (for outlier) and 3 (for extreme points only). Default is 1.5} } \value{ \itemize{ \item \code{identify_outliers()}. Returns the input data frame with two additional columns: "is.outlier" and "is.extreme", which hold logical values. \item \code{is_outlier() and is_extreme()}. Returns logical vectors. } } \description{ Detect outliers using boxplot methods. Boxplots are a popular and an easy method for identifying outliers. There are two categories of outlier: (1) outliers and (2) extreme points. Values above \code{Q3 + 1.5xIQR} or below \code{Q1 - 1.5xIQR} are considered as outliers. Values above \code{Q3 + 3xIQR} or below \code{Q1 - 3xIQR} are considered as extreme points (or extreme outliers). Q1 and Q3 are the first and third quartile, respectively. IQR is the interquartile range (IQR = Q3 - Q1). Generally speaking, data points that are labelled outliers in boxplots are not considered as troublesome as those considered extreme points and might even be ignored. Note that, any \code{NA} and \code{NaN} are automatically removed before the quantiles are computed. } \section{Functions}{ \itemize{ \item \code{identify_outliers()}: takes a data frame and extract rows suspected as outliers according to a numeric column. The following columns are added "is.outlier" and "is.extreme". \item \code{is_outlier()}: detect outliers in a numeric vector. Returns logical vector. \item \code{is_extreme()}: detect extreme points in a numeric vector. An alias of \code{is_outlier()}, where coef = 3. Returns logical vector. }} \examples{ # Generate a demo data set.seed(123) demo.data <- data.frame( sample = 1:20, score = c(rnorm(19, mean = 5, sd = 2), 50), gender = rep(c("Male", "Female"), each = 10) ) # Identify outliers according to the variable score demo.data \%>\% identify_outliers(score) # Identify outliers by groups demo.data \%>\% group_by(gender) \%>\% identify_outliers("score") } rstatix/man/anova_summary.Rd0000644000176200001440000001116715074310430015676 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anova_summary.R \name{anova_summary} \alias{anova_summary} \title{Create Nice Summary Tables of ANOVA Results} \usage{ anova_summary(object, effect.size = "ges", detailed = FALSE, observed = NULL) } \arguments{ \item{object}{an object of returned by either \code{\link[car]{Anova}()}, or \code{\link[stats]{aov}()}.} \item{effect.size}{the effect size to compute and to show in the ANOVA results. Allowed values can be either "ges" (generalized eta squared) or "pes" (partial eta squared) or both. Default is "ges".} \item{detailed}{If TRUE, returns extra information (sums of squares columns, intercept row, etc.) in the ANOVA table.} \item{observed}{Variables that are observed (i.e, measured) as compared to experimentally manipulated. The default effect size reported (generalized eta-squared) requires correct specification of the observed variables.} } \value{ return an object of class \code{anova_test} a data frame containing the ANOVA table for independent measures ANOVA. However, for repeated/mixed measures ANOVA, it is a list containing the following components are returned: \itemize{ \item \strong{ANOVA}: a data frame containing ANOVA results \item \strong{Mauchly's Test for Sphericity}: If any within-Ss variables with more than 2 levels are present, a data frame containing the results of Mauchly's test for Sphericity. Only reported for effects that have more than 2 levels because sphericity necessarily holds for effects with only 2 levels. \item \strong{Sphericity Corrections}: If any within-Ss variables are present, a data frame containing the Greenhouse-Geisser and Huynh-Feldt epsilon values, and corresponding corrected p-values. } The \strong{returned object might have an attribute} called \code{args} if you compute ANOVA using the function \code{\link{anova_test}()}. The attribute \code{args} is a list holding the arguments used to fit the ANOVA model, including: data, dv, within, between, type, model, etc. The following abbreviations are used in the different results tables: \itemize{ \item DFn Degrees of Freedom in the numerator (i.e. DF effect). \item DFd Degrees of Freedom in the denominator (i.e., DF error). \item SSn Sum of Squares in the numerator (i.e., SS effect). \item SSd Sum of Squares in the denominator (i.e.,SS error). \item F F-value. \item p p-value (probability of the data given the null hypothesis). \item p<.05 Highlights p-values less than the traditional alpha level of .05. \item ges Generalized Eta-Squared measure of effect size. \item GGe Greenhouse-Geisser epsilon. \item p[GGe] p-value after correction using Greenhouse-Geisser epsilon. \item p[GGe]<.05 Highlights p-values (after correction using Greenhouse-Geisser epsilon) less than the traditional alpha level of .05. \item HFe Huynh-Feldt epsilon. \item p[HFe] p-value after correction using Huynh-Feldt epsilon. \item p[HFe]<.05 Highlights p-values (after correction using Huynh-Feldt epsilon) less than the traditional alpha level of .05. \item W Mauchly's W statistic } } \description{ Create beautiful summary tables of ANOVA test results obtained from either \code{\link[car]{Anova}()} or \code{\link[stats]{aov}()}. The results include ANOVA table, generalized effect size and some assumption checks. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth df$dose <- as.factor(df$dose) # Independent measures ANOVA #::::::::::::::::::::::::::::::::::::::::: # Compute ANOVA and display the summary res.anova <- Anova(lm(len ~ dose*supp, data = df)) anova_summary(res.anova) # Display both SSn and SSd using detailed = TRUE # Show generalized eta squared using effect.size = "ges" anova_summary(res.anova, detailed = TRUE, effect.size = "ges") # Show partial eta squared using effect.size = "pes" anova_summary(res.anova, detailed = TRUE, effect.size = "pes") # Repeated measures designs using car::Anova() #::::::::::::::::::::::::::::::::::::::::: # Prepare the data df$id <- as.factor(rep(1:10, 6)) # Add individuals ids head(df) # Easily perform repeated measures ANOVA using the car package design <- factorial_design(df, dv = len, wid = id, within = c(supp, dose)) res.anova <- Anova(design$model, idata = design$idata, idesign = design$idesign, type = 3) anova_summary(res.anova) # Repeated measures designs using stats::Aov() #::::::::::::::::::::::::::::::::::::::::: res.anova <- aov(len ~ dose*supp + Error(id/(supp*dose)), data = df) anova_summary(res.anova) } \seealso{ \code{\link{anova_test}()}, \code{\link{factorial_design}()} } \author{ Alboukadel Kassambara, \email{alboukadel.kassambara@gmail.com} } rstatix/man/cor_mark_significant.Rd0000644000176200001440000000160615074310430017165 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_mark_significant.R \name{cor_mark_significant} \alias{cor_mark_significant} \title{Add Significance Levels To a Correlation Matrix} \usage{ cor_mark_significant( x, cutpoints = c(0, 1e-04, 0.001, 0.01, 0.05, 1), symbols = c("****", "***", "**", "*", "") ) } \arguments{ \item{x}{an object of class \code{\link{cor_mat}()}.} \item{cutpoints}{numeric vector used for intervals.} \item{symbols}{character vector, one shorter than cutpoints, used as significance symbols.} } \value{ a data frame containing the lower triangular part of the correlation matrix marked by significance symbols. } \description{ Combines correlation coefficients and significance levels in a correlation matrix data. } \examples{ mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_mat() \%>\% cor_mark_significant() } rstatix/man/sample_n_by.Rd0000644000176200001440000000107015074310430015275 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sample_n_by.R \name{sample_n_by} \alias{sample_n_by} \title{Sample n Rows By Group From a Table} \usage{ sample_n_by(data, ..., size = 1, replace = FALSE) } \arguments{ \item{data}{a data frame} \item{...}{Variables to group by} \item{size}{the number of rows to select} \item{replace}{with or without replacement?} } \description{ sample n rows by group from a table using the \code{\link[dplyr]{sample_n}()} function. } \examples{ ToothGrowth \%>\% sample_n_by(dose, supp, size = 2) } rstatix/man/counts_to_cases.Rd0000644000176200001440000000173715074310430016212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/counts_to_cases.R \name{counts_to_cases} \alias{counts_to_cases} \title{Convert a Table of Counts into a Data Frame of cases} \usage{ counts_to_cases(x, count.col = "Freq") } \arguments{ \item{x}{a contingency table or a data frame} \item{count.col}{the name of the column containing the counts. Default is "Freq".} } \value{ a data frame of cases } \description{ converts a contingency table or a data frame of counts into a data frame of individual observations. } \examples{ # Create a cross-tabulation demo data #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% xtab <- as.table( rbind(c(20, 5), c(16,9)) ) dimnames(xtab) <- list( before = c("non.smoker", "smoker"), after = c("non.smoker", "smoker") ) xtab # Convert into a data frame of cases #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% df <- counts_to_cases(xtab) head(df) } rstatix/man/sign_test.Rd0000644000176200001440000001073615074310430015015 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sign_test.R \name{sign_test} \alias{sign_test} \alias{pairwise_sign_test} \title{Sign Test} \usage{ sign_test( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", alternative = "two.sided", mu = 0, conf.level = 0.95, detailed = FALSE ) pairwise_sign_test( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", detailed = FALSE, ... ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ treatment}.} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group).} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{alternative}{a character string specifying the alternative hypothesis, must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter.} \item{mu}{a single number representing the value of the population median specified by the null hypothesis.} \item{conf.level}{confidence level of the interval.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{...}{other arguments passed to the function \code{sign_test()}} } \value{ return a data frame with some the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. \item \code{statistic}: Test statistic used to compute the p-value. That is the S-statistic (the number of positive differences between the data and the hypothesized median), with names attribute \code{"S"}. \item \code{df, parameter}: degrees of freedom. Here, the total number of valid differences. \item \code{p}: p-value. \item \code{method}: the statistical test used to compare groups. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: estimate of the effect size. It corresponds to the median of the differences. \item \code{alternative}: a character string describing the alternative hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a confidence interval of the estimate. } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs one-sample and two-sample sign tests. Read more: \href{https://www.datanovia.com/en/lessons/sign-test-in-r/}{Sign Test in R}. } \section{Functions}{ \itemize{ \item \code{sign_test()}: Sign test \item \code{pairwise_sign_test()}: performs pairwise two sample Wilcoxon test. }} \note{ This function is a reimplementation of the function \code{SignTest()} from the \code{DescTools} package. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # One-sample test #::::::::::::::::::::::::::::::::::::::::: df \%>\% sign_test(len ~ 1, mu = 0) # Two-samples paired test #::::::::::::::::::::::::::::::::::::::::: df \%>\% sign_test(len ~ supp) # Compare supp levels after grouping the data by "dose" #:::::::::::::::::::::::::::::::::::::::: df \%>\% group_by(dose) \%>\% sign_test(data =., len ~ supp) \%>\% adjust_pvalue(method = "bonferroni") \%>\% add_significance("p.adj") # pairwise comparisons #:::::::::::::::::::::::::::::::::::::::: # As dose contains more than two levels ==> # pairwise test is automatically performed. df \%>\% sign_test(len ~ dose) # Comparison against reference group #:::::::::::::::::::::::::::::::::::::::: # each level is compared to the ref group df \%>\% sign_test(len ~ dose, ref.group = "0.5") } rstatix/man/Manova.Rd0000644000176200001440000000037415074310430014234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils-manova.R \name{Manova} \alias{Manova} \title{Manova exported from car package} \description{ See \code{car::\link[car:Anova]{Manova}} for details. } \keyword{internal} rstatix/man/pull_triangle.Rd0000644000176200001440000000326315074310430015654 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pull_triangle.R \name{pull_triangle} \alias{pull_triangle} \alias{pull_upper_triangle} \alias{pull_lower_triangle} \title{Pull Lower and Upper Triangular Part of a Matrix} \usage{ pull_triangle(x, triangle = c("lower", "upper"), diagonal = FALSE) pull_upper_triangle(x, diagonal = FALSE) pull_lower_triangle(x, diagonal = FALSE) } \arguments{ \item{x}{a (correlation) matrix} \item{triangle}{the triangle to pull. Allowed values are one of "upper" and "lower".} \item{diagonal}{logical. Default is FALSE. If TRUE, the matrix diagonal is included.} } \value{ an object of class \code{cor_mat_tri}, which is a data frame } \description{ Returns the lower or the upper triangular part of a (correlation) matrix. } \section{Functions}{ \itemize{ \item \code{pull_triangle()}: returns either the lower or upper triangular part of a matrix. \item \code{pull_upper_triangle()}: returns an object of class \code{upper_tri}, which is a data frame containing the upper triangular part of a matrix. \item \code{pull_lower_triangle()}: returns an object of class \code{lower_tri}, which is a data frame containing the lower triangular part of a matrix. }} \examples{ # Data preparation #:::::::::::::::::::::::::::::::::::::::::: mydata <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) head(mydata, 3) # Compute correlation matrix and pull triangles #:::::::::::::::::::::::::::::::::::::::::: # Correlation matrix cor.mat <- cor_mat(mydata) cor.mat # Pull lower triangular part cor.mat \%>\% pull_lower_triangle() # Pull upper triangular part cor.mat \%>\% pull_upper_triangle() } \seealso{ \code{\link{replace_triangle}()} } rstatix/man/cramer_v.Rd0000644000176200001440000000230015074310430014600 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cramer_v.R \name{cramer_v} \alias{cramer_v} \title{Compute Cramer's V} \usage{ cramer_v(x, y = NULL, correct = TRUE, ...) } \arguments{ \item{x}{a numeric vector or matrix. \code{x} and \code{y} can also both be factors.} \item{y}{a numeric vector; ignored if \code{x} is a matrix. If \code{x} is a factor, \code{y} should be a factor of the same length.} \item{correct}{a logical indicating whether to apply continuity correction when computing the test statistic for 2 by 2 tables: one half is subtracted from all \eqn{|O - E|} differences; however, the correction will not be bigger than the differences themselves. No correction is done if \code{simulate.p.value = TRUE}.} \item{...}{other arguments passed to the function \code{\link[stats]{chisq.test}()}.} } \description{ Compute Cramer's V, which measures the strength of the association between categorical variables. } \examples{ # Data preparation df <- as.table(rbind(c(762, 327, 468), c(484, 239, 477))) dimnames(df) <- list( gender = c("F", "M"), party = c("Democrat","Independent", "Republican") ) df # Compute cramer's V cramer_v(df) } rstatix/man/fisher_test.Rd0000644000176200001440000001443415074314420015337 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fisher_test.R \name{fisher_test} \alias{fisher_test} \alias{pairwise_fisher_test} \alias{row_wise_fisher_test} \title{Fisher's Exact Test for Count Data} \usage{ fisher_test( xtab, workspace = 2e+05, alternative = "two.sided", conf.int = TRUE, conf.level = 0.95, simulate.p.value = FALSE, B = 2000, detailed = FALSE, ... ) pairwise_fisher_test(xtab, p.adjust.method = "holm", detailed = FALSE, ...) row_wise_fisher_test(xtab, p.adjust.method = "holm", detailed = FALSE, ...) } \arguments{ \item{xtab}{a contingency table in a matrix form.} \item{workspace}{an integer specifying the size of the workspace used in the network algorithm. In units of 4 bytes. Only used for non-simulated p-values larger than \eqn{2 \times 2}{2 by 2} tables. This also increases the internal stack size which allows larger problems to be solved, sometimes needing hours. In such cases, \code{simulate.p.values = TRUE} may be more reasonable.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"two.sided"}, \code{"greater"} or \code{"less"}. You can specify just the initial letter. Only used in the \eqn{2 \times 2}{2 by 2} case.} \item{conf.int}{logical indicating if a confidence interval for the odds ratio in a \eqn{2 \times 2}{2 by 2} table should be computed (and returned).} \item{conf.level}{confidence level for the returned confidence interval. Only used in the \eqn{2 \times 2}{2 by 2} case and if \code{conf.int = TRUE}.} \item{simulate.p.value}{a logical indicating whether to compute p-values by Monte Carlo simulation, in larger than \eqn{2 \times 2}{2 by 2} tables.} \item{B}{an integer specifying the number of replicates used in the Monte Carlo test when \code{simulate.p.value} is true.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{...}{Other arguments passed to the function \code{fisher_test()}.} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} } \value{ return a data frame with some the following columns: \itemize{ \item \code{group}: the categories in the row-wise proportion tests. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the used statistical test. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: an estimate of the odds ratio. Only present in the 2 by 2 case. \item \code{alternative}: a character string describing the alternative hypothesis. \item \code{conf.low,conf.high}: a confidence interval for the odds ratio. Only present in the 2 by 2 case and if argument conf.int = TRUE.} The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs Fisher's exact test for testing the null of independence of rows and columns in a contingency table. Wrappers around the R base function \code{\link[stats]{fisher.test}()} but have the advantage of performing pairwise and row-wise fisher tests, the post-hoc tests following a significant chi-square test of homogeneity for 2xc and rx2 contingency tables. } \section{Functions}{ \itemize{ \item \code{fisher_test()}: performs Fisher's exact test for testing the null of independence of rows and columns in a contingency table with fixed marginals. Wrapper around the function \code{\link[stats]{fisher.test}()}. \item \code{pairwise_fisher_test()}: pairwise comparisons between proportions, a post-hoc tests following a significant Fisher's exact test of homogeneity for 2xc design. \item \code{row_wise_fisher_test()}: performs row-wise Fisher's exact test of count data, a post-hoc tests following a significant chi-square test of homogeneity for rx2 contingency table. The test is conducted for each category (row). }} \examples{ # Comparing two proportions #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: frequencies of smokers between two groups xtab <- as.table(rbind(c(490, 10), c(400, 100))) dimnames(xtab) <- list( group = c("grp1", "grp2"), smoker = c("yes", "no") ) xtab # compare the proportion of smokers fisher_test(xtab, detailed = TRUE) # Homogeneity of proportions between groups #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # H0: the proportion of smokers is similar in the four groups # Ha: this proportion is different in at least one of the populations. # # Data preparation grp.size <- c( 106, 113, 156, 102 ) smokers <- c( 50, 100, 139, 80 ) no.smokers <- grp.size - smokers xtab <- as.table(rbind( smokers, no.smokers )) dimnames(xtab) <- list( Smokers = c("Yes", "No"), Groups = c("grp1", "grp2", "grp3", "grp4") ) xtab # Compare the proportions of smokers between groups fisher_test(xtab, detailed = TRUE) # Pairwise comparison between groups pairwise_fisher_test(xtab) # Pairwise proportion tests #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: Titanic xtab <- as.table(rbind( c(122, 167, 528, 673), c(203, 118, 178, 212) )) dimnames(xtab) <- list( Survived = c("No", "Yes"), Class = c("1st", "2nd", "3rd", "Crew") ) xtab # Compare the proportion of survived between groups pairwise_fisher_test(xtab) # Row-wise proportion tests #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: Titanic xtab <- as.table(rbind( c(180, 145), c(179, 106), c(510, 196), c(862, 23) )) dimnames(xtab) <- list( Class = c("1st", "2nd", "3rd", "Crew"), Gender = c("Male", "Female") ) xtab # Compare the proportion of males and females in each category row_wise_fisher_test(xtab) # A r x c table Agresti (2002, p. 57) Job Satisfaction Job <- matrix(c(1,2,1,0, 3,3,6,1, 10,10,14,9, 6,7,12,11), 4, 4, dimnames = list(income = c("< 15k", "15-25k", "25-40k", "> 40k"), satisfaction = c("VeryD", "LittleD", "ModerateS", "VeryS"))) fisher_test(Job) fisher_test(Job, simulate.p.value = TRUE, B = 1e5) } rstatix/man/doo.Rd0000644000176200001440000000370415074310430013574 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/doo.R \name{doo} \alias{doo} \title{Alternative to dplyr::do for Doing Anything} \usage{ doo(data, .f, ..., result = ".results.") } \arguments{ \item{data}{a (grouped) data frame} \item{.f}{A function, formula, or atomic vector. For example \code{~t.test(len ~ supp, data = .)}.} \item{...}{Additional arguments passed on to .f} \item{result}{the column name to hold the results. Default is ".results.".} } \value{ a data frame } \description{ Provides a flexible alternative to the \code{dplyr:do()} function. Technically it uses \code{nest() + mutate() + map()} to apply arbitrary computation to a grouped data frame. The output is a data frame. If the applied function returns a data frame, then the output will be automatically unnested. Otherwise, the output includes the grouping variables and a column named ".results." (by default), which is a "list-columns" containing the results for group combinations. } \examples{ # Custom function #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% stat_test <- function(data, formula){ t.test(formula, data) \%>\% tidy() } # Example 1: pipe-friendly stat_test(). # Two possibilities of usage are available #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Use this ToothGrowth \%>\% group_by(dose) \%>\% doo(~stat_test(data =., len ~ supp)) # Or this ToothGrowth \%>\% group_by(dose) \%>\% doo(stat_test, len ~ supp) # Example 2: R base function t.test() (not pipe friendly) # One possibility of usage #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% comparisons <- ToothGrowth \%>\% group_by(dose) \%>\% doo(~t.test(len ~ supp, data =.)) comparisons comparisons$.results. # Example 3: R base function combined with tidy() #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% ToothGrowth \%>\% group_by(dose) \%>\% doo(~t.test(len ~ supp, data =.) \%>\% tidy()) } rstatix/man/cochran_qtest.Rd0000644000176200001440000000267615074310430015657 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cochran_qtest.R \name{cochran_qtest} \alias{cochran_qtest} \title{Cochran's Q Test} \usage{ cochran_qtest(data, formula) } \arguments{ \item{data}{a data frame containing the variables in the formula.} \item{formula}{a formula of the form \code{a ~ b | c}, where \code{a} is the outcome variable name; b is the within-subjects factor variables; and c (factor) is the column name containing individuals/subjects identifier. Should be unique per individual.} } \description{ Performs the Cochran's Q test for unreplicated randomized block design experiments with a binary response variable and paired data. This test is analogue to the \code{\link{friedman.test}()} with 0,1 coded response. It's an extension of the McNemar Chi-squared test for comparing more than two paired proportions. } \examples{ # Generate a demo data mydata <- data.frame( outcome = c(0,1,1,0,0,1,0,1,1,1,1,1,0,0,1,1,0,1,0,1,1,0,0,1,0,1,1,0,0,1), treatment = gl(3,1,30,labels=LETTERS[1:3]), participant = gl(10,3,labels=letters[1:10]) ) mydata$outcome <- factor( mydata$outcome, levels = c(1, 0), labels = c("success", "failure") ) # Cross-tabulation xtabs(~outcome + treatment, mydata) # Compare the proportion of success between treatments cochran_qtest(mydata, outcome ~ treatment|participant) # pairwise comparisons between groups pairwise_mcnemar_test(mydata, outcome ~ treatment|participant) } rstatix/man/games_howell_test.Rd0000644000176200001440000000617115074310430016521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/games_howell_test.R \name{games_howell_test} \alias{games_howell_test} \title{Games Howell Post-hoc Tests} \usage{ games_howell_test(data, formula, conf.level = 0.95, detailed = FALSE) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{conf.level}{confidence level of the interval.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y (outcome) variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n1,n2}: Sample counts. \item \code{estimate, conf.low, conf.high}: mean difference and its confidence intervals. \item \code{statistic}: Test statistic (t-value) used to compute the p-value. \item \code{df}: degrees of freedom calculated using Welch’s correction. \item \code{p.adj}: adjusted p-value using Tukey's method. \item \code{method}: the statistical test used to compare groups. \item \code{p.adj.signif}: the significance level of p-values. } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs Games-Howell test, which is used to compare all possible combinations of group differences when the assumption of homogeneity of variances is violated. This post hoc test provides confidence intervals for the differences between group means and shows whether the differences are statistically significant. The test is based on Welch’s degrees of freedom correction and uses Tukey’s studentized range distribution for computing the p-values. The test compares the difference between each pair of means with appropriate adjustment for the multiple testing. So there is no need to apply additional p-value corrections. } \details{ The Games-Howell method is an improved version of the Tukey-Kramer method and is applicable in cases where the equivalence of variance assumption is violated. It is a t-test using Welch’s degree of freedom. This method uses a strategy for controlling the type I error for the entire comparison and is known to maintain the preset significance level even when the size of the sample is different. However, the smaller the number of samples in each group, the it is more tolerant the type I error control. Thus, this method can be applied when the number of samples is six or more. } \examples{ # Simple test ToothGrowth \%>\% games_howell_test(len ~ dose) # Grouped data ToothGrowth \%>\% group_by(supp) \%>\% games_howell_test(len ~ dose) } \references{ \itemize{ \item Aaron Schlege, https://rpubs.com/aaronsc32/games-howell-test. \item Sangseok Lee, Dong Kyu Lee. What is the proper way to apply the multiple comparison test?. Korean J Anesthesiol. 2018;71(5):353-360. } } rstatix/man/levene_test.Rd0000644000176200001440000000202315074310430015321 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/levene_test.R \name{levene_test} \alias{levene_test} \title{Levene's Test} \usage{ levene_test(data, formula, center = median) } \arguments{ \item{data}{a data frame for evaluating the formula or a model} \item{formula}{a formula} \item{center}{The name of a function to compute the center of each group; mean gives the original Levene's test; the default, median, provides a more robust test.} } \value{ a data frame with the following columns: df1, df2 (df.residual), statistic and p. } \description{ Provide a pipe-friendly framework to easily compute Levene's test for homogeneity of variance across groups. Wrapper around the function \code{\link[car]{leveneTest}()}, which can additionally handles a grouped data. } \examples{ # Prepare the data data("ToothGrowth") df <- ToothGrowth df$dose <- as.factor(df$dose) # Compute Levene's Test df \%>\% levene_test(len ~ dose) # Grouped data df \%>\% group_by(supp) \%>\% levene_test(len ~ dose) } rstatix/man/df_select.Rd0000644000176200001440000000155415074310430014744 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/df.R \name{df_select} \alias{df_select} \title{Select Columns in a Data Frame} \usage{ df_select(data, ..., vars = NULL) } \arguments{ \item{data}{a data frame} \item{...}{One or more unquoted expressions (or variable names) separated by commas. Used to select a variable of interest.} \item{vars}{a character vector containing the variable names of interest.} } \value{ a data frame } \description{ A wrapper around the \code{\link[dplyr]{select}()} function for selection data frame columns. Supports standard and non standard evaluations. Usefull to easily program with \code{dplyr} } \examples{ df <- head(ToothGrowth) df # Select column using standard evaluation df \%>\% df_select(vars = c("dose", "len")) # Select column using non-standard evaluation df \%>\% df_select(dose, len) } rstatix/man/as_cor_mat.Rd0000644000176200001440000000177715074310430015132 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/as_cor_mat.R \name{as_cor_mat} \alias{as_cor_mat} \title{Convert a Correlation Test Data Frame into a Correlation Matrix} \usage{ as_cor_mat(x) } \arguments{ \item{x}{an object of class \code{cor_test}.} } \value{ Returns a data frame containing the matrix of the correlation coefficients. The output has an attribute named "pvalue", which contains the matrix of the correlation test p-values. } \description{ Convert a correlation test data frame, returned by the \code{\link{cor_test}()}, into a correlation matrix format. } \examples{ # Pairwise correlation tests between variables #::::::::::::::::::::::::::::::::::::::::::::::: res.cor.test <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_test() res.cor.test # Convert the correlation test into a correlation matrix #::::::::::::::::::::::::::::::::::::::::::::::: res.cor.test \%>\% as_cor_mat() } \seealso{ \code{\link{cor_mat}()}, \code{\link{cor_test}()} } rstatix/man/binom_test.Rd0000644000176200001440000001045015074310430015152 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/binom_test.R \name{binom_test} \alias{binom_test} \alias{pairwise_binom_test} \alias{pairwise_binom_test_against_p} \title{Exact Binomial Test} \usage{ binom_test( x, n, p = 0.5, alternative = "two.sided", conf.level = 0.95, detailed = FALSE ) pairwise_binom_test( x, p.adjust.method = "holm", alternative = "two.sided", conf.level = 0.95 ) pairwise_binom_test_against_p( x, p = rep(1/length(x), length(x)), p.adjust.method = "holm", alternative = "two.sided", conf.level = 0.95 ) } \arguments{ \item{x}{numeric vector containing the counts.} \item{n}{number of trials; ignored if \code{x} has length 2.} \item{p}{a vector of probabilities of success. The length of p must be the same as the number of groups specified by x, and its elements must be greater than 0 and less than 1.} \item{alternative}{indicates the alternative hypothesis and must be one of \code{"two.sided"}, \code{"greater"} or \code{"less"}. You can specify just the initial letter.} \item{conf.level}{confidence level for the returned confidence interval.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} } \value{ return a data frame containing the p-value and its significance. with some the following columns: \itemize{ \item \code{group, group1, group2}: the categories or groups being compared. \item \code{statistic}: the number of successes. \item \code{parameter}: the number of trials. \item \code{p}: p-value of the test. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the used statistical test. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: the estimated probability of success. \item \code{alternative}: a character string describing the alternative hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a confidence interval for the probability of success.} The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs exact binomial test and pairwise comparisons following a significant exact multinomial test. Wrapper around the R base function \code{link[stats]{binom.test}()} that returns a data frame as a result. } \section{Functions}{ \itemize{ \item \code{binom_test()}: performs exact binomial test. Wrapper around the R base function \code{\link[stats]{binom.test}} that returns a dataframe as a result. \item \code{pairwise_binom_test()}: performs pairwise comparisons (binomial test) following a significant exact multinomial test. \item \code{pairwise_binom_test_against_p()}: performs pairwise comparisons (binomial test) following a significant exact multinomial test for given probabilities. }} \examples{ # Exact binomial test #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: 160 mice with cancer including 95 male and 65 female # Q1: Does cancer affect more males than females? binom_test(x = 95, n = 160) # => yes, there are a significant difference # Q2: compare the observed proportion of males # to an expected proportion (p = 3/5) binom_test(x = 95, n = 160, p = 3/5) # => there are no significant difference # Multinomial test #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data tulip <- c(red = 81, yellow = 50, white = 27) # Question 1: are the color equally common ? # this is a test of homogeneity res <- multinom_test(tulip) res attr(res, "descriptives") # Pairwise comparisons between groups pairwise_binom_test(tulip, p.adjust.method = "bonferroni") # Question 2: comparing observed to expected proportions # this is a goodness-of-fit test expected.p <- c(red = 0.5, yellow = 0.33, white = 0.17) res <- multinom_test(tulip, expected.p) res attr(res, "descriptives") # Pairwise comparisons against a given probabilities pairwise_binom_test_against_p(tulip, expected.p) } \seealso{ \link{multinom_test} } rstatix/man/factors.Rd0000644000176200001440000000376515074310430014463 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/factors.R \name{convert_as_factor} \alias{convert_as_factor} \alias{set_ref_level} \alias{reorder_levels} \title{Factors} \usage{ convert_as_factor(data, ..., vars = NULL, make.valid.levels = FALSE) set_ref_level(data, name, ref) reorder_levels(data, name, order) } \arguments{ \item{data}{a data frame} \item{...}{one unquoted expressions (or variable name) specifying the name of the variables you want to convert into factor. Alternative to the argument \code{vars}.} \item{vars}{a character vector specifying the variables to convert into factor.} \item{make.valid.levels}{logical. Default is FALSE. If TRUE, converts the variable to factor and add a leading character (x) if starting with a digit.} \item{name}{a factor variable name. Can be unquoted. For example, use \code{group} or \code{"group"}.} \item{ref}{the reference level.} \item{order}{a character vector specifying the order of the factor levels} } \description{ Provides pipe-friendly functions to convert simultaneously multiple variables into a factor variable. Helper functions are also available to set the reference level and the levels order. } \section{Functions}{ \itemize{ \item \code{convert_as_factor()}: Convert one or multiple variables into factor. \item \code{set_ref_level()}: Change a factor reference level or group. \item \code{reorder_levels()}: Change the order of a factor levels }} \examples{ # Create a demo data df <- tibble( group = c("a", "a", "b", "b", "c", "c"), time = c("t1", "t2", "t1", "t2", "t1", "t2"), value = c(5, 6, 1, 3, 4, 5) ) df # Convert group and time into factor variable result <- df \%>\% convert_as_factor(group, time) result # Show group levels levels(result$group) # Set c as the reference level (the first one) result <- result \%>\% set_ref_level("group", ref = "c") levels(result$group) # Set the order of levels result <- result \%>\% reorder_levels("group", order = c("b", "c", "a")) levels(result$group) } rstatix/man/wilcox_test.Rd0000644000176200001440000001500115074314756015367 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wilcox_test.R \name{wilcox_test} \alias{wilcox_test} \alias{pairwise_wilcox_test} \title{Wilcoxon Tests} \usage{ wilcox_test( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", paired = FALSE, exact = NULL, alternative = "two.sided", mu = 0, conf.level = 0.95, detailed = FALSE ) pairwise_wilcox_test( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", detailed = FALSE, ... ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group). If \code{ref.group = "all"}, pairwise two sample tests are performed for comparing each grouping variable levels against all (i.e. basemean).} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{paired}{a logical indicating whether you want a paired test.} \item{exact}{a logical indicating whether an exact p-value should be computed.} \item{alternative}{a character string specifying the alternative hypothesis, must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter.} \item{mu}{a number specifying an optional parameter used to form the null hypothesis.} \item{conf.level}{confidence level of the interval.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{...}{other arguments to be passed to the function \code{\link[stats]{wilcox.test}}.} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. \item \code{statistic}: Test statistic used to compute the p-value. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the statistical test used to compare groups. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: an estimate of the location parameter (Only present if argument \code{detailed = TRUE}). This corresponds to the pseudomedian (for one-sample case) or to the difference of the location parameter (for two-samples case). \itemize{ \item The pseudomedian of a distribution \code{F} is the median of the distribution of \code{(u+v)/2}, where \code{u} and \code{v} are independent, each with distribution \code{F}. If \code{F} is symmetric, then the pseudomedian and median coincide. \item Note that in the two-sample case the estimator for the difference in location parameters does not estimate the difference in medians (a common misconception) but rather the median of the difference between a sample from x and a sample from y. } \item \code{conf.low, conf.high}: a confidence interval for the location parameter. (Only present if argument conf.int = TRUE.) } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Provides a pipe-friendly framework to performs one and two sample Wilcoxon tests. Read more: \href{https://www.datanovia.com/en/lessons/wilcoxon-test-in-r/}{Wilcoxon in R}. } \details{ - \code{pairwise_wilcox_test()} applies the standard two sample Wilcoxon test to all possible pairs of groups. This method calls the \code{\link[stats]{wilcox.test}()}, so extra arguments are accepted. - If a list of comparisons is specified, the result of the pairwise tests is filtered to keep only the comparisons of interest.The p-value is adjusted after filtering. - For a grouped data, if pairwise test is performed, then the p-values are adjusted for each group level independently. - a nonparametric confidence interval and an estimator for the pseudomedian (one-sample case) or for the difference of the location parameters \code{x-y} is computed, where x and y are the compared samples or groups. The column \code{estimate} and the confidence intervals are displayed in the test result when the option \code{detailed = TRUE} is specified in the \code{wilcox_test()} and \code{pairwise_wilcox_test()} functions. Read more about the calculation of the estimate in the details section of the R base function \code{wilcox.test()} documentation by typing \code{?wilcox.test} in the R console. } \section{Functions}{ \itemize{ \item \code{wilcox_test()}: Wilcoxon test \item \code{pairwise_wilcox_test()}: performs pairwise two sample Wilcoxon test. }} \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # One-sample test #::::::::::::::::::::::::::::::::::::::::: df \%>\% wilcox_test(len ~ 1, mu = 0) # Two-samples unpaired test #::::::::::::::::::::::::::::::::::::::::: df \%>\% wilcox_test(len ~ supp) # Two-samples paired test #::::::::::::::::::::::::::::::::::::::::: df \%>\% wilcox_test (len ~ supp, paired = TRUE) # Compare supp levels after grouping the data by "dose" #:::::::::::::::::::::::::::::::::::::::: df \%>\% group_by(dose) \%>\% wilcox_test(data =., len ~ supp) \%>\% adjust_pvalue(method = "bonferroni") \%>\% add_significance("p.adj") # pairwise comparisons #:::::::::::::::::::::::::::::::::::::::: # As dose contains more than two levels ==> # pairwise test is automatically performed. df \%>\% wilcox_test(len ~ dose) # Comparison against reference group #:::::::::::::::::::::::::::::::::::::::: # each level is compared to the ref group df \%>\% wilcox_test(len ~ dose, ref.group = "0.5") # Comparison against all #:::::::::::::::::::::::::::::::::::::::: df \%>\% wilcox_test(len ~ dose, ref.group = "all") } rstatix/man/cor_reorder.Rd0000644000176200001440000000161515074310430015317 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cor_reorder.R \name{cor_reorder} \alias{cor_reorder} \title{Reorder Correlation Matrix} \usage{ cor_reorder(x) } \arguments{ \item{x}{a correlation matrix. Particularly, an object of class \code{cor_mat}.} } \value{ a data frame } \description{ reorder correlation matrix, according to the coefficients, using the hierarchical clustering method. } \examples{ # Compute correlation matrix #:::::::::::::::::::::::::::::::::::::::::: cor.mat <- mtcars \%>\% select(mpg, disp, hp, drat, wt, qsec) \%>\% cor_mat() # Reorder by correlation and get p-values #:::::::::::::::::::::::::::::::::::::::::: # Reorder cor.mat \%>\% cor_reorder() # Get p-values of the reordered cor_mat cor.mat \%>\% cor_reorder() \%>\% cor_get_pval() } \seealso{ \code{\link{cor_mat}()}, \code{\link{cor_gather}()}, \code{\link{cor_spread}()} } rstatix/man/box_m.Rd0000644000176200001440000000207615074707646014143 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/box_m.R \name{box_m} \alias{box_m} \title{Box's M-test for Homogeneity of Covariance Matrices} \usage{ box_m(data, group) } \arguments{ \item{data}{a numeric data.frame or matrix containing n observations of p variables; it is expected that n > p.} \item{group}{a vector of length n containing the class of each observation; it is usually a factor.} } \value{ A data frame containing the following components: \item{statistic}{an approximated value of the chi-square distribution.} \item{parameter}{the degrees of freedom related of the test statistic in this case that it follows a Chi-square distribution.} \item{p.value}{the p-value of the test.} \item{method}{the character string "Box's M-test for Homogeneity of Covariance Matrices".} } \description{ Performs the Box's M-test for homogeneity of covariance matrices obtained from multivariate normal data according to one grouping variable. The test is based on the chi-square approximation. } \examples{ data(iris) box_m(iris[, -5], iris[, 5]) } rstatix/man/get_test_label.Rd0000644000176200001440000001211715074310430015766 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get_test_label.R \name{get_pwc_label} \alias{get_pwc_label} \alias{get_test_label} \alias{create_test_label} \alias{get_n} \alias{get_description} \title{Extract Label Information from Statistical Tests} \usage{ get_pwc_label(stat.test, type = c("expression", "text")) get_test_label( stat.test, description = NULL, p.col = "p", type = c("expression", "text"), correction = c("auto", "GG", "HF", "none"), row = NULL, detailed = FALSE ) create_test_label( statistic.text, statistic, p, parameter = NA, description = NULL, n = NA, effect.size = NA, effect.size.text = NA, type = c("expression", "text"), detailed = FALSE ) get_n(stat.test) get_description(stat.test) } \arguments{ \item{stat.test}{statistical test results returned by \code{rstatix} functions.} \item{type}{the label type. Can be one of "text" and "expression". Partial match allowed. If you want to add the label onto a ggplot, it might be useful to specify \code{type = "expresion"}.} \item{description}{the test description used as the prefix of the label. Examples of description are "ANOVA", "Two Way ANOVA". To remove the default description, specify \code{description = NULL}. If missing, we'll try to guess the statistical test default description.} \item{p.col}{character specifying the column containing the p-value. Default is \code{"p"}, can be \code{"p.adj"}.} \item{correction}{character, considered only in the case of ANOVA test. Which sphericity correction of the degrees of freedom should be reported for the within-subject factors (repeated measures). The default is set to \code{"GG"} corresponding to the Greenhouse-Geisser correction. Possible values are \code{"GG"}, \code{"HF"} (i.e., Hyunh-Feldt correction), \code{"none"} (i.e., no correction) and \code{"auto"} (apply automatically GG correction if the sphericity assumption is not for within-subject design.} \item{row}{numeric, the row index to be considered. If NULL, the last row is automatically considered for ANOVA test.} \item{detailed}{logical value. If TRUE, returns detailed label.} \item{statistic.text}{character specifying the test statistic. For example \code{statistic.text = "F"} (for ANOVA test ); \code{statistic.text = "t"} (for t-test ).} \item{statistic}{the numeric value of a statistic.} \item{p}{the p-value of the test.} \item{parameter}{string containing the degree of freedom (if exists). Default is \code{NA} to accommodate non-parametric tests. For example \code{parameter = "1,9"} (for ANOVA test. Two parameters exist: DFn and DFd); \code{sparameter = "9"} (for t-test ).} \item{n}{sample count, example: \code{n = 10}.} \item{effect.size}{the effect size value} \item{effect.size.text}{a character specifying the relevant effect size. For example, for \code{Cohens d} statistic, \code{effect.size.text = "d"}. You can also use plotmath expression as follow \code{quote(italic("d"))}.} } \value{ a text label or an expression to pass to a plotting function. } \description{ Extracts label information from statistical tests. Useful for labelling plots with test outputs. } \section{Functions}{ \itemize{ \item \code{get_pwc_label()}: Extract label from pairwise comparisons. \item \code{get_test_label()}: Extract labels for statistical tests. \item \code{create_test_label()}: Create labels from user specified test results. \item \code{get_n()}: Extracts sample counts (n) from an rstatix test outputs. Returns a numeric vector. \item \code{get_description()}: Extracts the description of an rstatix test outputs. Returns a character vector. }} \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # One-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: anov <- df \%>\% anova_test(len ~ dose) get_test_label(anov, detailed = TRUE, type = "text") # Two-way ANOVA test #::::::::::::::::::::::::::::::::::::::::: anov <- df \%>\% anova_test(len ~ supp*dose) get_test_label(anov, detailed = TRUE, type = "text", description = "Two Way ANOVA") # Kruskal-Wallis test #::::::::::::::::::::::::::::::::::::::::: kruskal<- df \%>\% kruskal_test(len ~ dose) get_test_label(kruskal, detailed = TRUE, type = "text") # Wilcoxon test #::::::::::::::::::::::::::::::::::::::::: # Unpaired test wilcox <- df \%>\% wilcox_test(len ~ supp) get_test_label(wilcox, detailed = TRUE, type = "text") # Paired test wilcox <- df \%>\% wilcox_test(len ~ supp, paired = TRUE) get_test_label(wilcox, detailed = TRUE, type = "text") # T test #::::::::::::::::::::::::::::::::::::::::: ttest <- df \%>\% t_test(len ~ dose) get_test_label(ttest, detailed = TRUE, type = "text") # Pairwise comparisons labels #::::::::::::::::::::::::::::::::::::::::: get_pwc_label(ttest, type = "text") # Create test labels #::::::::::::::::::::::::::::::::::::::::: create_test_label( statistic.text = "F", statistic = 71.82, parameter = "4, 294", p = "<0.0001", description = "ANOVA", type = "text" ) # Extract infos #::::::::::::::::::::::::::::::::::::::::: stat.test <- df \%>\% t_test(len ~ dose) get_n(stat.test) get_description(stat.test) } rstatix/man/emmeans_test.Rd0000644000176200001440000000753115074310430015501 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/emmeans_test.R \name{emmeans_test} \alias{emmeans_test} \alias{get_emmeans} \title{Pairwise Comparisons of Estimated Marginal Means} \usage{ emmeans_test( data, formula, covariate = NULL, ref.group = NULL, comparisons = NULL, p.adjust.method = "bonferroni", conf.level = 0.95, model = NULL, detailed = FALSE ) get_emmeans(emmeans.test) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{covariate}{(optional) covariate names (for ANCOVA)} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group). If \code{ref.group = "all"}, pairwise two sample tests are performed for comparing each grouping variable levels against all (i.e. basemean).} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{conf.level}{confidence level of the interval.} \item{model}{a fitted-model objects such as the result of a call to \code{lm()}, from which the overall degrees of freedom are to be calculated.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{emmeans.test}{an object of class \code{emmeans_test}.} } \value{ return a data frame with some the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{statistic}: Test statistic (t.ratio) used to compute the p-value. \item \code{df}: degrees of freedom. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the statistical test used to compare groups. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: estimate of the effect size, that is the difference between the two emmeans (estimated marginal means). \item \code{conf.low,conf.high}: Lower and upper bound on a confidence interval of the estimate. } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. It has also an attribute named "emmeans", a data frame containing the groups emmeans. } \description{ Performs pairwise comparisons between groups using the estimated marginal means. Pipe-friendly wrapper arround the functions \code{emmans() + contrast()} from the \code{emmeans} package, which need to be installed before using this function. This function is useful for performing post-hoc analyses following ANOVA/ANCOVA tests. } \section{Functions}{ \itemize{ \item \code{get_emmeans()}: returns the estimated marginal means from an object of class \code{emmeans_test} }} \examples{ # Data preparation df <- ToothGrowth df$dose <- as.factor(df$dose) # Pairwise comparisons res <- df \%>\% group_by(supp) \%>\% emmeans_test(len ~ dose, p.adjust.method = "bonferroni") res # Display estimated marginal means attr(res, "emmeans") # Show details df \%>\% group_by(supp) \%>\% emmeans_test(len ~ dose, p.adjust.method = "bonferroni", detailed = TRUE) } rstatix/man/chisq_test.Rd0000644000176200001440000001225015074314420015160 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/chisq_test.R \name{chisq_test} \alias{chisq_test} \alias{pairwise_chisq_gof_test} \alias{pairwise_chisq_test_against_p} \alias{chisq_descriptives} \alias{expected_freq} \alias{observed_freq} \alias{pearson_residuals} \alias{std_residuals} \title{Chi-squared Test for Count Data} \usage{ chisq_test( x, y = NULL, correct = TRUE, p = rep(1/length(x), length(x)), rescale.p = FALSE, simulate.p.value = FALSE, B = 2000 ) pairwise_chisq_gof_test(x, p.adjust.method = "holm", ...) pairwise_chisq_test_against_p( x, p = rep(1/length(x), length(x)), p.adjust.method = "holm", ... ) chisq_descriptives(res.chisq) expected_freq(res.chisq) observed_freq(res.chisq) pearson_residuals(res.chisq) std_residuals(res.chisq) } \arguments{ \item{x}{a numeric vector or matrix. \code{x} and \code{y} can also both be factors.} \item{y}{a numeric vector; ignored if \code{x} is a matrix. If \code{x} is a factor, \code{y} should be a factor of the same length.} \item{correct}{a logical indicating whether to apply continuity correction when computing the test statistic for 2 by 2 tables: one half is subtracted from all \eqn{|O - E|} differences; however, the correction will not be bigger than the differences themselves. No correction is done if \code{simulate.p.value = TRUE}.} \item{p}{a vector of probabilities of the same length as \code{x}. An error is given if any entry of \code{p} is negative.} \item{rescale.p}{a logical scalar; if TRUE then \code{p} is rescaled (if necessary) to sum to 1. If \code{rescale.p} is FALSE, and \code{p} does not sum to 1, an error is given.} \item{simulate.p.value}{a logical indicating whether to compute p-values by Monte Carlo simulation.} \item{B}{an integer specifying the number of replicates used in the Monte Carlo test.} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{...}{other arguments passed to the function \code{{chisq_test}()}.} \item{res.chisq}{an object of class \code{chisq_test}.} } \value{ return a data frame with some the following columns: \itemize{ \item \code{n}: the number of participants. \item \code{group, group1, group2}: the categories or groups being compared. \item \code{statistic}: the value of Pearson's chi-squared test statistic. \item \code{df}: the degrees of freedom of the approximate chi-squared distribution of the test statistic. NA if the p-value is computed by Monte Carlo simulation. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the used statistical test. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{observed}: observed counts. \item \code{expected}: the expected counts under the null hypothesis. } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Performs chi-squared tests, including goodness-of-fit, homogeneity and independence tests. } \section{Functions}{ \itemize{ \item \code{chisq_test()}: performs chi-square tests including goodness-of-fit, homogeneity and independence tests. \item \code{pairwise_chisq_gof_test()}: perform pairwise comparisons between groups following a global chi-square goodness of fit test. \item \code{pairwise_chisq_test_against_p()}: perform pairwise comparisons after a global chi-squared test for given probabilities. For each group, the observed and the expected proportions are shown. Each group is compared to the sum of all others. \item \code{chisq_descriptives()}: returns the descriptive statistics of the chi-square test. These include, observed and expected frequencies, proportions, residuals and standardized residuals. \item \code{expected_freq()}: returns the expected counts from the chi-square test result. \item \code{observed_freq()}: returns the observed counts from the chi-square test result. \item \code{pearson_residuals()}: returns the Pearson residuals, \code{(observed - expected) / sqrt(expected)}. \item \code{std_residuals()}: returns the standardized residuals }} \examples{ # Chi-square goodness of fit test #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% tulip <- c(red = 81, yellow = 50, white = 27) # Q1: Are the colors equally common? chisq_test(tulip) pairwise_chisq_gof_test(tulip) # Q2: comparing observed to expected proportions chisq_test(tulip, p = c(1/2, 1/3, 1/6)) pairwise_chisq_test_against_p(tulip, p = c(0.5, 0.33, 0.17)) # Homogeneity of proportions between groups #\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\% # Data: Titanic xtab <- as.table(rbind( c(203, 118, 178, 212), c(122, 167, 528, 673) )) dimnames(xtab) <- list( Survived = c("Yes", "No"), Class = c("1st", "2nd", "3rd", "Crew") ) xtab # Chi-square test chisq_test(xtab) # Compare the proportion of survived between groups pairwise_prop_test(xtab) } rstatix/man/wilcox_effsize.Rd0000644000176200001440000001047115074310430016032 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wilcox_effsize.R \name{wilcox_effsize} \alias{wilcox_effsize} \title{Wilcoxon Effect Size} \usage{ wilcox_effsize( data, formula, comparisons = NULL, ref.group = NULL, paired = FALSE, alternative = "two.sided", mu = 0, ci = FALSE, conf.level = 0.95, ci.type = "perc", nboot = 1000, ... ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group). If \code{ref.group = "all"}, pairwise two sample tests are performed for comparing each grouping variable levels against all (i.e. basemean).} \item{paired}{a logical indicating whether you want a paired test.} \item{alternative}{a character string specifying the alternative hypothesis, must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter.} \item{mu}{a number specifying an optional parameter used to form the null hypothesis.} \item{ci}{If TRUE, returns confidence intervals by bootstrap. May be slow.} \item{conf.level}{The level for the confidence interval.} \item{ci.type}{The type of confidence interval to use. Can be any of "norm", "basic", "perc", or "bca". Passed to \code{boot::boot.ci}.} \item{nboot}{The number of replications to use for bootstrap.} \item{...}{Additional arguments passed to the functions \code{coin::wilcoxsign_test()} (case of one- or paired-samples test) or \code{coin::wilcox_test()} (case of independent two-samples test).} } \value{ return a data frame with some of the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. \item \code{effsize}: estimate of the effect size (\code{r} value). \item \code{magnitude}: magnitude of effect size. \item \code{conf.low,conf.high}: lower and upper bound of the effect size confidence interval.} } \description{ Compute Wilcoxon effect size (\code{r}) for: \itemize{ \item one-sample test (Wilcoxon one-sample signed-rank test); \item paired two-samples test (Wilcoxon two-sample paired signed-rank test) and \item independent two-samples test ( Mann-Whitney, two-sample rank-sum test). } It can also returns confidence intervals by bootstap. The effect size \code{r} is calculated as \code{Z} statistic divided by square root of the sample size (N) (\eqn{Z/\sqrt{N}}). The \code{Z} value is extracted from either \code{coin::wilcoxsign_test()} (case of one- or paired-samples test) or \code{coin::wilcox_test()} (case of independent two-samples test). Note that \code{N} corresponds to total sample size for independent samples test and to total number of pairs for paired samples test. The \code{r} value varies from 0 to close to 1. The interpretation values for r commonly in published litterature and on the internet are: \code{0.10 - < 0.3} (small effect), \code{0.30 - < 0.5} (moderate effect) and \code{>= 0.5} (large effect). } \examples{ if(require("coin")){ # One-sample Wilcoxon test effect size ToothGrowth \%>\% wilcox_effsize(len ~ 1, mu = 0) # Independent two-samples wilcoxon effect size ToothGrowth \%>\% wilcox_effsize(len ~ supp) # Paired-samples wilcoxon effect size ToothGrowth \%>\% wilcox_effsize(len ~ supp, paired = TRUE) # Pairwise comparisons ToothGrowth \%>\% wilcox_effsize(len ~ dose) # Grouped data ToothGrowth \%>\% group_by(supp) \%>\% wilcox_effsize(len ~ dose) } } \references{ Maciej Tomczak and Ewa Tomczak. The need to report effect size estimates revisited. An overview of some recommended measures of effect size. Trends in Sport Sciences. 2014; 1(21):19-25. } rstatix/man/welch_anova_test.Rd0000644000176200001440000000305315074310430016335 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/welch_anova_test.R \name{welch_anova_test} \alias{welch_anova_test} \title{Welch One-Way ANOVA Test} \usage{ welch_anova_test(data, formula) } \arguments{ \item{data}{a data frame containing the variables in the formula.} \item{formula}{a formula specifying the ANOVA model similar to aov. Can be of the form y ~ group where y is a numeric variable giving the data values and group is a factor with one or multiple levels giving the corresponding groups. For example, formula = TP53 ~ cancer_group.} } \value{ return a data frame with the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{n}: sample count. \item \code{statistic}: the value of the test statistic. \item \code{p}: p-value. \item \code{method}: the statistical test used to compare groups.} } \description{ Tests for equal means in a one-way design (not assuming equal variance). A wrapper around the base function \code{\link[stats]{oneway.test}()}. This is is an alternative to the standard one-way ANOVA in the situation where the homogeneity of variance assumption is violated. } \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth df$dose <- as.factor(df$dose) # Welch one-way ANOVA test (not assuming equal variance) #::::::::::::::::::::::::::::::::::::::::: df \%>\% welch_anova_test(len ~ dose) # Grouped data #::::::::::::::::::::::::::::::::::::::::: df \%>\% group_by(supp) \%>\% welch_anova_test(len ~ dose) } rstatix/man/tukey_hsd.Rd0000644000176200001440000000515715074310430015016 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tukey_hsd.R \name{tukey_hsd} \alias{tukey_hsd} \alias{tukey_hsd.default} \alias{tukey_hsd.lm} \alias{tukey_hsd.data.frame} \title{Tukey Honest Significant Differences} \usage{ tukey_hsd(x, ...) \method{tukey_hsd}{default}(x, ...) \method{tukey_hsd}{lm}(x, ...) \method{tukey_hsd}{data.frame}(x, formula, ...) } \arguments{ \item{x}{an object of class \code{aov}, \code{lm} or \code{data.frame} containing the variables used in the formula.} \item{...}{other arguments passed to the function \code{\link[stats]{TukeyHSD}()}. These include: \itemize{ \item \strong{which}: A character vector listing terms in the fitted model for which the intervals should be calculated. Defaults to all the terms. \item \strong{ordered}: A logical value indicating if the levels of the factor should be ordered according to increasing average in the sample before taking differences. If ordered is true then the calculated differences in the means will all be positive. The significant differences will be those for which the lwr end point is positive. }} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{data}{a data.frame containing the variables in the formula.} } \value{ a tibble data frame containing the results of the different comparisons. } \description{ Provides a pipe-friendly framework to performs Tukey post-hoc tests. Wrapper around the function \code{\link[stats]{TukeyHSD}()}. It is essentially a t-test that corrects for multiple testing. Can handle different inputs formats: aov, lm, formula. } \section{Methods (by class)}{ \itemize{ \item \code{tukey_hsd(default)}: performs tukey post-hoc test from \code{aov()} results. \item \code{tukey_hsd(lm)}: performs tukey post-hoc test from \code{lm()} model. \item \code{tukey_hsd(data.frame)}: performs tukey post-hoc tests using data and formula as inputs. ANOVA will be automatically performed using the function \code{\link[stats]{aov}()} }} \examples{ # Data preparation df <- ToothGrowth df$dose <- as.factor(df$dose) # Tukey HSD from ANOVA results aov(len ~ dose, data = df) \%>\% tukey_hsd() # two-way anova with interaction aov(len ~ dose*supp, data = df) \%>\% tukey_hsd() # Tukey HSD from lm() results lm(len ~ dose, data = df) \%>\% tukey_hsd() # Tukey HSD from data frame and formula tukey_hsd(df, len ~ dose) # Tukey HSD using grouped data df \%>\% group_by(supp) \%>\% tukey_hsd(len ~ dose) } rstatix/man/t_test.Rd0000644000176200001440000001421215074310430014311 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/t_test.R \name{t_test} \alias{t_test} \alias{pairwise_t_test} \title{T-test} \usage{ t_test( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", paired = FALSE, var.equal = FALSE, alternative = "two.sided", mu = 0, conf.level = 0.95, detailed = FALSE ) pairwise_t_test( data, formula, comparisons = NULL, ref.group = NULL, p.adjust.method = "holm", paired = FALSE, pool.sd = !paired, detailed = FALSE, ... ) } \arguments{ \item{data}{a data.frame containing the variables in the formula.} \item{formula}{a formula of the form \code{x ~ group} where \code{x} is a numeric variable giving the data values and \code{group} is a factor with one or multiple levels giving the corresponding groups. For example, \code{formula = TP53 ~ cancer_group}.} \item{comparisons}{A list of length-2 vectors specifying the groups of interest to be compared. For example to compare groups "A" vs "B" and "B" vs "C", the argument is as follow: \code{comparisons = list(c("A", "B"), c("B", "C"))}} \item{ref.group}{a character string specifying the reference group. If specified, for a given grouping variable, each of the group levels will be compared to the reference group (i.e. control group). If \code{ref.group = "all"}, pairwise two sample tests are performed for comparing each grouping variable levels against all (i.e. basemean).} \item{p.adjust.method}{method to adjust p values for multiple comparisons. Used when pairwise comparisons are performed. Allowed values include "holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none". If you don't want to adjust the p value (not recommended), use p.adjust.method = "none".} \item{paired}{a logical indicating whether you want a paired test.} \item{var.equal}{a logical variable indicating whether to treat the two variances as being equal. If \code{TRUE} then the pooled variance is used to estimate the variance otherwise the Welch (or Satterthwaite) approximation to the degrees of freedom is used.} \item{alternative}{a character string specifying the alternative hypothesis, must be one of \code{"two.sided"} (default), \code{"greater"} or \code{"less"}. You can specify just the initial letter.} \item{mu}{a number specifying an optional parameter used to form the null hypothesis.} \item{conf.level}{confidence level of the interval.} \item{detailed}{logical value. Default is FALSE. If TRUE, a detailed result is shown.} \item{pool.sd}{logical value used in the function \code{pairwise_t_test()}. Switch to allow/disallow the use of a pooled SD. The \code{pool.sd = TRUE} (default) calculates a common SD for all groups and uses that for all comparisons (this can be useful if some groups are small). This method does not actually call t.test, so extra arguments are ignored. Pooling does not generalize to paired tests so pool.sd and paired cannot both be TRUE. If \code{pool.sd = FALSE} the standard two sample t-test is applied to all possible pairs of groups. This method calls the \code{t.test()}, so extra arguments, such as \code{var.equal} are accepted.} \item{...}{other arguments to be passed to the function \code{\link[stats]{t.test}}.} } \value{ return a data frame with some the following columns: \itemize{ \item \code{.y.}: the y variable used in the test. \item \code{group1,group2}: the compared groups in the pairwise tests. \item \code{n,n1,n2}: Sample counts. \item \code{statistic}: Test statistic used to compute the p-value. \item \code{df}: degrees of freedom. \item \code{p}: p-value. \item \code{p.adj}: the adjusted p-value. \item \code{method}: the statistical test used to compare groups. \item \code{p.signif, p.adj.signif}: the significance level of p-values and adjusted p-values, respectively. \item \code{estimate}: estimate of the effect size. It corresponds to the estimated mean or difference in means depending on whether it was a one-sample test or a two-sample test. \item \code{estimate1, estimate2}: show the mean values of the two groups, respectively, for independent samples t-tests. \item \code{alternative}: a character string describing the alternative hypothesis. \item \code{conf.low,conf.high}: Lower and upper bound on a confidence interval. } The \strong{returned object has an attribute called args}, which is a list holding the test arguments. } \description{ Provides a pipe-friendly framework to performs one and two sample t-tests. Read more: \href{https://www.datanovia.com/en/lessons/t-test-in-r/}{T-test in R}. } \details{ - If a list of comparisons is specified, the result of the pairwise tests is filtered to keep only the comparisons of interest. The p-value is adjusted after filtering. - For a grouped data, if pairwise test is performed, then the p-values are adjusted for each group level independently. } \section{Functions}{ \itemize{ \item \code{t_test()}: t test \item \code{pairwise_t_test()}: performs pairwise two sample t-test. Wrapper around the R base function \code{\link[stats]{pairwise.t.test}}. }} \examples{ # Load data #::::::::::::::::::::::::::::::::::::::: data("ToothGrowth") df <- ToothGrowth # One-sample test #::::::::::::::::::::::::::::::::::::::::: df \%>\% t_test(len ~ 1, mu = 0) # Two-samples unpaired test #::::::::::::::::::::::::::::::::::::::::: df \%>\% t_test(len ~ supp) # Two-samples paired test #::::::::::::::::::::::::::::::::::::::::: df \%>\% t_test (len ~ supp, paired = TRUE) # Compare supp levels after grouping the data by "dose" #:::::::::::::::::::::::::::::::::::::::: df \%>\% group_by(dose) \%>\% t_test(data =., len ~ supp) \%>\% adjust_pvalue(method = "bonferroni") \%>\% add_significance("p.adj") # pairwise comparisons #:::::::::::::::::::::::::::::::::::::::: # As dose contains more than two levels ==> # pairwise test is automatically performed. df \%>\% t_test(len ~ dose) # Comparison against reference group #:::::::::::::::::::::::::::::::::::::::: # each level is compared to the ref group df \%>\% t_test(len ~ dose, ref.group = "0.5") # Comparison against all #:::::::::::::::::::::::::::::::::::::::: df \%>\% t_test(len ~ dose, ref.group = "all") } rstatix/DESCRIPTION0000644000176200001440000000623015074715412013465 0ustar liggesusersPackage: rstatix Type: Package Title: Pipe-Friendly Framework for Basic Statistical Tests Version: 0.7.3 Authors@R: c( person("Alboukadel", "Kassambara", role = c("aut", "cre"), email = "alboukadel.kassambara@gmail.com")) Description: Provides a simple and intuitive pipe-friendly framework, coherent with the 'tidyverse' design philosophy, for performing basic statistical tests, including t-test, Wilcoxon test, ANOVA, Kruskal-Wallis and correlation analyses. The output of each test is automatically transformed into a tidy data frame to facilitate visualization. Additional functions are available for reshaping, reordering, manipulating and visualizing correlation matrix. Functions are also included to facilitate the analysis of factorial experiments, including purely 'within-Ss' designs (repeated measures), purely 'between-Ss' designs, and mixed 'within-and-between-Ss' designs. It's also possible to compute several effect size metrics, including "eta squared" for ANOVA, "Cohen's d" for t-test and 'Cramer V' for the association between categorical variables. The package contains helper functions for identifying univariate and multivariate outliers, assessing normality and homogeneity of variances. License: GPL-2 Encoding: UTF-8 Depends: R (>= 3.3.0) Imports: stats, utils, tidyr (>= 1.0.0), purrr, broom (>= 0.7.4), rlang (>= 0.3.1), tibble (>= 2.1.3), dplyr (>= 0.7.1), magrittr, corrplot, tidyselect (>= 1.2.0), car, generics (>= 0.0.2) Suggests: knitr, rmarkdown, ggpubr, graphics, emmeans, coin, boot, testthat, spelling URL: https://rpkgs.datanovia.com/rstatix/ BugReports: https://github.com/kassambara/rstatix/issues RoxygenNote: 7.3.3 Collate: 'utilities.R' 'add_significance.R' 'adjust_pvalue.R' 'factorial_design.R' 'utilities_two_sample_test.R' 'anova_summary.R' 'anova_test.R' 'as_cor_mat.R' 'binom_test.R' 'box_m.R' 'chisq_test.R' 'cochran_qtest.R' 'cohens_d.R' 'cor_as_symbols.R' 'replace_triangle.R' 'pull_triangle.R' 'cor_mark_significant.R' 'cor_mat.R' 'cor_plot.R' 'cor_reorder.R' 'cor_reshape.R' 'cor_select.R' 'cor_test.R' 'counts_to_cases.R' 'cramer_v.R' 'df.R' 'doo.R' 't_test.R' 'dunn_test.R' 'emmeans_test.R' 'eta_squared.R' 'factors.R' 'fisher_test.R' 'freq_table.R' 'friedman_test.R' 'friedman_effsize.R' 'games_howell_test.R' 'get_comparisons.R' 'get_manova_table.R' 'get_mode.R' 'get_pvalue_position.R' 'get_summary_stats.R' 'get_test_label.R' 'kruskal_effesize.R' 'kruskal_test.R' 'levene_test.R' 'mahalanobis_distance.R' 'make_clean_names.R' 'mcnemar_test.R' 'multinom_test.R' 'outliers.R' 'p_value.R' 'prop_test.R' 'prop_trend_test.R' 'reexports.R' 'remove_ns.R' 'sample_n_by.R' 'shapiro_test.R' 'sign_test.R' 'tukey_hsd.R' 'utils-manova.R' 'utils-pipe.R' 'welch_anova_test.R' 'wilcox_effsize.R' 'wilcox_test.R' Language: en-US NeedsCompilation: no Packaged: 2025-10-18 13:21:05 UTC; kassambara Author: Alboukadel Kassambara [aut, cre] Maintainer: Alboukadel Kassambara Repository: CRAN Date/Publication: 2025-10-18 13:50:02 UTC