ggstats/0000755000176200001440000000000014674044142011734 5ustar liggesusersggstats/tests/0000755000176200001440000000000014672600601013072 5ustar liggesusersggstats/tests/testthat/0000755000176200001440000000000014674044142014736 5ustar liggesusersggstats/tests/testthat/test-gglikert.R0000644000176200001440000001576214674026464017670 0ustar liggesuserstest_that("gglikert()", { skip_on_cran() skip_if_not_installed("labelled") skip_if_not_installed("ggplot2") skip_if_not_installed("dplyr") likert_levels <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree" ) set.seed(42) df <- dplyr::tibble( q1 = sample(likert_levels, 150, replace = TRUE), q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q5 = sample(c(likert_levels, NA), 150, replace = TRUE), q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) ) %>% dplyr::mutate(dplyr::across( dplyr::everything(), ~ factor(.x, levels = likert_levels) )) likert_levels_dk <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Don't know" ) df_dk <- dplyr::tibble( q1 = sample(likert_levels_dk, 150, replace = TRUE), q2 = sample(likert_levels_dk, 150, replace = TRUE, prob = 6:1), q3 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q4 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q5 = sample(c(likert_levels_dk, NA), 150, replace = TRUE), q6 = sample( likert_levels_dk, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0, 1) ) ) %>% dplyr::mutate(dplyr::across( dplyr::everything(), ~ factor(.x, levels = likert_levels_dk) )) vdiffr::expect_doppelganger( "gglikert() mod simple", gglikert(df) ) expect_error( d <- gglikert_data(df), NA ) expect_equal(levels(d$.answer), likert_levels) vdiffr::expect_doppelganger( "gglikert() include and width", gglikert(df, include = q1:q3, width = .5) ) vdiffr::expect_doppelganger( "gglikert() variable_labels", gglikert(df, variable_labels = c(q2 = "second question")) ) vdiffr::expect_doppelganger( "gglikert() sort prop asc", gglikert(df, sort = "asc") ) vdiffr::expect_doppelganger( "gglikert() sort prop desc", gglikert(df, sort = "desc") ) vdiffr::expect_doppelganger( "gglikert() sort prop_lower asc", gglikert(df, sort = "asc", sort_method = "prop_lower") ) vdiffr::expect_doppelganger( "gglikert() sort prop_lower desc", gglikert(df, sort = "desc", sort_method = "prop_lower") ) vdiffr::expect_doppelganger( "gglikert() sort mean asc", gglikert(df, sort = "asc", sort_method = "mean") ) vdiffr::expect_doppelganger( "gglikert() sort mean desc", gglikert(df, sort = "desc", sort_method = "mean") ) vdiffr::expect_doppelganger( "gglikert() sort median asc", gglikert(df, sort = "asc", sort_method = "median") ) vdiffr::expect_doppelganger( "gglikert() sort median desc", gglikert(df, sort = "desc", sort_method = "median") ) vdiffr::expect_doppelganger( "gglikert() sort prop asc include_center", gglikert(df, sort = "asc", sort_prop_include_center = TRUE) ) vdiffr::expect_doppelganger( "gglikert() exclude_fill_values", gglikert(df, exclude_fill_values = "Neither agree nor disagree") ) vdiffr::expect_doppelganger( "gglikert() add_labels", gglikert(df, add_labels = FALSE) ) vdiffr::expect_doppelganger( "gglikert() customize labels", gglikert(df, labels_size = 5, labels_hide_below = .3, labels_accuracy = .1) ) vdiffr::expect_doppelganger( "gglikert() add_totals", gglikert(df, add_totals = FALSE) ) vdiffr::expect_doppelganger( "gglikert() customize totals", gglikert( df, totals_size = 5, totals_fontface = "italic", totals_include_center = TRUE, totals_hjust = 0 ) ) vdiffr::expect_doppelganger( "gglikert() colors", gglikert(df, labels_color = "red", totals_color = "blue") ) vdiffr::expect_doppelganger( "gglikert() reverse", gglikert(df, y_reverse = TRUE, reverse_likert = TRUE) ) vdiffr::expect_doppelganger( "gglikert() variable labels and y_label_wrap", df %>% labelled::set_variable_labels( q1 = "first question", q2 = "second question", q3 = "third question with a very very very veru very very long label" ) %>% gglikert( variable_labels = c( q2 = "question 2", q4 = "another question with a long long long long long long label" ), y_label_wrap = 20 ) ) vdiffr::expect_doppelganger( "gglikert() cutoff 0", gglikert(df, cutoff = 0) ) vdiffr::expect_doppelganger( "gglikert() cutoff 1", gglikert(df, cutoff = 1) ) vdiffr::expect_doppelganger( "gglikert() cutoff 1 symmetric", gglikert(df, cutoff = 1, symmetric = TRUE) ) vdiffr::expect_doppelganger( "gglikert() cutoff 1.5", gglikert(df, cutoff = 1.5) ) vdiffr::expect_doppelganger( "gglikert() cutoff 5", gglikert(df, cutoff = 5) ) vdiffr::expect_doppelganger( "gglikert_stacked()", gglikert_stacked(df) ) vdiffr::expect_doppelganger( "gglikert_stacked() add_median_line", gglikert_stacked(df, add_median_line = TRUE) ) vdiffr::expect_doppelganger( "gglikert_stacked() labels_color red", gglikert_stacked(df, labels_color = "red") ) vdiffr::expect_doppelganger( "gglikert_stacked() labels_color auto", gglikert_stacked(df, labels_color = "auto") ) vdiffr::expect_doppelganger( "gglikert_stacked() labels_color black", gglikert_stacked(df, labels_color = "black") ) df_group <- df df_group$group1 <- sample(c("A", "B"), 150, replace = TRUE) df_group$group2 <- sample(c("a", "b", "c"), 150, replace = TRUE) vdiffr::expect_doppelganger( "gglikert() facet_cols", gglikert(df_group, q1:q6, facet_cols = vars(group1)) ) vdiffr::expect_doppelganger( "gglikert() facet_rows", gglikert(df_group, q1:q2, facet_rows = vars(group1, group2)) ) vdiffr::expect_doppelganger( "gglikert() facet_rows and facet_cols", gglikert( df_group, q3:q6, facet_cols = vars(group1), facet_rows = vars(group2) ) ) vdiffr::expect_doppelganger( "gglikert() facet_rows with group on y", gglikert(df_group, q1:q6, y = "group1", facet_rows = vars(.question)) ) f <- function(d) { d$.question <- forcats::fct_relevel(d$.question, "q5", "q2") d } vdiffr::expect_doppelganger( "gglikert() with data_fun", gglikert(df_group, q1:q6, data_fun = f) ) expect_error(gglikert(df_group, data_fun = "text")) }) test_that("hex_bw()", { expect_equal(hex_bw("#FFFFFF"), "#000000") expect_equal(hex_bw("#BBBBBB"), "#000000") expect_equal(hex_bw("#000000"), "#ffffff") expect_equal(hex_bw("#444444"), "#ffffff") }) ggstats/tests/testthat/test-ggcascade.R0000644000176200001440000000230414674033502017734 0ustar liggesuserstest_that("ggcascade() works", { skip_on_cran() library(ggplot2) p <- ggplot2::diamonds |> ggcascade( all = TRUE, big = carat > .5, "big & ideal" = carat > .5 & cut == "Ideal" ) vdiffr::expect_doppelganger( "ggcascade diamonds", p ) p <- ggplot2::mpg |> ggcascade( all = TRUE, recent = year > 2000, "recent & economic" = year > 2000 & displ < 3, .by = cyl, .ncol = 3, .arrows = FALSE ) vdiffr::expect_doppelganger( "ggcascade mpg by, no arrow and ncol", p ) p <- ggplot2::mpg |> ggcascade( all = TRUE, recent = year > 2000, "recent & economic" = year > 2000 & displ < 3, .by = pick(cyl, drv), .add_n = FALSE, .text_size = 2 ) vdiffr::expect_doppelganger( "ggcascade mpg py pick, no n, text_size", p ) d <- as.data.frame(Titanic) p <- d |> ggcascade( all = TRUE, female = Sex == "Female", "female & survived" = Sex == "Female" & Survived == "Yes", .weights = Freq, .by = Class ) vdiffr::expect_doppelganger( "ggcascade titanic weights", p ) }) ggstats/tests/testthat/test-ggcoef_model.R0000644000176200001440000003662614601225305020455 0ustar liggesuserstest_that("ggcoef_model()", { skip_on_cran() skip_if_not_installed("broom.helpers") skip_if_not_installed("reshape") data(tips, package = "reshape") mod_simple <- lm(tip ~ day + time + total_bill, data = tips) vdiffr::expect_doppelganger( "ggcoef_model() mod simple", ggcoef_model(mod_simple) ) vdiffr::expect_doppelganger( "ggcoef_model() mod simple no guide", ggcoef_model(mod_simple, shape_guide = FALSE, colour_guide = FALSE) ) # custom variable labels # you can use to define variable labels before computing model if (requireNamespace("labelled")) { tips_labelled <- tips %>% labelled::set_variable_labels( day = "Day of the week", time = "Lunch or Dinner", total_bill = "Bill's total" ) mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled) vdiffr::expect_doppelganger( "ggcoef_model() mod labelled", ggcoef_model(mod_labelled) ) } vdiffr::expect_doppelganger( "ggcoef_model() mod simple with variable labels", ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ) ) ) # if labels are too long, you can use 'facet_labeller' to wrap them vdiffr::expect_doppelganger( "ggcoef_model() mod simple facet_labeller", ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ), facet_labeller = ggplot2::label_wrap_gen(10) ) ) # do not display variable facets but add colour guide vdiffr::expect_doppelganger( "ggcoef_model() mod simple no variable facets", ggcoef_model( mod_simple, facet_row = NULL, colour_guide = TRUE ) ) # a logistic regression example d_titanic <- as.data.frame(Titanic) d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes")) mod_titanic <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial ) vdiffr::expect_doppelganger( "ggcoef_model() logistic regression", ggcoef_model(mod_titanic, exponentiate = TRUE) ) # display intercept vdiffr::expect_doppelganger( "ggcoef_model() logistic regression with intercept", ggcoef_model(mod_titanic, exponentiate = TRUE, intercept = TRUE) ) # display only a subset of terms vdiffr::expect_doppelganger( "ggcoef_model() logistic regression subset", ggcoef_model(mod_titanic, exponentiate = TRUE, include = c("Age", "Class")) ) # do not change points' shape based on significance vdiffr::expect_doppelganger( "ggcoef_model() logistic regression no significance", ggcoef_model(mod_titanic, exponentiate = TRUE, significance = NULL) ) # a black and white version vdiffr::expect_doppelganger( "ggcoef_model() logistic regression black and white", ggcoef_model( mod_titanic, exponentiate = TRUE, colour = NULL, stripped_rows = FALSE ) ) # show dichotomous terms on one row vdiffr::expect_doppelganger( "ggcoef_model() logistic regression no reference row", ggcoef_model( mod_titanic, exponentiate = TRUE, no_reference_row = broom.helpers::all_dichotomous(), categorical_terms_pattern = "{ifelse(dichotomous, paste0(level, ' / ', reference_level), level)}", show_p_values = FALSE ) ) # works also with with polynomial terms mod_poly <- lm( tip ~ poly(total_bill, 3) + day, data = tips, ) vdiffr::expect_doppelganger( "ggcoef_model() polynomial terms", ggcoef_model(mod_poly) ) # or with different type of contrasts # for sum contrasts, the value of the reference term is computed if (requireNamespace("emmeans")) { mod2 <- lm( tip ~ day + time + sex, data = tips, contrasts = list(time = contr.sum, day = contr.treatment(4, base = 3)) ) vdiffr::expect_doppelganger( "ggcoef_model() different types of contrasts", ggcoef_model(mod2) ) } }) test_that("ggcoef_compare()", { skip_if_not_installed("broom.helpers") skip_on_cran() # Use ggcoef_compare() for comparing several models on the same plot mod1 <- lm(Fertility ~ ., data = swiss) mod2 <- step(mod1, trace = 0) mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) models <- list( "Full model" = mod1, "Simplified model" = mod2, "With interaction" = mod3 ) vdiffr::expect_doppelganger( "ggcoef_compare() dodged", ggcoef_compare(models) ) vdiffr::expect_doppelganger( "ggcoef_compare() faceted", ggcoef_compare(models, type = "faceted") ) d <- as.data.frame(Titanic) m1 <- glm(Survived ~ Sex + Age, family = binomial, data = d, weights = Freq) m2 <- glm( Survived ~ Sex + Age + Class, family = binomial, data = d, weights = Freq ) models <- list("Model 1" = m1, "Model 2" = m2) vdiffr::expect_doppelganger( "ggcoef_compare() titanic dodged", ggcoef_compare(models) ) vdiffr::expect_doppelganger( "ggcoef_compare() titanic faceted", ggcoef_compare(models, type = "faceted") ) rd <- ggcoef_compare(models, return_data = TRUE) expect_equal( levels(rd$label), c("Male", "Female", "Child", "Adult", "1st", "2nd", "3rd", "Crew") ) expect_error( ggcoef_compare(models, add_reference_rows = FALSE), NA ) }) test_that("ggcoef_multinom()", { skip_if_not_installed("broom.helpers") skip_if_not_installed("nnet") skip_on_cran() library(nnet) hec <- as.data.frame(HairEyeColor) mod <- multinom( Hair ~ Eye + Sex, data = hec, weights = hec$Freq ) vdiffr::expect_doppelganger( "ggcoef_multinom() dodged", ggcoef_multinom(mod, exponentiate = TRUE) ) vdiffr::expect_doppelganger( "ggcoef_multinom() faceted", ggcoef_multinom(mod, type = "faceted") ) vdiffr::expect_doppelganger( "ggcoef_multinom() table", ggcoef_multinom(mod, type = "table", exponentiate = TRUE) ) vdiffr::expect_doppelganger( "ggcoef_multinom() faceted custom y level label", ggcoef_multinom( mod, type = "faceted", y.level_label = c("Brown" = "Brown\n(ref: Black)"), exponentiate = TRUE ) ) }) test_that("ggcoef_model() works with tieders not returning p-values", { skip_if_not_installed("broom.helpers") skip_on_cran() mod <- lm(Sepal.Width ~ Species, iris) my_tidier <- function(x, ...) { x %>% broom::tidy(...) %>% dplyr::select(-dplyr::all_of("p.value")) } vdiffr::expect_doppelganger( "ggcoef_model() no p values", ggcoef_model(mod, tidy_fun = my_tidier) ) }) test_that("ggcoef_compare() complete NA respecting variables order", { skip_if_not_installed("broom.helpers") m1 <- lm(Fertility ~ Education + Catholic, data = swiss) m2 <- lm(Fertility ~ Education + Catholic + Agriculture, data = swiss) m3 <- lm( Fertility ~ Education + Catholic + Agriculture + Infant.Mortality, data = swiss ) res <- ggcoef_compare(models = list(m1, m2, m3), return_data = TRUE) expect_equal( res$variable[1:4], structure(1:4, .Label = c( "Education", "Catholic", "Agriculture", "Infant.Mortality" ), class = "factor") ) }) test_that("ggcoef_compare() does not produce an error with an include", { skip_if_not_installed("survival") skip_if_not_installed("broom.helpers") skip_on_cran() m1 <- survival::coxph( survival::Surv(time, status) ~ prior + age, data = survival::veteran ) m2 <- survival::coxph( survival::Surv(time, status) ~ prior + celltype, data = survival::veteran ) models <- list("Model 1" = m1, "Model 2" = m2) vdiffr::expect_doppelganger( "ggcoef_compare() with include", ggcoef_compare(models, include = broom.helpers::starts_with("p")) ) }) test_that("ggcoef_model() works with pairwise contratst", { skip_if_not_installed("broom.helpers") skip_if_not_installed("emmeans") mod <- lm(Sepal.Length ~ Sepal.Width + Species, data = iris) expect_error( ggcoef_model(mod, add_pairwise_contrasts = TRUE), NA ) expect_error( ggcoef_model( mod, add_pairwise_contrasts = TRUE, pairwise_variables = dplyr::starts_with("Sp"), keep_model_terms = TRUE ), NA ) mod2 <- lm(Sepal.Length ~ Species, data = iris) expect_error( ggcoef_compare(list(mod, mod2), add_pairwise_contrasts = TRUE), NA ) }) test_that("tidy_args is supported", { mod <- lm(Sepal.Length ~ Sepal.Width, data = iris) custom <- function(x, force = 1, ...) { broom::tidy(x, ...) %>% dplyr::mutate(estimate = force) } res <- ggcoef_model( mod, tidy_fun = custom, tidy_args = list(force = 3), return_data = TRUE ) expect_equal(res$estimate, 3) }) test_that("ggcoef_table()", { skip_on_cran() skip_if_not_installed("broom.helpers") skip_if_not_installed("reshape") data(tips, package = "reshape") mod_simple <- lm(tip ~ day + time + total_bill, data = tips) vdiffr::expect_doppelganger( "ggcoef_table() mod simple", ggcoef_table(mod_simple) ) vdiffr::expect_doppelganger( "ggcoef_table() table_stat", ggcoef_table(mod_simple, table_stat = c("p.value", "ci")) ) vdiffr::expect_doppelganger( "ggcoef_table() table_header", ggcoef_table(mod_simple, table_header = c("A", "B", "C")) ) expect_error( ggcoef_table(mod_simple, table_header = c("A", "B", "C", "D")) ) vdiffr::expect_doppelganger( "ggcoef_table() table_text_size", ggcoef_table(mod_simple, table_text_size = 5) ) vdiffr::expect_doppelganger( "ggcoef_table() table_stat_label ", ggcoef_table( mod_simple, table_stat_label = list( estimate = scales::label_percent(.1) ) ) ) vdiffr::expect_doppelganger( "ggcoef_table() ci_pattern", ggcoef_table(mod_simple, ci_pattern = "{conf.low} to {conf.high}") ) vdiffr::expect_doppelganger( "ggcoef_table() table_widths", ggcoef_table(mod_simple, table_witdhs = c(1, 2)) ) vdiffr::expect_doppelganger( "ggcoef_table() stripped_rows", ggcoef_table(mod_simple, stripped_rows = FALSE) ) vdiffr::expect_doppelganger( "ggcoef_table() show_p_values & signif_stars", ggcoef_table(mod_simple, show_p_values = TRUE, signif_stars = TRUE) ) vdiffr::expect_doppelganger( "ggcoef_table() show_p_values only", ggcoef_table(mod_simple, show_p_values = TRUE, signif_stars = FALSE) ) vdiffr::expect_doppelganger( "ggcoef_table() signif_stars only", ggcoef_table(mod_simple, show_p_values = FALSE, signif_stars = TRUE) ) vdiffr::expect_doppelganger( "ggcoef_table() customized statistics", ggcoef_table( mod_simple, table_stat = c("label", "estimate", "std.error", "ci"), ci_pattern = "{conf.low} to {conf.high}", table_stat_label = list( estimate = scales::label_number(accuracy = .01), conf.low = scales::label_number(accuracy = .1), conf.high = scales::label_number(accuracy = .1), std.error = scales::label_number(accuracy = .001), label = toupper ), table_header = c("Term", "Coef.", "SE", "CI"), table_witdhs = c(2, 3) ) ) }) test_that("ggcoef_multicomponents()", { skip_on_cran() skip_if_not_installed("broom.helpers") skip_if_not_installed("pscl") library(pscl) data("bioChemists", package = "pscl") mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists) vdiffr::expect_doppelganger( "ggcoef_multicomponents() dodged", ggcoef_multicomponents(mod, tidy_fun = broom.helpers::tidy_zeroinfl) ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() faceted", ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "f" ) ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() faceted exponentiated", ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "f", exponentiate = TRUE ) ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() table", ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t" ) ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() table exponentiated", ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t", exponentiate = TRUE ) ) expect_s3_class( ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t", return_data = TRUE ), "tbl" ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() table component_label", ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t", component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") # nolint ) ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() faceted component_label", ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "f", component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") # nolint ) ) # message if unfound values for component_label expect_message( ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t", component_label = c(c = "Count", zi = "Zero-inflated") ) ) # error if unnamed values for component_label expect_error( ggcoef_multicomponents( mod, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t", component_label = c("Count", zi = "Zero-inflated") ) ) mod2 <- zeroinfl(art ~ fem + mar | 1, data = bioChemists) vdiffr::expect_doppelganger( "ggcoef_multicomponents() mod2 table", ggcoef_multicomponents( mod2, tidy_fun = broom.helpers::tidy_zeroinfl, type = "t" ) ) skip_if_not_installed("betareg") skip_if_not_installed("parameters") library(betareg) data("GasolineYield", package = "betareg") m1 <- betareg(yield ~ batch + temp, data = GasolineYield) m2 <- betareg(yield ~ batch + temp | temp + pressure, data = GasolineYield) vdiffr::expect_doppelganger( "ggcoef_multicomponents() betareg m1 table", ggcoef_multicomponents( m1, type = "t", tidy_fun = broom.helpers::tidy_parameters, tidy_args = list(component = "all") ) ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() betareg m2 table", ggcoef_multicomponents( m2, type = "t", tidy_fun = broom.helpers::tidy_parameters, tidy_args = list(component = "all") ) ) modlm <- lm(Sepal.Length ~ Sepal.Width + Species, data = iris) vdiffr::expect_doppelganger( "ggcoef_multicomponents() linear model table", ggcoef_multicomponents(modlm, type = "t") ) vdiffr::expect_doppelganger( "ggcoef_multicomponents() linear model faceted", ggcoef_multicomponents(modlm, type = "f") ) }) ggstats/tests/testthat/test-position_likert.R0000644000176200001440000000574414672600602021263 0ustar liggesuserstest_that("position_likert()", { skip_on_cran() library(ggplot2) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + scale_x_continuous(label = label_percent_abs()) + scale_fill_brewer(palette = "PiYG") + xlab("proportion") vdiffr::expect_doppelganger( "position_likert() base", p ) vdiffr::expect_doppelganger( "position_likert() facet", p + facet_grid(~ price > 2500) ) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "diverging") + scale_x_continuous(label = label_number_abs()) + scale_fill_brewer(palette = "PiYG") vdiffr::expect_doppelganger( "position_diverging() base", p ) vdiffr::expect_doppelganger( "position_diverging() facet", p + facet_grid(~ price > 2500) ) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(reverse = TRUE)) vdiffr::expect_doppelganger( "position_likert() reverse", p ) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_diverging(reverse = TRUE)) vdiffr::expect_doppelganger( "position_diverging() reverse", p ) custom_label <- function(x) { p <- scales::percent(x, accuracy = 1) p[x < .075] <- "" p } p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + geom_text( aes(by = clarity, label = custom_label(after_stat(prop))), stat = "prop", position = position_likert(vjust = .5) ) + scale_x_continuous(label = label_percent_abs()) + scale_fill_brewer(palette = "PiYG", direction = -1) + xlab("proportion") vdiffr::expect_doppelganger( "position_likert() vjust", p ) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(exclude_fill_values = "Very Good")) + scale_x_continuous(label = label_percent_abs()) + scale_fill_brewer(palette = "PiYG") + xlab("proportion") vdiffr::expect_doppelganger( "position_likert() exclude_fill_values", p ) }) test_that("geom_diverging() & associates", { library(ggplot2) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_diverging() + geom_diverging_text(aes(color = after_scale(hex_bw(.data$fill)))) vdiffr::expect_doppelganger( "geom_diverging and geom_diverging_text", p ) p <- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_likert() + geom_likert_text(aes(color = after_scale(hex_bw(.data$fill)))) vdiffr::expect_doppelganger( "geom_likert and geom_likert_text", p ) d <- Titanic |> as.data.frame() p <- ggplot(d) + aes(y = Class, fill = Sex, weight = Freq) + geom_pyramid() + geom_pyramid_text() vdiffr::expect_doppelganger( "geom_pyramid and geom_pyramid_text", p ) }) ggstats/tests/testthat/test_ggsurvey.R0000644000176200001440000000130714357760262020002 0ustar liggesuserstest_that("ggsurvey works correctly", { skip_on_cran() skip_if_not_installed("survey") skip_if_not_installed("ggplot2") library(ggplot2) data(api, package = "survey") dstrat <- survey::svydesign( id = ~1, strata = ~stype, weights = ~pw, data = apistrat, fpc = ~fpc ) vdiffr::expect_doppelganger( "ggsurvey() dstrat", ggsurvey(dstrat) + aes(x = cnum, y = dnum) + geom_count() ) d <- as.data.frame(Titanic) dw <- survey::svydesign(ids = ~1, weights = ~Freq, data = d) vdiffr::expect_doppelganger( "ggsurvey() titanic", ggsurvey(dw) + aes(x = Class, fill = Survived) + geom_bar(position = "fill") ) }) ggstats/tests/testthat/test-stat_weighted_mean.R0000644000176200001440000000345214357760262021703 0ustar liggesuserstest_that("stat_weighted_mean()", { skip_on_cran() skip_if_not_installed("reshape") library(ggplot2) data(tips, package = "reshape") vdiffr::expect_doppelganger( "stat_weighted_mean() point", ggplot(tips) + aes(x = day, y = total_bill) + geom_point() ) vdiffr::expect_doppelganger( "stat_weighted_mean() geom-default", ggplot(tips) + aes(x = day, y = total_bill) + stat_weighted_mean() ) vdiffr::expect_doppelganger( "stat_weighted_mean() geom-line", ggplot(tips) + aes(x = day, y = total_bill, group = 1) + stat_weighted_mean(geom = "line") ) vdiffr::expect_doppelganger( "stat_weighted_mean() geom-line-grouped", ggplot(tips) + aes(x = day, y = total_bill, colour = sex, group = sex) + stat_weighted_mean(geom = "line") ) vdiffr::expect_doppelganger( "stat_weighted_mean() geom-bar-dodge", ggplot(tips) + aes(x = day, y = total_bill, fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") ) # computing a proportion on the fly vdiffr::expect_doppelganger( "stat_weighted_mean() geom-bar-dodge-percent", ggplot(tips) + aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + scale_y_continuous(labels = scales::percent) ) # taking into account some weights d <- as.data.frame(Titanic) vdiffr::expect_doppelganger( "stat_weighted_mean() titanic", ggplot(d) + aes( x = Class, y = as.integer(Survived == "Yes"), weight = Freq, fill = Sex ) + geom_bar(stat = "weighted_mean", position = "dodge") + scale_y_continuous(labels = scales::percent) + labs(y = "Survived") ) }) ggstats/tests/testthat/test-stat_cross.R0000644000176200001440000000433114357760262020231 0ustar liggesuserstest_that("stat_cross()", { skip_on_cran() library(ggplot2) d <- as.data.frame(Titanic) # plot number of observations p <- ggplot(d) + aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) + stat_cross() + scale_size_area(max_size = 20) vdiffr::expect_doppelganger("stat_cross() n obs", p) # custom shape and fill colour based on chi-squared residuals p <- ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(std.resid) ) + stat_cross(shape = 22) + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + scale_size_area(max_size = 20) vdiffr::expect_doppelganger("stat_cross() shape-22", p) # custom shape and fill colour based phi coefficients p <- ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(phi) ) + stat_cross(shape = 22) + scale_fill_steps2(show.limits = TRUE) + scale_size_area(max_size = 20) vdiffr::expect_doppelganger("stat_cross() phi coefficients", p) # plotting the number of observations as a table p <- ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = after_stat(observed) ) + geom_text(stat = "cross") vdiffr::expect_doppelganger("stat_cross() table", p) # Row proportions with standardized residuals p <- ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = scales::percent(after_stat(row.prop)), size = NULL, fill = after_stat(std.resid) ) + stat_cross(shape = 22, size = 30) + geom_text(stat = "cross") + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + facet_grid(Sex ~ .) + labs(fill = "Standardized residuals") vdiffr::expect_doppelganger("stat_cross() residuals", p) }) test_that("phi coefficients", { res <- Titanic %>% as.data.frame() %>% xtabs(Freq ~ Sex + Class, data = .) %>% chisq.test() %>% augment_chisq_add_phi() %>% dplyr::mutate(.phi = round(.data$.phi, digits = 3)) expect_equal( res$.phi, c(-0.236, 0.236, -0.149, 0.149, -0.107, 0.107, 0.375, -0.375) ) }) ggstats/tests/testthat/test-geom_stripped.R0000644000176200001440000000063614357760262020712 0ustar liggesuserstest_that("geom_stripped_cols() and geom_stripped_rows() works", { skip_on_cran() library(ggplot2) p <- ggplot(iris) + aes(x = Species, y = Petal.Length) + geom_count() vdiffr::expect_doppelganger( "stripped rows and cols", p + geom_stripped_rows( odd = "blue", even = "yellow", alpha = .1, nudge_y = .5 ) + geom_stripped_cols() ) }) ggstats/tests/testthat/test-stat_prop.R0000644000176200001440000000751314672600602020054 0ustar liggesuserstest_that("stat_prop()", { skip_on_cran() library(ggplot2) d <- as.data.frame(Titanic) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) vdiffr::expect_doppelganger( "stat_prop() titanic", p ) vdiffr::expect_doppelganger( "stat_prop() direct call", ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + stat_prop(geom = "bar") ) vdiffr::expect_doppelganger( "stat_prop() titanic-facet", p + facet_grid(~Sex) ) vdiffr::expect_doppelganger( "stat_prop() titanic-dodge", ggplot(d) + aes(x = Class, fill = Survived, weight = Freq) + geom_bar(position = "dodge") + geom_text( aes(by = Survived), stat = "prop", position = position_dodge(0.9), vjust = "bottom" ) ) vdiffr::expect_doppelganger( "stat_prop() titanic-dodge (not specifying by)", ggplot(d) + aes(x = Class, fill = Survived, weight = Freq) + geom_bar(position = "dodge") + geom_text( stat = "prop", position = position_dodge(0.9), vjust = "bottom" ) ) vdiffr::expect_doppelganger( "stat_prop() titanic-stack", ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = 1) + geom_bar() + geom_text( aes(label = scales::percent(after_stat(prop), accuracy = 1)), stat = "prop", position = position_stack(.5) ) ) }) test_that("stat_prop() works with an y aesthetic", { library(ggplot2) skip_on_cran() d <- as.data.frame(Titanic) p <- ggplot(d) + aes(y = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) vdiffr::expect_doppelganger("stat_prop() y-aes", p) }) test_that("stat_prop() works with a character by", { library(ggplot2) skip_on_cran() d <- as.data.frame(Titanic) p <- ggplot(d) + aes(y = Class, fill = Survived, weight = Freq, by = as.character(Class)) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) vdiffr::expect_doppelganger("stat_prop() by-character", p) }) test_that("stat_prop() works with default_by", { library(ggplot2) skip_on_cran() d <- as.data.frame(Titanic) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, y = after_stat(prop)) + geom_bar(stat = "prop") vdiffr::expect_doppelganger("stat_prop() default_by none", p) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, y = after_stat(prop)) + geom_bar(stat = "prop", default_by = "fill") vdiffr::expect_doppelganger("stat_prop() default_by fill", p) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, y = after_stat(prop)) + geom_bar(stat = "prop", default_by = "x") vdiffr::expect_doppelganger("stat_prop() default_by x", p) p <- ggplot(d) + aes(y = Class, fill = Survived, weight = Freq, x = after_stat(prop)) + geom_bar(stat = "prop", default_by = "x") vdiffr::expect_doppelganger("stat_prop() default_by x horizontal", p) }) test_that("geom_prop_bar() & geom_prop_text()", { d <- as.data.frame(Titanic) p <- ggplot(d) + aes(y = Class, fill = Survived, weight = Freq) + geom_prop_bar() + geom_prop_text() vdiffr::expect_doppelganger("geom_prop_bar() & geom_prop_text()", p) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq) + geom_prop_bar(height = "count") + geom_prop_text( height = "count", labels = "count", labeller = scales::number ) vdiffr::expect_doppelganger("geom_prop_bar() & geom_prop_text() - count", p) }) ggstats/tests/testthat/test-pal_extender.R0000644000176200001440000000041314625277577020526 0ustar liggesuserstest_that("pal_extender() works", { skip_if_not_installed("scales") pal <- scales::pal_brewer(palette = "PiYG") pal_e <- pal_extender(pal = pal) expect_equal(pal(5), pal_e(5)) expect_false(any(is.na(pal_e(20)))) expect_length(pal_e(20), 20L) }) ggstats/tests/testthat/test-utilities.R0000644000176200001440000000067614657111214020056 0ustar liggesuserstest_that("signif_stars() works", { x <- c(0.5, 0.1, 0.05, 0.01, 0.001) expect_equal( signif_stars(x), c("", ".", "*", "**", "***") ) expect_equal( signif_stars(x, one = .15, point = NULL), c("", "*", "*", "**", "***") ) }) test_that("symmetric_limits() works", { expect_equal( symmetric_limits(c(-1, 5)), c(-5, 5) ) expect_equal( symmetric_limits(c(-8, 5)), c(-8, 8) ) }) ggstats/tests/testthat.R0000644000176200001440000000060214357760261015064 0ustar liggesusers# This file is part of the standard setup for testthat. # It is recommended that you do not modify it. # # Where should you do additional test configuration? # Learn more about the roles of various files in: # * https://r-pkgs.org/tests.html # * https://testthat.r-lib.org/reference/test_package.html#special-files library(testthat) library(ggstats) test_check("ggstats") ggstats/tests/spelling.R0000644000176200001440000000023314672600601015030 0ustar liggesusersif (requireNamespace("spelling", quietly = TRUE)) spelling::spell_check_test( vignettes = TRUE, error = FALSE, skip_on_cran = TRUE ) ggstats/MD50000644000176200001440000001354514674044142012254 0ustar liggesusers468da12c623ed8efc03f059e9b59c155 *DESCRIPTION b44661e2a33da91a4f2aa745ddecbed9 *NAMESPACE 99c37d0cf010872d7cb05189dff884c1 *NEWS.md d901396dd3f60e4c0c889cfe0f3a8397 *R/geom_diverging.R 79a6d70006904f6bd1ce00b774551ae9 *R/geom_stripped_rows.R f81bb0e370788b3c0405e8c5c5b7a9d3 *R/ggcascade.R 172b0161e0be58ff5afb88c21ba7aa30 *R/ggcoef_model.R 605d28362e2719297344e63698f38c6c *R/gglikert.R 87495891682f9d0dd09b1676ec037f59 *R/ggstats-package.R 953e73724fb8b0057a745c342d9d7b22 *R/ggsurvey.R 138e738c7c1eb5d7b77889c2514b8ac6 *R/hex_bw.R c98e4b527646b20b3eb12f971ea38ea6 *R/label_number_abs.R 53777b19a7546712a32a9b128b739f4c *R/pal_extender.R 88c2ad8cb862d496d4d191ff4122ef4a *R/position_likert.R 3b1fdb66cd57067a20e46728f164c55c *R/round_any.R 365376ccbadc09cf99d6282994843ef7 *R/scale_fill_likert.R da97f039976af617e0731565c2ab13f3 *R/signif_stars.R 4c6668b24d12e94b24249afae6eaee11 *R/stat_cross.R 7ceb3551037fb7dcfc2580a7113906ab *R/stat_prop.R c272fb908cff0cc0d37625c706c55173 *R/stat_weighted_mean.R 2812c01ed28845bb99c972976e5301a4 *R/symmetric_limits.R e66c066897522ee3c467fb77654268ba *R/weighted_quantile.R 30b51ffb810a3156f834e004b11b5950 *R/weighted_sum.R 9441ea360a282aa4eb19dfe5719dd3e2 *README.md c5fda4979d85c8b676abe24aa50e2919 *build/vignette.rds ad8da455be04b36a8782e908cf025ae2 *inst/WORDLIST f6502b087b59c2a2c92dbba48b363085 *inst/doc/geom_diverging.R 20b0ae8b98046c6881506719608ea6e6 *inst/doc/geom_diverging.Rmd 8c29c52fe9d43d6477663cda7b591750 *inst/doc/geom_diverging.html 2db7a2e4639b903ffa4c102049a48935 *inst/doc/ggcoef_model.R 2993c011720d9a23a3f5a1d33e535682 *inst/doc/ggcoef_model.Rmd ffe635927ff92f22c6184ceffe38b69e *inst/doc/ggcoef_model.html 811f81af02614832973666fa2a5939a1 *inst/doc/gglikert.R 4c258131d3a1cbab6792e71ea6b80d06 *inst/doc/gglikert.Rmd b87eeddd3bdba1cfee17c9e86c72fdce *inst/doc/gglikert.html 1b8081a7ad40a9dd366a906798cc7300 *inst/doc/stat_cross.R bceaf8ba6563ed5198d7e8cd325ec352 *inst/doc/stat_cross.Rmd a6035411b982cc113ebcb7e666fcd83c *inst/doc/stat_cross.html 55d63c39d237804640b959599a466805 *inst/doc/stat_prop.R b5dd71e6e2bce8814cca82cab4b89768 *inst/doc/stat_prop.Rmd afa34a64c2aaf35f696bc4dcc5e6fe91 *inst/doc/stat_prop.html 06e26e6b115620dae874f56b5ff93f16 *inst/doc/stat_weighted_mean.R 8b364b651c16d66c845af52161f585b4 *inst/doc/stat_weighted_mean.Rmd 5cd6579c0525126f41e95760b44a4adf *inst/doc/stat_weighted_mean.html 613bdbc4f6d83370ef17432b0635bdb6 *man/augment_chisq_add_phi.Rd b3e8ba6641adf60b0d8f8e72d2920ef7 *man/figures/README-unnamed-chunk-10-1.png ba380e7ffae46bec9e27ba8fad30e905 *man/figures/README-unnamed-chunk-11-1.png efd1211d099a4efe2fa538769a7ca5ee *man/figures/README-unnamed-chunk-4-1.png 2a3632c8ce22c9ede4449226b6b451dc *man/figures/README-unnamed-chunk-4-2.png 575c0ef96464cbb8407d5a4a9fc09460 *man/figures/README-unnamed-chunk-5-1.png cb36fca2fe78700b46074a33eee27da2 *man/figures/README-unnamed-chunk-6-1.png 2b21a8a438efaa0379e6f7c0eadfaebb *man/figures/README-unnamed-chunk-7-1.png ede7edf7937a5f04052ea0c2514a891d *man/figures/README-unnamed-chunk-8-1.png 080d42a1bf5da61b6442ce72001d9645 *man/figures/README-unnamed-chunk-9-1.png cb1e46f469cfbbbde29c8b5113e1d789 *man/figures/lifecycle-archived.svg c0d2e5a54f1fa4ff02bf9533079dd1f7 *man/figures/lifecycle-defunct.svg a1b8c987c676c16af790f563f96cbb1f *man/figures/lifecycle-deprecated.svg c3978703d8f40f2679795335715e98f4 *man/figures/lifecycle-experimental.svg 952b59dc07b171b97d5d982924244f61 *man/figures/lifecycle-maturing.svg 27b879bf3677ea76e3991d56ab324081 *man/figures/lifecycle-questioning.svg 53b3f893324260b737b3c46ed2a0e643 *man/figures/lifecycle-stable.svg 1c1fe7a759b86dc6dbcbe7797ab8246c *man/figures/lifecycle-superseded.svg 9fab84240be11446cbc7d47a3cba010a *man/geom_diverging.Rd 5a4c22fbbc5d167a8e0554fcb449fcb6 *man/geom_stripped_rows.Rd 848bbadf3889ef0c44377462b8943b98 *man/ggcascade.Rd 67ded732d02d796c58938288b22e35eb *man/ggcoef_model.Rd 9f66f7713f5f4ea4051891a2aa6fda5e *man/gglikert.Rd 50314b608b6fe16a9bfdc8c272728f37 *man/ggstats-package.Rd f2624df8c40b05c304bbb80250b12770 *man/ggsurvey.Rd fd9e715c1aebb5a9a96a5f5c08821cd7 *man/hex_bw.Rd a20fbb6f509575a4b439a0450276857f *man/label_number_abs.Rd 0531b55b43d14c617c0674168b40f357 *man/pal_extender.Rd d34275c502c52dc83c1955e444feb8e8 *man/position_likert.Rd 87de156ae0d0bcc84a9fdd9d45db32e9 *man/round_any.Rd 2e2298b6ad8b5d90a8bdb449786c192f *man/scale_fill_likert.Rd ed4752eb6f36bd29490e9b14dc376a21 *man/signif_stars.Rd 0994a6d55ff3c567c45c9f75b7b56255 *man/stat_cross.Rd 0ff3dbc1e3a424e6e3dce8a0850835f5 *man/stat_prop.Rd ec0ec051245f9e1d47f9f0ce8df87137 *man/stat_weighted_mean.Rd f88cb1037595dee61eb600697abef8ed *man/symmetric_limits.Rd ca70a231c2ab7cd2bfb3ef3ebc63fe4f *man/weighted.median.Rd fe3c22bb256c150ec50eb9fb3ed843a4 *man/weighted.sum.Rd 1b7ff84c1f3d4ea54194c6b7424b930a *tests/spelling.R c7758487796fdefd18c2ffda1429ca23 *tests/testthat.R ec7aca3f4fb8c5b0db00a135c302d4d1 *tests/testthat/test-geom_stripped.R 252c4aa9bc6d47d2f516c6988fcd0de5 *tests/testthat/test-ggcascade.R c3488023ce73588cee5f0f89df13fa88 *tests/testthat/test-ggcoef_model.R 7531540cf2a7217db9d16e41d12bba65 *tests/testthat/test-gglikert.R 3812959b4e98027d513ca7c847644084 *tests/testthat/test-pal_extender.R 9d8a8a57e35a25f34b669fe70fce07b9 *tests/testthat/test-position_likert.R 54aea6d92dcb6888b7e1d85b47e27c41 *tests/testthat/test-stat_cross.R 3bf309de7281c33895481bb62dd92bb2 *tests/testthat/test-stat_prop.R a850c441de4f629f540d2bffe68711cd *tests/testthat/test-stat_weighted_mean.R 06f67c29001808c7d4694200ef0745d7 *tests/testthat/test-utilities.R 86c282eb2902de49b32827e44ab5113a *tests/testthat/test_ggsurvey.R 20b0ae8b98046c6881506719608ea6e6 *vignettes/geom_diverging.Rmd 2993c011720d9a23a3f5a1d33e535682 *vignettes/ggcoef_model.Rmd 4c258131d3a1cbab6792e71ea6b80d06 *vignettes/gglikert.Rmd bceaf8ba6563ed5198d7e8cd325ec352 *vignettes/stat_cross.Rmd b5dd71e6e2bce8814cca82cab4b89768 *vignettes/stat_prop.Rmd 8b364b651c16d66c845af52161f585b4 *vignettes/stat_weighted_mean.Rmd ggstats/R/0000755000176200001440000000000014674033502012133 5ustar liggesusersggstats/R/label_number_abs.R0000644000176200001440000000223714527332004015532 0ustar liggesusers#' Label absolute values #' #' @param ... arguments passed to [scales::label_number()] or #' [scales::label_percent()] #' @param hide_below if provided, values below `hide_below` will be masked #' (i.e. an empty string `""` will be returned) #' @returns A "labelling" function, , i.e. a function that takes a vector and #' returns a character vector of same length giving a label for each input #' value. #' @seealso [scales::label_number()], [scales::label_percent()] #' @export #' @examples #' x <- c(-0.2, -.05, 0, .07, .25, .66) #' #' scales::label_number()(x) #' label_number_abs()(x) #' #' scales::label_percent()(x) #' label_percent_abs()(x) #' label_percent_abs(hide_below = .1)(x) label_number_abs <- function(..., hide_below = NULL) { function(x) { res <- scales::label_number(...)(abs(x)) if (!is.null(hide_below)) { res[abs(x) < hide_below] <- "" } res } } #' @rdname label_number_abs #' @export label_percent_abs <- function(..., hide_below = NULL) { function(x) { res <- scales::label_percent(...)(abs(x)) if (!is.null(hide_below)) { res[abs(x) < hide_below] <- "" } res } } ggstats/R/geom_stripped_rows.R0000644000176200001440000001314514674033502016175 0ustar liggesusers#' Alternating Background Color #' #' Add alternating background color along the y-axis. The geom takes default #' aesthetics `odd` and `even` that receive color codes. #' #' @inheritParams ggplot2::layer #' @inheritParams ggplot2::geom_rect #' @param xfrom,xto limitation of the strips along the x-axis #' @param width width of the strips #' @param nudge_x,nudge_y horizontal or vertical adjustment to nudge strips by #' @export #' @return A `ggplot2` plot with the added geometry. #' @examplesIf requireNamespace("reshape") #' data(tips, package = "reshape") #' #' library(ggplot2) #' p <- ggplot(tips) + #' aes(x = time, y = day) + #' geom_count() + #' theme_light() #' #' p #' p + geom_stripped_rows() #' p + geom_stripped_cols() #' p + geom_stripped_rows() + geom_stripped_cols() #' #' \donttest{ #' p <- ggplot(tips) + #' aes(x = total_bill, y = day) + #' geom_count() + #' theme_light() #' p #' p + geom_stripped_rows() #' p + geom_stripped_rows() + scale_y_discrete(expand = expansion(0, 0.5)) #' p + geom_stripped_rows(xfrom = 10, xto = 35) #' p + geom_stripped_rows(odd = "blue", even = "yellow") #' p + geom_stripped_rows(odd = "blue", even = "yellow", alpha = .1) #' p + geom_stripped_rows(odd = "#00FF0022", even = "#FF000022") #' #' p + geom_stripped_cols() #' p + geom_stripped_cols(width = 10) #' p + geom_stripped_cols(width = 10, nudge_x = 5) #' } geom_stripped_rows <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., show.legend = NA, inherit.aes = TRUE, xfrom = -Inf, xto = Inf, width = 1, nudge_y = 0) { ggplot2::layer( data = data, mapping = mapping, stat = stat, geom = GeomStrippedRows, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( xfrom = xfrom, xto = xto, width = width, nudge_y = nudge_y, ... ) ) } GeomStrippedRows <- ggplot2::ggproto("GeomStrippedRows", ggplot2::Geom, required_aes = c("y"), default_aes = ggplot2::aes( odd = "#11111111", even = "#00000000", alpha = NA, colour = NA, linetype = "solid", linewidth = .5 ), draw_key = ggplot2::draw_key_rect, draw_panel = function(data, panel_params, coord, xfrom, xto, width = 1, nudge_y = 0) { ggplot2::GeomRect$draw_panel( data |> dplyr::mutate( y = round_any(.data$y, width), ymin = .data$y - width / 2 + nudge_y, ymax = .data$y + width / 2 + nudge_y, xmin = xfrom, xmax = xto ) |> dplyr::select(dplyr::all_of(c( "xmin", "xmax", "ymin", "ymax", "odd", "even", "alpha", "colour", "linetype", "linewidth" ))) |> dplyr::distinct(.data$ymin, .keep_all = TRUE) |> dplyr::arrange(.data$ymin) |> dplyr::mutate( .n = dplyr::row_number(), fill = dplyr::if_else( .data$.n %% 2L == 1L, true = .data$odd, false = .data$even ) ) |> dplyr::select(-dplyr::all_of(c(".n", "odd", "even"))), panel_params, coord ) } ) #' @rdname geom_stripped_rows #' @param yfrom,yto limitation of the strips along the y-axis #' @export geom_stripped_cols <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., show.legend = NA, inherit.aes = TRUE, yfrom = -Inf, yto = Inf, width = 1, nudge_x = 0) { ggplot2::layer( data = data, mapping = mapping, stat = stat, geom = GeomStrippedCols, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( yfrom = yfrom, yto = yto, width = width, nudge_x = nudge_x, ... ) ) } GeomStrippedCols <- ggplot2::ggproto("GeomStrippedCols", ggplot2::Geom, required_aes = c("y"), default_aes = ggplot2::aes( odd = "#11111111", even = "#00000000", alpha = NA, colour = NA, linetype = "solid", linewidth = .5 ), draw_key = ggplot2::draw_key_rect, draw_panel = function(data, panel_params, coord, yfrom, yto, width = 1, nudge_x = 0) { ggplot2::GeomRect$draw_panel( data |> dplyr::mutate( x = round_any(.data$x, width), xmin = .data$x - width / 2 + nudge_x, xmax = .data$x + width / 2 + nudge_x, ymin = yfrom, ymax = yto ) |> dplyr::select(dplyr::all_of(c( "xmin", "xmax", "ymin", "ymax", "odd", "even", "alpha", "colour", "linetype", "linewidth" ))) |> dplyr::distinct(.data$xmin, .keep_all = TRUE) |> dplyr::arrange(.data$xmin) |> dplyr::mutate( .n = dplyr::row_number(), fill = dplyr::if_else( .data$.n %% 2L == 1L, true = .data$odd, false = .data$even ) ) |> dplyr::select(-dplyr::all_of(c(".n", "odd", "even"))), panel_params, coord ) } ) ggstats/R/round_any.R0000644000176200001440000000140614600506637014260 0ustar liggesusers#' Round to multiple of any number. # #' @param x numeric or date-time (POSIXct) vector to round #' @param accuracy number to round to; for POSIXct objects, a number of seconds #' @param f rounding function: \code{\link{floor}}, \code{\link{ceiling}} or #' \code{\link{round}} #' @source adapted from `plyr` #' @export #' @examples #' round_any(1.865, accuracy = .25) round_any <- function(x, accuracy, f = round) { UseMethod("round_any") } #' @export round_any.numeric <- function(x, accuracy, f = round) { f(x / accuracy) * accuracy } #' @export round_any.POSIXct <- function(x, accuracy, f = round) { tz <- format(x[1], "%Z") xr <- round_any(as.numeric(x), accuracy, f) as.POSIXct(xr, origin = "1970-01-01 00:00.00 UTC", tz = tz) } ggstats/R/position_likert.R0000644000176200001440000002332414674033502015500 0ustar liggesusers#' Stack objects on top of each another and center them around 0 #' #' `position_diverging()` stacks bars on top of each other and #' center them around zero (the same number of categories are displayed on #' each side). #' `position_likert()` uses proportions instead of counts. This type of #' presentation is commonly used to display Likert-type scales. #' #' #' It is recommended to use `position_likert()` with `stat_prop()` #' and its `complete` argument (see examples). #' #' @param vjust Vertical adjustment for geoms that have a position #' (like points or lines), not a dimension (like bars or areas). Set to #' `0` to align with the bottom, `0.5` for the middle, #' and `1` (the default) for the top. #' @param reverse If `TRUE`, will reverse the default stacking order. #' This is useful if you're rotating both the plot and legend. #' @param exclude_fill_values Vector of values from the variable associated with #' the `fill` aesthetic that should not be displayed (but still taken into #' account for computing proportions) #' @param cutoff number of categories to be displayed negatively (i.e. on the #' left of the x axis or the bottom of the y axis), could be a decimal value: #' `2` to display negatively the two first categories, `2.5` to display #' negatively the two first categories and half of the third, `2.2` to display #' negatively the two first categories and a fifth of the third (see examples). #' By default (`NULL`), it will be equal to the number of categories divided #' by 2, i.e. it will be centered. #' @seealso See [ggplot2::position_stack()] and [ggplot2::position_fill()] #' @export #' @examples #' library(ggplot2) #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "fill") + #' scale_x_continuous(label = scales::label_percent()) + #' xlab("proportion") #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "likert") + #' scale_x_continuous(label = label_percent_abs()) + #' scale_fill_likert() + #' xlab("proportion") #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "stack") + #' scale_fill_likert(pal = scales::brewer_pal(palette = "PiYG")) #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "diverging") + #' scale_x_continuous(label = label_number_abs()) + #' scale_fill_likert() #' #' \donttest{ #' # Reverse order ------------------------------------------------------------- #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = position_likert(reverse = TRUE)) + #' scale_x_continuous(label = label_percent_abs()) + #' scale_fill_likert() + #' xlab("proportion") #' #' # Custom center ------------------------------------------------------------- #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = position_likert(cutoff = 1)) + #' scale_x_continuous(label = label_percent_abs()) + #' scale_fill_likert(cutoff = 1) + #' xlab("proportion") #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = position_likert(cutoff = 3.75)) + #' scale_x_continuous(label = label_percent_abs()) + #' scale_fill_likert(cutoff = 3.75) + #' xlab("proportion") #' #' # Missing items ------------------------------------------------------------- #' # example with a level not being observed for a specific value of y #' d <- diamonds #' d <- d[!(d$cut == "Premium" & d$clarity == "I1"), ] #' d <- d[!(d$cut %in% c("Fair", "Good") & d$clarity == "SI2"), ] #' #' # by default, the two lowest bar are not properly centered #' ggplot(d) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "likert") + #' scale_fill_likert() #' #' # use stat_prop() with `complete = "fill"` to fix it #' ggplot(d) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "likert", stat = "prop", complete = "fill") + #' scale_fill_likert() #' #' # Add labels ---------------------------------------------------------------- #' #' custom_label <- function(x) { #' p <- scales::percent(x, accuracy = 1) #' p[x < .075] <- "" #' p #' } #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "likert") + #' geom_text( #' aes(by = clarity, label = custom_label(after_stat(prop))), #' stat = "prop", #' position = position_likert(vjust = .5) #' ) + #' scale_x_continuous(label = label_percent_abs()) + #' scale_fill_likert() + #' xlab("proportion") #' #' # Do not display specific fill values --------------------------------------- #' # (but taken into account to compute proportions) #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = position_likert(exclude_fill_values = "Very Good")) + #' scale_x_continuous(label = label_percent_abs()) + #' scale_fill_likert() + #' xlab("proportion") #' } position_likert <- function(vjust = 1, reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL) { ggplot2::ggproto( NULL, PositionLikert, vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ) } #' @export #' @rdname position_likert position_diverging <- function(vjust = 1, reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL) { ggplot2::ggproto( NULL, PositionDiverging, vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ) } #' @rdname position_likert #' @format NULL #' @usage NULL #' @export PositionLikert <- ggplot2::ggproto("PositionLikert", Position, type = NULL, vjust = 1, fill = TRUE, exclude_fill_values = NULL, cutoff = NULL, reverse = FALSE, setup_params = function(self, data) { flipped_aes <- ggplot2::has_flipped_aes(data) data <- ggplot2::flip_data(data, flipped_aes) list( var = self$var %||% likert_var(data), fill = self$fill, vjust = self$vjust, reverse = self$reverse, exclude_fill_values = self$exclude_fill_values, cutoff = self$cutoff, flipped_aes = flipped_aes ) }, setup_data = function(self, data, params) { data <- ggplot2::flip_data(data, params$flipped_aes) if (is.null(params$var)) { return(data) } if (!"ymin" %in% names(data)) data$ymin <- 0 data$ymax <- switch(params$var, y = data$y, ymax = as.numeric(ifelse(data$ymax == 0, data$ymin, data$ymax)) ) data <- ggplot2::remove_missing( data, vars = c("x", "xmin", "xmax", "y"), name = "position_likert" ) ggplot2::flip_data(data, params$flipped_aes) }, compute_panel = function(data, params, scales) { data <- ggplot2::flip_data(data, params$flipped_aes) if (is.null(params$var)) { return(data) } negative <- data$ymax < 0 negative[is.na(negative)] <- FALSE if (any(negative)) { cli::cli_abort("{.fn position_liker} does not work with negative values") } data <- data |> tidyr::nest(.by = "x", .key = "d") |> dplyr::mutate( d = purrr::map( .data$d, function(x) { pos_likert( x, vjust = params$vjust, fill = params$fill, reverse = params$reverse, exclude_fill_values = params$exclude_fill_values, cutoff = params$cutoff ) } ) ) |> tidyr::unnest(cols = "d") ggplot2::flip_data(data, params$flipped_aes) } ) pos_likert <- function(df, vjust = 1, fill = FALSE, reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL) { if (reverse) { df <- df[nrow(df):1, ] # nolint } if (fill) { df$y <- df$y / sum(abs(df$y), na.rm = TRUE) } # Values to be excluded after computation of proportions if (!is.null(exclude_fill_values) && "fill" %in% names(df)) { exclude <- df$fill %in% exclude_fill_values df <- df[!exclude, ] } n <- nrow(df) + 1 y <- ifelse(is.na(df$y), 0, df$y) heights <- c(0, cumsum(y)) df$ymin <- pmin(heights[-n], heights[-1]) df$ymax <- pmax(heights[-n], heights[-1]) df$y <- (1 - vjust) * df$ymin + vjust * df$ymax # Now, we have to center the results if (is.null(cutoff)) cutoff <- nrow(df) / 2 if (cutoff < 0) cli::cli_abort("{.arg cutoff} cannot be negative.") if (cutoff > nrow(df)) cli::cli_abort( "{.arg cutoff} cannot be higher than the number of categories." ) if (cutoff == nrow(df)) { y_adjust <- df$ymax[cutoff] } else if (cutoff < 1) { y_adjust <- cutoff * df$ymax[1] } else { y_adjust <- df$ymax[cutoff %/% 1] + cutoff %% 1 * (df$ymax[cutoff %/% 1 + 1] - df$ymax[cutoff %/% 1]) } df$y <- df$y - y_adjust df$ymin <- df$ymin - y_adjust df$ymax <- df$ymax - y_adjust df } #' @rdname position_likert #' @format NULL #' @usage NULL #' @export PositionDiverging <- ggproto("PositionDiverging", PositionLikert, fill = FALSE ) likert_var <- function(data) { if (!is.null(data$ymax)) { "ymax" } else if (!is.null(data$y)) { "y" } else { cli::cli_warn(c( "Stacking requires either the {.field ymin} {.emph and} {.field ymin}", "or the {.field y} aesthetics", "i" = "Maybe you want {.code position = \"identity\"}?" )) NULL } } ggstats/R/stat_cross.R0000644000176200001440000001574314674033502014454 0ustar liggesusers#' Compute cross-tabulation statistics #' #' Computes statistics of a 2-dimensional matrix using [broom::augment.htest]. #' #' @inheritParams ggplot2::stat_identity #' @param geom Override the default connection with #' [ggplot2::geom_point()]. #' @param na.rm If `TRUE`, the default, missing values are #' removed with a warning. #' If `TRUE`, missing values are silently removed. #' @param keep.zero.cells If `TRUE`, cells with no observations are kept. #' @section Aesthetics: #' `stat_cross()` requires the **x** and the **y** aesthetics. #' @section Computed variables: #' \describe{ #' \item{observed}{number of observations in x,y} #' \item{prop}{proportion of total} #' \item{row.prop}{row proportion} #' \item{col.prop}{column proportion} #' \item{expected}{expected count under the null hypothesis} #' \item{resid}{Pearson's residual} #' \item{std.resid}{standardized residual} #' \item{row.observed}{total number of observations within row} #' \item{col.observed}{total number of observations within column} #' \item{total.observed}{total number of observations within the table} #' \item{phi}{phi coefficients, see [augment_chisq_add_phi()]} #' } #' #' @export #' @return A `ggplot2` plot with the added statistic. #' @seealso `vignette("stat_cross")` #' @examples #' library(ggplot2) #' d <- as.data.frame(Titanic) #' #' # plot number of observations #' ggplot(d) + #' aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) + #' stat_cross() + #' scale_size_area(max_size = 20) #' #' # custom shape and fill colour based on chi-squared residuals #' ggplot(d) + #' aes( #' x = Class, y = Survived, weight = Freq, #' size = after_stat(observed), fill = after_stat(std.resid) #' ) + #' stat_cross(shape = 22) + #' scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + #' scale_size_area(max_size = 20) #' #' \donttest{ #' # custom shape and fill colour based on phi coeffients #' ggplot(d) + #' aes( #' x = Class, y = Survived, weight = Freq, #' size = after_stat(observed), fill = after_stat(phi) #' ) + #' stat_cross(shape = 22) + #' scale_fill_steps2(show.limits = TRUE) + #' scale_size_area(max_size = 20) #' #' #' # plotting the number of observations as a table #' ggplot(d) + #' aes( #' x = Class, y = Survived, weight = Freq, label = after_stat(observed) #' ) + #' geom_text(stat = "cross") #' #' # Row proportions with standardized residuals #' ggplot(d) + #' aes( #' x = Class, y = Survived, weight = Freq, #' label = scales::percent(after_stat(row.prop)), #' size = NULL, fill = after_stat(std.resid) #' ) + #' stat_cross(shape = 22, size = 30) + #' geom_text(stat = "cross") + #' scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + #' facet_grid(Sex ~ .) + #' labs(fill = "Standardized residuals") + #' theme_minimal() #' } stat_cross <- function(mapping = NULL, data = NULL, geom = "point", position = "identity", ..., na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, keep.zero.cells = FALSE) { params <- list( na.rm = na.rm, keep.zero.cells = keep.zero.cells, ... ) layer( data = data, mapping = mapping, stat = StatCross, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = params ) } #' @rdname stat_cross #' @format NULL #' @usage NULL #' @export StatCross <- ggplot2::ggproto( "StatCross", ggplot2::Stat, required_aes = c("x", "y"), default_aes = ggplot2::aes(weight = 1), setup_params = function(data, params) { params }, extra_params = c("na.rm"), compute_panel = function(self, data, scales, keep.zero.cells = FALSE) { if (is.null(data$weight)) { data$weight <- rep(1, nrow(data)) } # compute cross statistics panel <- augment_chisq_add_phi( chisq.test(xtabs(weight ~ y + x, data = data)) ) panel_names <- names(panel) for (to_name in c( "observed", "prop", "row.prop", "col.prop", "expected", "resid", "std.resid", "row.observed", "col.observed", "total.observed", "phi" )) { from_name <- paste0(".", to_name) panel_names[which(panel_names == from_name)] <- to_name } names(panel) <- panel_names # to handle the fact that ggplot2 could transform factors into integers # before computation of the statistic if (is.numeric(data$x)) panel$x <- as.numeric(panel$x) if (is.numeric(data$y)) panel$y <- as.numeric(panel$y) # keeping first value of other aesthetics in data panel <- merge( panel, dplyr::select(data, -dplyr::all_of("PANEL")), by = c("x", "y"), all.x = TRUE ) panel <- panel |> dplyr::distinct(.data$x, .data$y, .keep_all = TRUE) if (!keep.zero.cells) { panel <- panel[panel$observed != 0, ] } panel } ) # Compute phi coefficients # see psych::phi() and GDAtools::phi.table() .compute_phi <- function(.prop, .row.observed, .col.observed, .total.observed) { rp <- .row.observed / .total.observed cp <- .col.observed / .total.observed (.prop - rp * cp) / sqrt(rp * (1 - rp) * cp * (1 - cp)) } #' Augment a chi-squared test and compute phi coefficients #' @details #' Phi coefficients are a measurement of the degree of association #' between two binary variables. #' #' - A value between -1.0 to -0.7 indicates a strong negative association. #' - A value between -0.7 to -0.3 indicates a weak negative association. #' - A value between -0.3 to +0.3 indicates a little or no association. #' - A value between +0.3 to +0.7 indicates a weak positive association. #' - A value between +0.7 to +1.0 indicates a strong positive association. #' @export #' @param x a chi-squared test as returned by [stats::chisq.test()] #' @return A `tibble`. #' @seealso [stat_cross()], `GDAtools::phi.table()` or `psych::phi()` #' @examples #' tab <- xtabs(Freq ~ Sex + Class, data = as.data.frame(Titanic)) #' augment_chisq_add_phi(chisq.test(tab)) augment_chisq_add_phi <- function(x) { if (!inherits(x, "htest") && names(x$statistic) != "X-squared") { cli::cli_abort(paste( "{.arg x} should be the result of a chi-squared test", "(see {.fn stats::chisq.test})." )) } broom::augment(x) |> dplyr::group_by(dplyr::across(1)) |> dplyr::mutate(.row.observed = sum(.data$.observed)) |> dplyr::group_by(dplyr::across(2)) |> dplyr::mutate(.col.observed = sum(.data$.observed)) |> dplyr::ungroup() |> dplyr::mutate( .total.observed = sum(.data$.observed), .phi = .compute_phi( .data$.prop, .data$.row.observed, .data$.col.observed, .data$.total.observed ) ) } ggstats/R/stat_weighted_mean.R0000644000176200001440000000704114415736022016113 0ustar liggesusers#' Compute weighted y mean #' #' This statistic will compute the mean of **y** aesthetic for #' each unique value of **x**, taking into account **weight** #' aesthetic if provided. #' #' @section Computed variables: #' \describe{ #' \item{y}{weighted y (numerator / denominator)} #' \item{numerator}{numerator} #' \item{denominator}{denominator} #' } #' #' @inheritParams ggplot2::stat_bin #' @param geom Override the default connection with [ggplot2::geom_point()]. #' @seealso `vignette("stat_weighted_mean")` #' @export #' @return A `ggplot2` plot with the added statistic. #' @examplesIf requireNamespace("reshape") #' @examples #' library(ggplot2) #' #' data(tips, package = "reshape") #' #' ggplot(tips) + #' aes(x = day, y = total_bill) + #' geom_point() #' #' ggplot(tips) + #' aes(x = day, y = total_bill) + #' stat_weighted_mean() #' #' \donttest{ #' ggplot(tips) + #' aes(x = day, y = total_bill, group = 1) + #' stat_weighted_mean(geom = "line") #' #' ggplot(tips) + #' aes(x = day, y = total_bill, colour = sex, group = sex) + #' stat_weighted_mean(geom = "line") #' #' ggplot(tips) + #' aes(x = day, y = total_bill, fill = sex) + #' stat_weighted_mean(geom = "bar", position = "dodge") #' #' # computing a proportion on the fly #' if (requireNamespace("scales")) { #' ggplot(tips) + #' aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) + #' stat_weighted_mean(geom = "bar", position = "dodge") + #' scale_y_continuous(labels = scales::percent) #' } #' } #' @examples #' library(ggplot2) #' #' # taking into account some weights #' if (requireNamespace("scales")) { #' d <- as.data.frame(Titanic) #' ggplot(d) + #' aes( #' x = Class, y = as.integer(Survived == "Yes"), #' weight = Freq, fill = Sex #' ) + #' geom_bar(stat = "weighted_mean", position = "dodge") + #' scale_y_continuous(labels = scales::percent) + #' labs(y = "Survived") #' } stat_weighted_mean <- function(mapping = NULL, data = NULL, geom = "point", position = "identity", ..., na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE) { layer( data = data, mapping = mapping, stat = StatWeightedMean, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list( na.rm = na.rm, orientation = orientation, ... ) ) } #' @rdname stat_weighted_mean #' @format NULL #' @usage NULL #' @export StatWeightedMean <- ggplot2::ggproto( "StatSummary", ggplot2::Stat, required_aes = c("x", "y"), extra_params = c("na.rm", "orientation"), setup_params = function(data, params) { params$flipped_aes <- ggplot2::has_flipped_aes(data, params) params }, compute_panel = function(data, scales, na.rm = FALSE, flipped_aes = FALSE) { data <- ggplot2::flip_data(data, flipped_aes) if (is.null(data$weight)) { data$weight <- rep(1, nrow(data)) } summarised <- aggregate( cbind(numerator = y * weight, denominator = weight) ~ ., data, FUN = sum, na.rm = TRUE ) summarised$y <- summarised$numerator / summarised$denominator summarised$flipped_aes <- flipped_aes ggplot2::flip_data(summarised, flipped_aes) } ) ggstats/R/weighted_sum.R0000644000176200001440000000055314674033502014745 0ustar liggesusers#' Weighted Sum #' #' @param x a numeric vector of values #' @param w a numeric vector of weights #' @param na.rm a logical indicating whether to ignore `NA` values #' @returns A numeric vector. #' @export #' @examples #' x <- 1:20 #' w <- runif(20) #' weighted.sum(x, w) weighted.sum <- function(x, w, na.rm = TRUE) { sum(x * w, na.rm = na.rm) } ggstats/R/geom_diverging.R0000644000176200001440000002152614672600601015247 0ustar liggesusers#' Geometries for diverging bar plots #' #' These geometries are similar to [`ggplot2::geom_bar()`] but provides #' different set of default values. #' #' - `geom_diverging()` is designed for stacked diverging bar plots, using #' [`position_diverging()`]. #' - `geom_likert()` is designed for Likert-type items. Using #' `position_likert()` (each bar sums to 100%). #' - `geom_pyramid()` is similar to `geom_diverging()` but uses #' proportions of the total instead of counts. #' #' To add labels on the bar plots, simply use `geom_diverging_text()`, #' `geom_likert_text()`, or `geom_pyramid_text()`. #' #' @param mapping Optional set of aesthetic mappings. #' @param data The data to be displayed in this layers. #' @param stat The statistical transformation to use on the data for this layer. #' @param position A position adjustment to use on the data for this layer. #' @param ... Other arguments passed on to [`ggplot2::geom_bar()`] #' @param complete An aesthetic for those unobserved values should be completed, #' see [`stat_prop()`]. Passed only if `stat = "prop"`. #' @param default_by Name of an aesthetic determining denominators by default, #' see [`stat_prop()`]. Passed only if `stat = "prop"`. #' @param height Statistic used, by default, to determine the height/width, #' see [`stat_prop()`]. Passed only if `stat = "prop"`. #' @param labels Statistic used, by default, to determine the labels, #' see [`stat_prop()`]. Passed only if `stat = "prop"`. #' @param labeller Labeller function to format labels, #' see [`stat_prop()`]. Passed only if `stat = "prop"`. #' @inheritParams position_likert #' @export #' @examples #' library(ggplot2) #' ggplot(diamonds) + #' aes(x = clarity, fill = cut) + #' geom_diverging() #' #' ggplot(diamonds) + #' aes(x = clarity, fill = cut) + #' geom_diverging(cutoff = 4) #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_likert() + #' geom_likert_text(aes(color = after_scale(hex_bw(.data$fill)))) #' #' d <- Titanic |> as.data.frame() #' #' ggplot(d) + #' aes(y = Class, fill = Sex, weight = Freq) + #' geom_diverging() + #' geom_diverging_text() #' #' ggplot(d) + #' aes(y = Class, fill = Sex, weight = Freq) + #' geom_pyramid() + #' geom_pyramid_text() geom_diverging <- function(mapping = NULL, data = NULL, stat = "prop", position = position_diverging( reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), ..., complete = "fill", default_by = "total", height = "count", reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL) { args <- list(...) if (stat == "prop") { args$complete <- complete args$default_by <- default_by args$height <- height } args$mapping <- mapping args$data <- data args$stat <- stat args$position <- position do.call(ggplot2::geom_bar, args) } #' @rdname geom_diverging #' @export geom_likert <- function(mapping = NULL, data = NULL, stat = "prop", position = position_likert( reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), ..., complete = "fill", default_by = "x", height = "prop", reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL) { args <- c(as.list(environment()), list(...)) do.call(geom_diverging, args) } #' @rdname geom_diverging #' @export geom_pyramid <- function(mapping = NULL, data = NULL, stat = "prop", position = position_diverging( reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), ..., complete = NULL, default_by = "total", height = "prop", reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL) { args <- c(as.list(environment()), list(...)) do.call(geom_diverging, args) } #' @rdname geom_diverging #' @export geom_diverging_text <- function(mapping = NULL, data = NULL, stat = "prop", position = position_diverging( vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), ..., complete = "fill", default_by = "total", height = "count", labels = "count", labeller = label_number_abs(hide_below = hide_below), reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL, vjust = 0.5, hide_below = NULL) { args <- list(...) if (stat == "prop") { args$complete <- complete args$default_by <- default_by args$height <- height args$labels <- labels args$labeller <- labeller } args$mapping <- mapping args$data <- data args$stat <- stat args$position <- position do.call(ggplot2::geom_text, args) } #' @rdname geom_diverging #' @param hide_below If provided, values below `hide_below` will be masked. #' Argument passed to [`label_number_abs()`] or [`label_percent_abs()`]. #' @export geom_likert_text <- function(mapping = NULL, data = NULL, stat = "prop", position = position_likert( vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), ..., complete = "fill", default_by = "x", height = "prop", labels = "prop", labeller = label_percent_abs( accuracy = 1, hide_below = hide_below ), reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL, vjust = 0.5, hide_below = NULL) { args <- c(as.list(environment()), list(...)) do.call(geom_diverging_text, args) } #' @rdname geom_diverging #' @export geom_pyramid_text <- function(mapping = NULL, data = NULL, stat = "prop", position = position_diverging( vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), ..., complete = NULL, default_by = "total", height = "prop", labels = "prop", labeller = label_percent_abs( accuracy = 1, hide_below = hide_below ), reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL, vjust = 0.5, hide_below = NULL) { args <- c(as.list(environment()), list(...)) do.call(geom_diverging_text, args) } ggstats/R/pal_extender.R0000644000176200001440000000427714625277577014764 0ustar liggesusers#' Extend a discrete colour palette #' #' If the palette returns less colours than requested, the list of colours #' will be expanded using [scales::pal_gradient_n()]. To be used with a #' sequential or diverging palette. Not relevant for qualitative palettes. #' #' @param pal A palette function, such as returned by [scales::brewer_pal], #' taking a number of colours as entry and returning a list of colours. #' @return A palette function. #' @export #' @examples #' pal <- scales::pal_brewer(palette = "PiYG") #' scales::show_col(pal(16)) #' scales::show_col(pal_extender(pal)(16)) pal_extender <- function(pal = scales::brewer_pal(palette = "BrBG")) { function(n) { cols <- suppressWarnings( stats::na.omit(pal(n)) ) if (length(cols) <= n) { cols <- scales::pal_gradient_n(cols)(seq(0, 1, length.out = n)) } cols } } #' @rdname pal_extender #' @param name The name of the scale. Used as the axis or legend title. #' If `waiver()`, the default, the name of the scale is taken from the first #' mapping used for that aesthetic. If `NULL`, the legend title will be omitted. #' @param ... Other arguments passed on to `discrete_scale()` to control name, #' limits, breaks, labels and so forth. #' @param aesthetics Character string or vector of character strings listing #' the name(s) of the aesthetic(s) that this scale works with. This can be #' useful, for example, to apply colour settings to the colour and fill #' aesthetics at the same time, via `aesthetics = c("colour", "fill")`. #' @export scale_fill_extended <- function(name = waiver(), ..., pal = scales::brewer_pal(palette = "BrBG"), aesthetics = "fill") { ggplot2::discrete_scale( aesthetics, name = name, palette = pal_extender(pal = pal), ... ) } #' @rdname pal_extender #' @export scale_colour_extended <- function(name = waiver(), ..., pal = scales::brewer_pal(palette = "BrBG"), aesthetics = "colour") { ggplot2::discrete_scale( aesthetics, name = name, palette = pal_extender(pal = pal), ... ) } ggstats/R/weighted_quantile.R0000644000176200001440000000675514527052132015772 0ustar liggesusers#' Weighted Median and Quantiles #' #' Compute the median or quantiles a set of numbers which have weights #' associated with them. #' #' @param x a numeric vector of values #' @param w a numeric vector of weights #' @param probs probabilities for which the quantiles should be computed, a #' numeric vector of values between 0 and 1 #' @param na.rm a logical indicating whether to ignore `NA` values #' @param type Integer specifying the rule for calculating the median or #' quantile, corresponding to the rules available for `stats:quantile()`. #' The only valid choices are type=1, 2 or 4. See Details. #' @details #' The `i`th observation `x[i]` is treated as having a weight proportional to #' `w[i]`. #' #' The weighted median is a value `m` such that the total weight of data less #' than or equal to `m` is equal to half the total weight. More generally, the #' weighted quantile with probability `p` is a value `q` such that the total #' weight of data less than or equal to `q` is equal to `p` times the total #' weight. #' #' If there is no such value, then #' #' - if `type = 1`, the next largest value is returned (this is the #' right-continuous inverse of the left-continuous cumulative distribution #' function); #' - if `type = 2`, the average of the two surrounding values is returned #' (the average of the right-continuous and left-continuous inverses); #' - if `type = 4`, linear interpolation is performed. #' #' Note that the default rule for `weighted.median()` is `type = 2`, consistent #' with the traditional definition of the median, while the default for #' `weighted.quantile()` is `type = 4`. #' @source These functions are adapted from their homonyms developed by Adrian #' Baddeley in the `spatstat` package. #' @returns A numeric vector. #' @export #' @examples #' x <- 1:20 #' w <- runif(20) #' weighted.median(x, w) #' weighted.quantile(x, w) weighted.median <- function(x, w, na.rm = TRUE, type = 2) { unname(weighted.quantile(x, probs = 0.5, w = w, na.rm = na.rm, type = type )) } #' @export #' @rdname weighted.median weighted.quantile <- function(x, w, probs = seq(0, 1, 0.25), na.rm = TRUE, type = 4) { x <- as.numeric(as.vector(x)) w <- as.numeric(as.vector(w)) if (length(x) == 0) { stop("No data given") } stopifnot(length(x) == length(w)) if (is.na(m <- match(type, c(1, 2, 4)))) { stop("Argument 'type' must equal 1, 2 or 4", call. = FALSE) } type <- c(1, 2, 4)[m] if (anyNA(x) || anyNA(w)) { ok <- !(is.na(x) | is.na(w)) x <- x[ok] w <- w[ok] } if (length(x) == 0) { stop("At least one non-NA value is required") } stopifnot(all(w >= 0)) if (all(w == 0)) { stop("All weights are zero", call. = FALSE) } oo <- order(x) x <- x[oo] w <- w[oo] Fx <- cumsum(w) / sum(w) if (length(x) > 1) { out <- switch(as.character(type), `1` = stats::approx(Fx, x, xout = probs, ties = "ordered", rule = 2, method = "constant", f = 1 ), `2` = stats::approx(Fx, x, xout = probs, ties = "ordered", rule = 2, method = "constant", f = 1 / 2 ), `4` = stats::approx(Fx, x, xout = probs, ties = "ordered", rule = 2, method = "linear" ) ) result <- out$y } else { result <- rep.int(x, length(probs)) } names(result) <- paste0( format(100 * probs, trim = TRUE), "%" ) return(result) } ggstats/R/scale_fill_likert.R0000644000176200001440000000557714657065717015761 0ustar liggesusers#' Colour scale for Likert-type plots #' #' This scale is similar to other diverging discrete colour scales, but allows #' to change the "center" of the scale using `cutoff` argument, as used by #' [position_likert()]. #' #' @param name The name of the scale. Used as the axis or legend title. #' If `waiver()`, the default, the name of the scale is taken from the first #' mapping used for that aesthetic. If `NULL`, the legend title will be omitted. #' @param ... Other arguments passed on to `discrete_scale()` to control name, #' limits, breaks, labels and so forth. #' @param pal A palette function taking a number of colours as entry and #' returning a list of colours (see examples), ideally a diverging palette #' @param cutoff Number of categories displayed negatively (see #' [position_likert()]) and therefore changing the center of the colour scale #' (see examples). #' @param aesthetics Character string or vector of character strings listing #' the name(s) of the aesthetic(s) that this scale works with. This can be #' useful, for example, to apply colour settings to the colour and fill #' aesthetics at the same time, via `aesthetics = c("colour", "fill")`. #' @examples #' library(ggplot2) #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "likert") + #' scale_x_continuous(label = label_percent_abs()) + #' xlab("proportion") #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = "likert") + #' scale_x_continuous(label = label_percent_abs()) + #' xlab("proportion") + #' scale_fill_likert() #' #' ggplot(diamonds) + #' aes(y = clarity, fill = cut) + #' geom_bar(position = position_likert(cutoff = 1)) + #' scale_x_continuous(label = label_percent_abs()) + #' xlab("proportion") + #' scale_fill_likert(cutoff = 1) #' @export scale_fill_likert <- function(name = waiver(), ..., pal = scales::brewer_pal(palette = "BrBG"), cutoff = NULL, aesthetics = "fill") { ggplot2::discrete_scale( aesthetics, name = name, palette = likert_pal(pal = pal, cutoff = cutoff), ... ) } #' @rdname scale_fill_likert #' @export likert_pal <- function(pal = scales::brewer_pal(palette = "BrBG"), cutoff = NULL) { function(n) { if (is.null(cutoff)) cutoff <- n / 2 if (cutoff < 0) cli::cli_abort("{.arg cutoff} should be positive.") if (cutoff > n) cli::cli_abort( "{.arg cutoff} higher than the number of requested colours." ) left <- floor(cutoff) center <- cutoff %% 1 > 0 right <- n - ceiling(cutoff) nc <- 2 * max(left, right) + center # needed colors cols <- pal_extender(pal = pal)(nc) if (left <= right) { cols[(nc - n + 1):nc] } else { cols[1:n] } } } ggstats/R/ggsurvey.R0000644000176200001440000000334314415524646014143 0ustar liggesusers#' Easy ggplot2 with survey objects #' #' A function to facilitate `ggplot2` graphs using a survey object. #' It will initiate a ggplot and map survey weights to the #' corresponding aesthetic. #' #' Graphs will be correct as long as only weights are required #' to compute the graph. However, statistic or geometry requiring #' correct variance computation (like [ggplot2::geom_smooth()]) will #' be statistically incorrect. #' #' @param design A survey design object, usually created with #' [survey::svydesign()] #' @param mapping Default list of aesthetic mappings to use for plot, #' to be created with [ggplot2::aes()]. #' @param ... Other arguments passed on to methods. Not currently used. #' @importFrom stats weights #' @return A `ggplot2` plot. #' @export #' @examplesIf requireNamespace("survey") #' data(api, package = "survey") #' dstrat <- survey::svydesign( #' id = ~1, strata = ~stype, #' weights = ~pw, data = apistrat, #' fpc = ~fpc #' ) #' ggsurvey(dstrat) + #' ggplot2::aes(x = cnum, y = dnum) + #' ggplot2::geom_count() #' #' d <- as.data.frame(Titanic) #' dw <- survey::svydesign(ids = ~1, weights = ~Freq, data = d) #' ggsurvey(dw) + #' ggplot2::aes(x = Class, fill = Survived) + #' ggplot2::geom_bar(position = "fill") ggsurvey <- function(design = NULL, mapping = NULL, ...) { if (!inherits(design, "survey.design")) { cli::cli_abort("{.var design} should be a {.cls survey.design} object.") } rlang::check_installed("survey") data <- design$variables data$.weights <- weights(design) if (is.null(mapping)) { mapping <- ggplot2::aes() } mapping$weight <- ggplot2::aes(weight = .data[[".weights"]])$weight ggplot2::ggplot(data, mapping, ...) } ggstats/R/ggcoef_model.R0000644000176200001440000012725114674033502014700 0ustar liggesusers#' Plot model coefficients #' #' `ggcoef_model()`, `ggcoef_table()`, `ggcoef_multinom()`, #' `ggcoef_multicomponents()` and `ggcoef_compare()` #' use [broom.helpers::tidy_plus_plus()] #' to obtain a `tibble` of the model coefficients, #' apply additional data transformation and then pass the #' produced `tibble` to `ggcoef_plot()` to generate the plot. #' #' For more control, you can use the argument `return_data = TRUE` to #' get the produced `tibble`, apply any transformation of your own and #' then pass your customized `tibble` to `ggcoef_plot()`. #' @inheritParams broom.helpers::tidy_plus_plus #' @param tidy_args Additional arguments passed to #' [broom.helpers::tidy_plus_plus()] and to `tidy_fun` #' @param model a regression model object #' @param conf.level the confidence level to use for the confidence #' interval if `conf.int = TRUE`; must be strictly greater than 0 #' and less than 1; defaults to 0.95, which corresponds to a 95 #' percent confidence interval #' @param show_p_values if `TRUE`, add p-value to labels #' @param signif_stars if `TRUE`, add significant stars to labels #' @param significance level (between 0 and 1) below which a #' coefficient is consider to be significantly different from 0 #' (or 1 if `exponentiate = TRUE`), `NULL` for not highlighting #' such coefficients #' @param significance_labels optional vector with custom labels #' for significance variable #' @param return_data if `TRUE`, will return the data.frame used #' for plotting instead of the plot #' @param ... parameters passed to [ggcoef_plot()] #' @return A `ggplot2` plot or a `tibble` if `return_data = TRUE`. #' @export #' @examples #' mod <- lm(Sepal.Length ~ Sepal.Width + Species, data = iris) #' ggcoef_model(mod) #' #' ggcoef_table(mod) #' #' #' \donttest{ #' ggcoef_table(mod, table_stat = c("estimate", "ci")) #' #' ggcoef_table( #' mod, #' table_stat_label = list( #' estimate = scales::label_number(.001) #' ) #' ) #' #' ggcoef_table(mod, table_text_size = 5, table_witdhs = c(1, 1)) #' #' # a logistic regression example #' d_titanic <- as.data.frame(Titanic) #' d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes")) #' mod_titanic <- glm( #' Survived ~ Sex * Age + Class, #' weights = Freq, #' data = d_titanic, #' family = binomial #' ) #' #' # use 'exponentiate = TRUE' to get the Odds Ratio #' ggcoef_model(mod_titanic, exponentiate = TRUE) #' #' ggcoef_table(mod_titanic, exponentiate = TRUE) #' #' # display intercepts #' ggcoef_model(mod_titanic, exponentiate = TRUE, intercept = TRUE) #' #' # customize terms labels #' ggcoef_model( #' mod_titanic, #' exponentiate = TRUE, #' show_p_values = FALSE, #' signif_stars = FALSE, #' add_reference_rows = FALSE, #' categorical_terms_pattern = "{level} (ref: {reference_level})", #' interaction_sep = " x " #' ) + #' ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) #' #' # display only a subset of terms #' ggcoef_model(mod_titanic, exponentiate = TRUE, include = c("Age", "Class")) #' #' # do not change points' shape based on significance #' ggcoef_model(mod_titanic, exponentiate = TRUE, significance = NULL) #' #' # a black and white version #' ggcoef_model( #' mod_titanic, #' exponentiate = TRUE, #' colour = NULL, stripped_rows = FALSE #' ) #' #' # show dichotomous terms on one row #' ggcoef_model( #' mod_titanic, #' exponentiate = TRUE, #' no_reference_row = broom.helpers::all_dichotomous(), #' categorical_terms_pattern = #' "{ifelse(dichotomous, paste0(level, ' / ', reference_level), level)}", #' show_p_values = FALSE #' ) #' } #' @examplesIf requireNamespace("reshape") #' #' \donttest{ #' data(tips, package = "reshape") #' mod_simple <- lm(tip ~ day + time + total_bill, data = tips) #' ggcoef_model(mod_simple) #' #' # custom variable labels #' # you can use the labelled package to define variable labels #' # before computing model #' if (requireNamespace("labelled")) { #' tips_labelled <- tips |> #' labelled::set_variable_labels( #' day = "Day of the week", #' time = "Lunch or Dinner", #' total_bill = "Bill's total" #' ) #' mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled) #' ggcoef_model(mod_labelled) #' } #' #' # you can provide custom variable labels with 'variable_labels' #' ggcoef_model( #' mod_simple, #' variable_labels = c( #' day = "Week day", #' time = "Time (lunch or dinner ?)", #' total_bill = "Total of the bill" #' ) #' ) #' # if labels are too long, you can use 'facet_labeller' to wrap them #' ggcoef_model( #' mod_simple, #' variable_labels = c( #' day = "Week day", #' time = "Time (lunch or dinner ?)", #' total_bill = "Total of the bill" #' ), #' facet_labeller = ggplot2::label_wrap_gen(10) #' ) #' #' # do not display variable facets but add colour guide #' ggcoef_model(mod_simple, facet_row = NULL, colour_guide = TRUE) #' #' # works also with with polynomial terms #' mod_poly <- lm( #' tip ~ poly(total_bill, 3) + day, #' data = tips, #' ) #' ggcoef_model(mod_poly) #' #' # or with different type of contrasts #' # for sum contrasts, the value of the reference term is computed #' if (requireNamespace("emmeans")) { #' mod2 <- lm( #' tip ~ day + time + sex, #' data = tips, #' contrasts = list(time = contr.sum, day = contr.treatment(4, base = 3)) #' ) #' ggcoef_model(mod2) #' } #' } #' ggcoef_model <- function( model, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = 1 - conf.level, significance_labels = NULL, show_p_values = TRUE, signif_stars = TRUE, return_data = FALSE, ...) { data <- ggcoef_data( model = model, tidy_fun = tidy_fun, tidy_args = {{ tidy_args }}, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, add_pairwise_contrasts = add_pairwise_contrasts, pairwise_variables = {{ pairwise_variables }}, keep_model_terms = keep_model_terms, pairwise_reverse = pairwise_reverse, emmeans_args = emmeans_args, significance = significance, significance_labels = significance_labels ) if (show_p_values && signif_stars) { data$add_to_label <- paste0(data$p_value_label, data$signif_stars) } if (show_p_values && !signif_stars) { data$add_to_label <- data$p_value_label } if (!show_p_values && signif_stars) { data$add_to_label <- data$signif_stars } if (show_p_values || signif_stars) { data$label <- forcats::fct_inorder( factor( paste0( data$label, ifelse( data$add_to_label == "", "", paste0(" (", data$add_to_label, ")") ) ) ) ) data$label_light <- forcats::fct_inorder( factor( paste0( data$label_light, ifelse( data$add_to_label == "", "", paste0(" (", data$add_to_label, ")") ) ) ) ) } if (return_data) { return(data) } args <- list(...) args$data <- data args$exponentiate <- exponentiate if (!"y" %in% names(args) && !"facet_row" %in% names(args)) { args$y <- "label_light" } if (!"colour" %in% names(args) && !all(is.na(data$var_label))) { args$colour <- "var_label" if (!"colour_guide" %in% names(args)) { args$colour_guide <- FALSE } } do.call(ggcoef_plot, args) } #' @describeIn ggcoef_model a variation of [ggcoef_model()] adding a table #' with estimates, confidence intervals and p-values #' @param table_stat statistics to display in the table, use any column name #' returned by the tidier or `"ci"` for confidence intervals formatted #' according to `ci_pattern` #' @param table_header optional custom headers for the table #' @param table_text_size text size for the table #' @param table_stat_label optional named list of labeller functions for the #' displayed statistic (see examples) #' @param ci_pattern glue pattern for confidence intervals in the table #' @param table_witdhs relative widths of the forest plot and the coefficients #' table #' @param plot_title an optional plot title #' @export ggcoef_table <- function( model, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = 1 - conf.level, significance_labels = NULL, show_p_values = FALSE, signif_stars = FALSE, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), plot_title = NULL, ...) { args <- list(...) # undocumented feature, we can pass directly `data` # used by ggcoef_multicomponents() if (is.null(args$data)) { data <- ggcoef_data( model = model, tidy_fun = tidy_fun, tidy_args = {{ tidy_args }}, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, add_pairwise_contrasts = add_pairwise_contrasts, pairwise_variables = {{ pairwise_variables }}, keep_model_terms = keep_model_terms, pairwise_reverse = pairwise_reverse, emmeans_args = emmeans_args, significance = significance, significance_labels = significance_labels ) } else { data <- args$data } if (show_p_values && signif_stars) { data$add_to_label <- paste0(data$p_value_label, data$signif_stars) } if (show_p_values && !signif_stars) { data$add_to_label <- data$p_value_label } if (!show_p_values && signif_stars) { data$add_to_label <- data$signif_stars } if (show_p_values || signif_stars) { data$label <- forcats::fct_inorder( factor( paste0( data$label, ifelse( data$add_to_label == "", "", paste0(" (", data$add_to_label, ")") ) ) ) ) data$label_light <- forcats::fct_inorder( factor( paste0( data$label_light, ifelse( data$add_to_label == "", "", paste0(" (", data$add_to_label, ")") ) ) ) ) } args$data <- data args$exponentiate <- exponentiate if (!"y" %in% names(args) && !"facet_row" %in% names(args)) { args$y <- "label_light" } if (!"colour" %in% names(args) && !all(is.na(data$var_label))) { args$colour <- "var_label" if (!"colour_guide" %in% names(args)) { args$colour_guide <- FALSE } } if (!"y" %in% names(args)) args$y <- "label" if (!"facet_row" %in% names(args)) args$facet_row <- "var_label" if (!"stripped_rows" %in% names(args)) args$stripped_rows <- TRUE if (!"strips_odd" %in% names(args)) args$strips_odd <- "#11111111" if (!"strips_even" %in% names(args)) args$strips_even <- "#00000000" coef_plot <- do.call(ggcoef_plot, args) if (!is.null(plot_title)) { coef_plot <- coef_plot + ggplot2::ggtitle(plot_title) + ggplot2::theme( plot.title = ggplot2::element_text(face = "bold"), plot.title.position = "plot" ) } if (args$stripped_rows) { if (!"term" %in% names(data)) { data$term <- data[[args$y]] } data <- data |> dplyr::mutate(.fill = dplyr::if_else( as.integer(.in_order(.data$term)) %% 2L == 1, args$strips_even, args$strips_odd )) } # building the coefficient table ---- tbl_data <- data if (!"estimate" %in% names(table_stat_label)) { table_stat_label$estimate <- scales::label_number(accuracy = .1) } if (!"conf.low" %in% names(table_stat_label)) { table_stat_label$conf.low <- scales::label_number(accuracy = .1) } if (!"conf.high" %in% names(table_stat_label)) { table_stat_label$conf.high <- scales::label_number(accuracy = .1) } if (!"p.value" %in% names(table_stat_label)) { table_stat_label$p.value <- scales::label_pvalue(add_p = FALSE) } for (v in names(table_stat_label)) { tbl_data[[v]] <- table_stat_label[[v]](tbl_data[[v]]) tbl_data[[v]][is.na(tbl_data[[v]])] <- "" } tbl_data$ci <- stringr::str_glue_data(tbl_data, ci_pattern) tbl_data$ci[is.na(data$conf.low) & is.na(data$conf.high)] <- " " tbl_data <- tbl_data |> tidyr::pivot_longer( dplyr::any_of(table_stat), names_to = "stat", values_to = "value", values_transform = as.character ) tbl_data$stat <- factor(tbl_data$stat, levels = table_stat) if (!is.null(table_header) && length(table_header) != length(table_stat)) { cli::cli_abort("{.arg table_header} should have the same length as {.arg table_stat}.") # nolint } if (is.null(table_header)) { table_header <- table_stat if ("estimate" %in% table_header) { table_header[table_header == "estimate"] <- attr(data, "coefficients_label") } if ("ci" %in% table_header) { table_header[table_header == "ci"] <- paste(scales::percent(conf.level), "CI") } if ("p.value" %in% table_header) { table_header[table_header == "p.value"] <- "p" } } table_plot <- ggplot2::ggplot(tbl_data) + ggplot2::aes( x = .data[["stat"]], y = .data[[args$y]], label = .data[["value"]] ) + ggplot2::geom_text(hjust = .5, vjust = .5, size = table_text_size) + ggplot2::scale_x_discrete(position = "top", labels = table_header) + ggplot2::scale_y_discrete( limits = rev, expand = ggplot2::expansion(mult = 0, add = .5) ) + ggplot2::facet_grid( rows = args$facet_row, scales = "free_y", space = "free_y", switch = "y" ) + ggplot2::theme_light() + ggplot2::theme( axis.text.x = ggplot2::element_text(face = "bold", hjust = .5), axis.text.y = ggplot2::element_blank(), axis.title = ggplot2::element_blank(), strip.text = ggplot2::element_blank(), panel.grid = ggplot2::element_blank(), axis.ticks = ggplot2::element_blank() ) if (args$stripped_rows) { table_plot <- table_plot + geom_stripped_rows( mapping = ggplot2::aes( odd = .data[[".fill"]], even = .data[[".fill"]], colour = NULL, linetype = NULL ) ) } # join the plots patchwork::wrap_plots(coef_plot, table_plot, nrow = 1, widths = table_witdhs) } #' @describeIn ggcoef_model designed for displaying several models on the same #' plot. #' @export #' @param models named list of models #' @param type a dodged plot, a faceted plot or multiple table plots? #' @examples #' \donttest{ #' # Use ggcoef_compare() for comparing several models on the same plot #' mod1 <- lm(Fertility ~ ., data = swiss) #' mod2 <- step(mod1, trace = 0) #' mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) #' models <- list( #' "Full model" = mod1, #' "Simplified model" = mod2, #' "With interaction" = mod3 #' ) #' #' ggcoef_compare(models) #' ggcoef_compare(models, type = "faceted") #' #' # you can reverse the vertical position of the point by using a negative #' # value for dodged_width (but it will produce some warnings) #' ggcoef_compare(models, dodged_width = -.9) #' } ggcoef_compare <- function( models, type = c("dodged", "faceted"), tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, ...) { data <- lapply( X = models, FUN = ggcoef_data, tidy_fun = tidy_fun, tidy_args = {{ tidy_args }}, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, add_pairwise_contrasts = add_pairwise_contrasts, pairwise_variables = {{ pairwise_variables }}, keep_model_terms = keep_model_terms, pairwise_reverse = pairwise_reverse, emmeans_args = emmeans_args, significance = significance, significance_labels = significance_labels ) data <- dplyr::bind_rows(data, .id = "model") coefficients_label <- attr(data, "coefficients_label") data$model <- .in_order(data$model) data$term <- .in_order(data$term) data$var_label <- .in_order(data$var_label) data$variable <- .in_order(data$variable) data$label <- .in_order(data$label) # include should be applied after lapply data <- data |> broom.helpers::tidy_select_variables( include = {{ include }}, model = models[[1]] # just need to pass 1 model for the function to work ) |> broom.helpers::tidy_detach_model() # Add NA values for unobserved combinations # (i.e. for a term present in one model but not in another) data <- data |> tidyr::complete( .data$model, tidyr::nesting( !!sym("var_label"), !!sym("variable"), !!sym("var_class"), !!sym("var_type"), !!sym("contrasts"), !!sym("label"), !!sym("label_light"), !!sym("term") ) ) |> # order lost after nesting dplyr::arrange(.data$model, .data$variable, .data$term) attr(data, "coefficients_label") <- coefficients_label if (return_data) { return(data) } type <- match.arg(type) args <- list(...) args$data <- data args$exponentiate <- exponentiate if (!"y" %in% names(args) && !"facet_row" %in% names(args)) { args$y <- "label_light" } if (type == "dodged") { if (!"dodged " %in% names(args)) { args$dodged <- TRUE } if (!"colour" %in% names(args)) { args$colour <- "model" } if (!"errorbar_coloured" %in% names(args)) { args$errorbar_coloured <- TRUE } } else { if (!"facet_col" %in% names(args)) { args$facet_col <- "model" } if (!"colour" %in% names(args) && !all(is.na(data$var_label))) { args$colour <- "var_label" if (!"colour_guide" %in% names(args)) { args$colour_guide <- FALSE } } } do.call(ggcoef_plot, args) } #' @describeIn ggcoef_model a variation of [ggcoef_model()] adapted to #' multinomial logistic regressions performed with [nnet::multinom()]. #' @param y.level_label an optional named vector for labeling `y.level` #' (see examples) #' @export #' @examplesIf requireNamespace("nnet") #' #' \donttest{ #' # specific function for nnet::multinom models #' mod <- nnet::multinom(Species ~ ., data = iris) #' ggcoef_multinom(mod, exponentiate = TRUE) #' ggcoef_multinom(mod, type = "faceted") #' ggcoef_multinom( #' mod, #' type = "faceted", #' y.level_label = c("versicolor" = "versicolor\n(ref: setosa)") #' ) #' } ggcoef_multinom <- function( model, type = c("dodged", "faceted", "table"), y.level_label = NULL, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), ...) { type <- match.arg(type) attr(model, "component_label_arg") <- "y.level_label" ggcoef_multicomponents( model = model, type = type, component_col = "y.level", component_label = y.level_label, tidy_fun = tidy_fun, tidy_args = tidy_args, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, significance = significance, significance_labels = significance_labels, return_data = return_data, table_stat = table_stat, table_header = table_header, table_text_size = table_text_size, table_stat_label = table_stat_label, ci_pattern = ci_pattern, table_witdhs = table_witdhs, ... ) } #' @describeIn ggcoef_model a variation of [ggcoef_model()] adapted to #' multi-component models such as zero-inflated models or beta regressions. #' [ggcoef_multicomponents()] has been tested with `pscl::zeroinfl()`, #' `pscl::hurdle()` and `betareg::betareg()` #' @param component_col name of the component column #' @param component_label an optional named vector for labeling components #' @export #' @examplesIf requireNamespace("pscl") #' \donttest{ #' library(pscl) #' data("bioChemists", package = "pscl") #' mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists) #' ggcoef_multicomponents(mod) #' #' ggcoef_multicomponents(mod, type = "f") #' #' ggcoef_multicomponents(mod, type = "t") #' #' ggcoef_multicomponents( #' mod, #' type = "t", #' component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") #' ) #' #' mod2 <- zeroinfl(art ~ fem + mar | 1, data = bioChemists) #' ggcoef_multicomponents(mod2, type = "t") #' } ggcoef_multicomponents <- function( model, type = c("dodged", "faceted", "table"), component_col = "component", component_label = NULL, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), ...) { type <- match.arg(type) if (return_data && type == "table") type <- "faceted" if (type %in% c("dodged", "faceted")) { res <- ggcoef_multi_d_f( model = model, type = type, component_col = component_col, component_label = component_label, tidy_fun = tidy_fun, tidy_args = tidy_args, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, significance = significance, significance_labels = significance_labels, return_data = return_data, ... ) } else { res <- ggcoef_multi_t( model = model, type = type, component_col = component_col, component_label = component_label, tidy_fun = tidy_fun, tidy_args = tidy_args, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, significance = significance, significance_labels = significance_labels, ... ) } res } # dodged & faceted version ggcoef_multi_d_f <- function( model, type = c("dodged", "faceted"), component_col = "component", component_label = NULL, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, ...) { component_label_arg <- attr(model, "component_label_arg") if (is.null(component_label_arg)) component_label_arg <- "component_label" data <- ggcoef_data( model, tidy_fun = tidy_fun, tidy_args = {{ tidy_args }}, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, significance = significance, significance_labels = significance_labels ) if (!component_col %in% names(data)) data[[component_col]] <- " " data[[component_col]] <- .in_order(data[[component_col]]) if (!is.null(component_label)) { if ( is.null(names(component_label)) || any(names(component_label) == "") ) { cli::cli_abort( "All elements of {.arg {component_label_arg}} should be named." ) } keep <- names(component_label) %in% levels(data[[component_col]]) drop <- component_label[!keep] if (length(drop) > 0) { cli::cli_alert_warning(c( "Error in {.arg {component_label_arg}}:\n", "value{?s} {.strong {drop}} not found in the data and ignored." )) } component_label <- component_label[keep] missing_levels <- setdiff( levels(.in_order(data[[component_col]])), names(component_label) ) names(missing_levels) <- missing_levels data[[component_col]] <- factor( data[[component_col]], levels = c(names(component_label), missing_levels), labels = c(component_label, missing_levels) ) } if (return_data) { return(data) } type <- match.arg(type) args <- list(...) args$data <- data args$exponentiate <- exponentiate if (!"y" %in% names(args) && !"facet_row" %in% names(args)) { args$y <- "label_light" } if (type == "dodged") { if (!"dodged " %in% names(args)) { args$dodged <- TRUE } if (!"colour" %in% names(args)) { args$colour <- component_col } if (!"errorbar_coloured" %in% names(args)) { args$errorbar_coloured <- TRUE } } else { if (!"facet_col" %in% names(args)) { args$facet_col <- component_col } if (!"colour" %in% names(args) && !all(is.na(data$var_label))) { args$colour <- "var_label" if (!"colour_guide" %in% names(args)) { args$colour_guide <- FALSE } } } do.call(ggcoef_plot, args) } # table version ggcoef_multi_t <- function( model, type = c("table"), component_col = "component", component_label = NULL, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), significance = 1 - conf.level, significance_labels = NULL, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), ...) { type <- match.arg(type) component_label_arg <- attr(model, "component_label_arg") if (is.null(component_label_arg)) component_label_arg <- "component_label" data <- ggcoef_data( model = model, tidy_fun = tidy_fun, tidy_args = {{ tidy_args }}, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, significance = significance, significance_labels = significance_labels ) if (!component_col %in% names(data)) data[[component_col]] <- " " data[[component_col]] <- .in_order(data[[component_col]]) if (!is.null(component_label)) { if ( is.null(names(component_label)) || any(names(component_label) == "") ) { cli::cli_abort( "All elements of {.arg {component_label_arg}} should be named." ) } keep <- names(component_label) %in% levels(data[[component_col]]) drop <- component_label[!keep] if (length(drop) > 0) { cli::cli_alert_warning(c( "Error in {.arg {component_label_arg}}:\n", "value{?s} {.strong {drop}} not found in the data and ignored." )) } component_label <- component_label[keep] missing_levels <- setdiff( levels(.in_order(data[[component_col]])), names(component_label) ) names(missing_levels) <- missing_levels data[[component_col]] <- factor( data[[component_col]], levels = c(names(component_label), missing_levels), labels = c(component_label, missing_levels) ) } res <- levels(data[[component_col]]) |> purrr::map( ~ ggcoef_table( data = dplyr::filter(data, .data[[component_col]] == .x), plot_title = .x, model = model, tidy_fun = tidy_fun, tidy_args = tidy_args, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, intercept = intercept, include = {{ include }}, significance = significance, significance_labels = significance_labels, show_p_values = FALSE, signif_stars = FALSE, table_stat = table_stat, table_header = table_header, table_text_size = table_text_size, table_stat_label = table_stat_label, ci_pattern = ci_pattern, table_witdhs = table_witdhs ) ) patchwork::wrap_plots(res, ncol = 1) } # not exporting ggcoef_data ggcoef_data <- function( model, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = .95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = conf.level, significance_labels = NULL) { rlang::check_installed("broom.helpers") if (length(significance) == 0) { significance <- NULL } data <- rlang::inject(broom.helpers::tidy_plus_plus( model = model, tidy_fun = tidy_fun, conf.int = conf.int, conf.level = conf.level, exponentiate = exponentiate, variable_labels = variable_labels, term_labels = term_labels, interaction_sep = interaction_sep, categorical_terms_pattern = categorical_terms_pattern, add_reference_rows = add_reference_rows, no_reference_row = {{ no_reference_row }}, add_pairwise_contrasts = add_pairwise_contrasts, pairwise_variables = {{ pairwise_variables }}, keep_model_terms = keep_model_terms, pairwise_reverse = pairwise_reverse, emmeans_args = emmeans_args, add_estimate_to_reference_rows = TRUE, add_header_rows = FALSE, intercept = intercept, include = {{ include }}, keep_model = FALSE, !!!tidy_args )) if (!"p.value" %in% names(data)) { data$p.value <- NA_real_ significance <- NULL } if (!is.null(significance)) { if (is.null(significance_labels)) { significance_labels <- paste(c("p <=", "p >"), significance) } data$significance <- factor( !is.na(data$p.value) & data$p.value <= significance, levels = c(TRUE, FALSE), labels = significance_labels ) } data$signif_stars <- signif_stars(data$p.value, point = NULL) data$p_value_label <- ifelse( is.na(data$p.value), "", scales::pvalue(data$p.value, add_p = TRUE) ) # keep only rows with estimate data <- data[!is.na(data$estimate), ] data$term <- .in_order(data$term) data$var_label <- .in_order(data$var_label) data$variable <- .in_order(data$variable) data$label <- .in_order(data$label) data$label_light <- dplyr::if_else( as.character(data$label) == as.character(data$var_label) & ((!grepl("^nmatrix", data$var_class)) | is.na(data$var_class)), "", as.character(data$label) ) |> .in_order() data } #' @describeIn ggcoef_model plot a tidy `tibble` of coefficients #' @param data a data frame containing data to be plotted, #' typically the output of `ggcoef_model()`, `ggcoef_compare()` #' or `ggcoef_multinom()` with the option `return_data = TRUE` #' @param x,y variables mapped to x and y axis #' @param exponentiate if `TRUE` a logarithmic scale will #' be used for x-axis #' @param point_size size of the points #' @param point_stroke thickness of the points #' @param point_fill fill colour for the points #' @param colour optional variable name to be mapped to #' colour aesthetic #' @param colour_guide should colour guide be displayed #' in the legend? #' @param colour_lab label of the colour aesthetic in the legend #' @param colour_labels labels argument passed to #' [ggplot2::scale_colour_discrete()] and #' [ggplot2::discrete_scale()] #' @param shape optional variable name to be mapped to the #' shape aesthetic #' @param shape_values values of the different shapes to use in #' [ggplot2::scale_shape_manual()] #' @param shape_guide should shape guide be displayed in the legend? #' @param shape_lab label of the shape aesthetic in the legend #' @param errorbar should error bars be plotted? #' @param errorbar_height height of error bars #' @param errorbar_coloured should error bars be colored as the points? #' @param stripped_rows should stripped rows be displayed in the background? #' @param strips_odd color of the odd rows #' @param strips_even color of the even rows #' @param vline should a vertical line be drawn at 0 (or 1 if #' `exponentiate = TRUE`)? #' @param vline_colour colour of vertical line #' @param dodged should points be dodged (according to the colour aesthetic)? #' @param dodged_width width value for [ggplot2::position_dodge()] #' @param facet_row variable name to be used for row facets #' @param facet_col optional variable name to be used for column facets #' @param facet_labeller labeller function to be used for labeling facets; #' if labels are too long, you can use [ggplot2::label_wrap_gen()] (see #' examples), more information in the documentation of [ggplot2::facet_grid()] #' @seealso `vignette("ggcoef_model")` #' @export ggcoef_plot <- function( data, x = "estimate", y = "label", exponentiate = FALSE, point_size = 2, point_stroke = 2, point_fill = "white", colour = NULL, colour_guide = TRUE, colour_lab = "", colour_labels = ggplot2::waiver(), shape = "significance", shape_values = c(16, 21), shape_guide = TRUE, shape_lab = "", errorbar = TRUE, errorbar_height = .1, errorbar_coloured = FALSE, stripped_rows = TRUE, strips_odd = "#11111111", strips_even = "#00000000", vline = TRUE, vline_colour = "grey50", dodged = FALSE, dodged_width = .8, facet_row = "var_label", facet_col = NULL, facet_labeller = "label_value") { data[[y]] <- forcats::fct_rev(.in_order(data[[y]])) if (!is.null(facet_row)) { data[[facet_row]] <- .in_order(data[[facet_row]]) } if (stripped_rows) { if (!"term" %in% names(data)) { data$term <- data[[y]] } data <- data |> dplyr::mutate(.fill = dplyr::if_else( as.integer(.in_order(.data$term)) %% 2L == 1, strips_even, strips_odd )) } # mapping mapping <- ggplot2::aes(x = .data[[x]], y = .data[[y]]) errorbar <- errorbar & all(c("conf.low", "conf.high") %in% names(data)) if (errorbar) { mapping$xmin <- ggplot2::aes(xmin = .data[["conf.low"]])$xmin mapping$xmax <- ggplot2::aes(xmax = .data[["conf.high"]])$xmax } if (!is.null(shape) && shape %in% names(data)) { mapping$shape <- ggplot2::aes(shape = .data[[shape]])$shape } if (!is.null(colour) && colour %in% names(data)) { mapping$colour <- ggplot2::aes(colour = .data[[colour]])$colour mapping$group <- ggplot2::aes(group = .data[[colour]])$group } # position if (dodged) { position <- ggplot2::position_dodge(dodged_width) } else { position <- ggplot2::position_identity() } # plot p <- ggplot2::ggplot(data = data, mapping = mapping) if (stripped_rows) { p <- p + geom_stripped_rows( mapping = ggplot2::aes( odd = .data[[".fill"]], even = .data[[".fill"]], colour = NULL, linetype = NULL ) ) } if (vline) { p <- p + ggplot2::geom_vline( xintercept = ifelse(exponentiate, 1, 0), colour = vline_colour ) } if (errorbar) { if (!is.null(colour) && errorbar_coloured) { p <- p + ggplot2::geom_errorbarh( na.rm = TRUE, height = errorbar_height, position = position ) } else { p <- p + ggplot2::geom_errorbarh( mapping = ggplot2::aes(colour = NULL), na.rm = TRUE, height = errorbar_height, colour = "black", position = position ) } } if (!is.null(facet_col) && is.character(facet_col)) { facet_col <- ggplot2::vars(!!sym(facet_col)) } if (!is.null(facet_row) && is.character(facet_row)) { facet_row <- ggplot2::vars(!!sym(facet_row)) } p <- p + ggplot2::geom_point( size = point_size, stroke = point_stroke, fill = point_fill, position = position, na.rm = TRUE ) + ggplot2::facet_grid( rows = facet_row, cols = facet_col, labeller = facet_labeller, scales = "free_y", space = "free_y", switch = "y" ) + ggplot2::ylab("") + ggplot2::scale_y_discrete(expand = ggplot2::expansion(mult = 0, add = .5)) + ggplot2::theme_light() + ggplot2::theme( legend.position = "bottom", legend.box = "vertical", strip.placement = "outside", strip.text.y.left = ggplot2::element_text( face = "bold", angle = 0, colour = "black", hjust = 0, vjust = 1 ), strip.text.x = ggplot2::element_text(face = "bold", colour = "black"), strip.background = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), panel.grid.major.y = ggplot2::element_blank(), panel.grid.major.x = ggplot2::element_line(linetype = "dashed"), axis.title.x = ggplot2::element_text(face = "bold"), axis.ticks.y = ggplot2::element_blank() ) if (!is.null(colour) && colour %in% names(data)) { if (colour_guide) { colour_guide <- ggplot2::guide_legend() } else { colour_guide <- "none" } p <- p + ggplot2::scale_colour_discrete( guide = colour_guide, labels = colour_labels ) + ggplot2::labs(colour = colour_lab) } if (!is.null(shape) && shape %in% names(data)) { if (shape_guide) { shape_guide <- ggplot2::guide_legend() } else { shape_guide <- "none" } p <- p + ggplot2::scale_shape_manual( values = shape_values, drop = FALSE, guide = shape_guide, na.translate = FALSE ) + ggplot2::labs(shape = shape_lab) } if (exponentiate) { p <- p + ggplot2::scale_x_log10() } if (!is.null(attr(data, "coefficients_label"))) { p <- p + ggplot2::xlab(attr(data, "coefficients_label")) } p } .in_order <- function(x) { # droping unobserved value if needed forcats::fct_inorder(as.character(x)) } ggstats/R/stat_prop.R0000644000176200001440000002354314674033502014300 0ustar liggesusers#' Compute proportions according to custom denominator #' #' `stat_prop()` is a variation of [ggplot2::stat_count()] allowing to #' compute custom proportions according to the **by** aesthetic defining #' the denominator (i.e. all proportions for a same value of **by** will #' sum to 1). If the **by** aesthetic is not specified, denominators will be #' determined according to the `default_by` argument. #' #' @inheritParams ggplot2::stat_count #' @param geom Override the default connection with [ggplot2::geom_bar()]. #' @param complete Name (character) of an aesthetic for those statistics should #' be completed for unobserved values (see example). #' @param default_by If the **by** aesthetic is not available, name of another #' aesthetic that will be used to determine the denominators (e.g. `"fill"`), #' or `NULL` or `"total"` to compute proportions of the total. To be noted, #' `default_by = "x"` works both for vertical and horizontal bars. #' @param height Which statistic (`"count"` or `"prop"`) should be used, by #' default, for determining the height/width of the geometry (accessible #' through `after_stat(height)`)? #' @param labels Which statistic (`"prop"` or `"count"`) should be used, by #' default, for generating formatted labels (accessible through #' `after_stat(labels)`)? #' @param labeller Labeller function to format labels and populate #' `after_stat(labels)`. #' #' @section Aesthetics: #' `stat_prop()` understands the following aesthetics #' (required aesthetics are in bold): #' #' - **x *or* y** #' - by #' - weight #' @section Computed variables: #' \describe{ #' \item{`after_stat(count)`}{number of points in bin} #' \item{`after_stat(denominator)`}{denominator for the proportions} #' \item{`after_stat(prop)`}{computed proportion, i.e. #' `after_stat(count)`/`after_stat(denominator)`} #' \item{`after_stat(height)`}{counts or proportions, according to `height`} #' \item{`after_stat(labels)`}{formatted heights, according to `labels` and #' `labeller`} #' } #' @seealso `vignette("stat_prop")`, [ggplot2::stat_count()]. For an alternative #' approach, see #' . #' #' @import ggplot2 #' @return A `ggplot2` plot with the added statistic. #' @export #' @examples #' library(ggplot2) #' d <- as.data.frame(Titanic) #' #' p <- ggplot(d) + #' aes(x = Class, fill = Survived, weight = Freq, by = Class) + #' geom_bar(position = "fill") + #' geom_text(stat = "prop", position = position_fill(.5)) #' p #' p + facet_grid(~Sex) #' #' ggplot(d) + #' aes(x = Class, fill = Survived, weight = Freq) + #' geom_bar(position = "dodge") + #' geom_text( #' aes(by = Survived), #' stat = "prop", #' position = position_dodge(0.9), vjust = "bottom" #' ) #' \donttest{ #' if (requireNamespace("scales")) { #' ggplot(d) + #' aes(x = Class, fill = Survived, weight = Freq, by = 1) + #' geom_bar() + #' geom_text( #' aes(label = scales::percent(after_stat(prop), accuracy = 1)), #' stat = "prop", #' position = position_stack(.5) #' ) #' } #' #' ggplot(d) + #' aes(y = Class, fill = Survived, weight = Freq) + #' geom_prop_bar() + #' geom_prop_text() #' #' # displaying unobserved levels with complete #' d <- diamonds |> #' dplyr::filter(!(cut == "Ideal" & clarity == "I1")) |> #' dplyr::filter(!(cut == "Very Good" & clarity == "VS2")) |> #' dplyr::filter(!(cut == "Premium" & clarity == "IF")) #' p <- ggplot(d) + #' aes(x = clarity, fill = cut, by = clarity) + #' geom_bar(position = "fill") #' p + geom_text(stat = "prop", position = position_fill(.5)) #' p + geom_text(stat = "prop", position = position_fill(.5), complete = "fill") #' } stat_prop <- function(mapping = NULL, data = NULL, geom = "bar", position = "fill", ..., width = NULL, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, complete = NULL, default_by = "total", height = c("count", "prop"), labels = c("prop", "count"), labeller = scales::label_percent(accuracy = .1)) { params <- list( na.rm = na.rm, orientation = orientation, width = width, complete = complete, default_by = default_by, height = height, labels = labels, labeller = labeller, ... ) if (!is.null(params$y)) { cli::cli_abort( "{.fn stat_prop} must not be used with a {.arg y} aesthetic.", call. = FALSE ) } layer( data = data, mapping = mapping, stat = StatProp, geom = geom, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = params ) } #' @rdname stat_prop #' @format NULL #' @usage NULL #' @export StatProp <- ggplot2::ggproto("StatProp", ggplot2::Stat, required_aes = c("x|y"), default_aes = ggplot2::aes( x = after_stat(height), y = after_stat(height), weight = 1, label = after_stat(labels), by = 1 ), setup_params = function(data, params) { params$flipped_aes <- ggplot2::has_flipped_aes( data, params, main_is_orthogonal = FALSE ) has_x <- !(is.null(data$x) && is.null(params$x)) has_y <- !(is.null(data$y) && is.null(params$y)) if (!has_x && !has_y) { cli::cli_abort( "{.fn stat_prop} requires an {.arg x} or {.arg y} aesthetic.", call. = FALSE ) } if (has_x && has_y) { cli::cli_abort( "{.fn stat_prop} can only have an {.arg x} or an {.arg y} aesthetic.", call. = FALSE ) } params }, extra_params = c("na.rm"), compute_panel = function(self, data, scales, width = NULL, flipped_aes = FALSE, complete = NULL, default_by = "total", height = c("count", "prop"), labels = c("prop", "count"), labeller = scales::label_percent(accuracy = .1)) { height <- match.arg(height) labels <- match.arg(labels) data <- ggplot2::flip_data(data, flipped_aes) data$weight <- data$weight %||% rep(1, nrow(data)) if (default_by == "y") default_by <- "x" if ( is.null(data[["by"]]) && !is.null(default_by) && !is.null(data[[default_by]]) ) { data$by <- data[[default_by]] } data$by <- data$by %||% rep(1, nrow(data)) width <- width %||% (ggplot2::resolution(data$x) * 0.9) if (is.character(data$by)) data$by <- factor(data$by) # sum weights for each combination of by and aesthetics # the use of . allows to consider all aesthetics defined in data panel <- stats::aggregate(weight ~ ., data = data, sum, na.rm = TRUE) names(panel)[which(names(panel) == "weight")] <- "count" panel$count[is.na(panel$count)] <- 0 if (!is.null(complete) && complete %in% names(panel)) { panel <- panel |> dplyr::select(-dplyr::all_of("group")) cols <- names(panel) cols <- cols[!cols %in% c("count", complete)] panel <- panel |> tidyr::complete( tidyr::nesting(!!!syms(cols)), .data[[complete]], fill = list(count = 0) ) |> dplyr::mutate(group = seq_len(dplyr::n())) } # compute proportions by by sum_abs <- function(x) { sum(abs(x)) } panel$denominator <- ave(panel$count, panel$by, FUN = sum_abs) panel$prop <- panel$count / panel$denominator panel$height <- panel[[height]] panel$labels <- labeller(panel[[labels]]) panel$width <- width panel$flipped_aes <- flipped_aes ggplot2::flip_data(panel, flipped_aes) } ) #' @rdname stat_prop #' @param stat The statistical transformation to use on the data for this layer. #' @export geom_prop_bar <- function(mapping = NULL, data = NULL, stat = "prop", position = position_stack(), ..., complete = NULL, default_by = "x", height = "prop") { args <- list(...) if (stat == "prop") { args$complete <- complete args$default_by <- default_by args$height <- height } args$mapping <- mapping args$data <- data args$stat <- stat args$position <- position do.call(ggplot2::geom_bar, args) } #' @rdname stat_prop #' @param vjust Vertical/Horizontal adjustment for the position. Set to 0 to #' align with the bottom/left, 0.5 (the default) for the middle, and 1 for the #' top/right. #' @export geom_prop_text <- function(mapping = NULL, data = NULL, stat = "prop", position = position_stack(vjust), ..., complete = NULL, default_by = "x", height = "prop", labels = "prop", labeller = scales::label_percent(accuracy = .1), vjust = 0.5) { args <- list(...) if (stat == "prop") { args$complete <- complete args$default_by <- default_by args$height <- height args$labels <- labels args$labeller <- labeller } args$mapping <- mapping args$data <- data args$stat <- stat args$position <- position do.call(ggplot2::geom_text, args) } ggstats/R/ggstats-package.R0000644000176200001440000000140314674033502015321 0ustar liggesusers#' @keywords internal "_PACKAGE" # The following block is used by usethis to automatically manage # roxygen namespace tags. Modify with care! ## usethis namespace: start #' @importFrom lifecycle deprecate_soft #' @importFrom lifecycle deprecated #' @importFrom dplyr .data sym #' @importFrom ggplot2 after_stat after_scale ## usethis namespace: end NULL utils::globalVariables(c("prop")) # \lifecycle{experimental} # \lifecycle{maturing} # \lifecycle{stable} # \lifecycle{superseded} # \lifecycle{questioning} # \lifecycle{soft-deprecated} # \lifecycle{deprecated} # \lifecycle{defunct} # \lifecycle{archived} # from ggplot2 (but not exported by ggplot2) `%||%` <- function(a, b) { if (!is.null(a)) { a } else { b } } ggstats/R/ggcascade.R0000644000176200001440000001451614674034015014166 0ustar liggesusers#' Cascade plot #' #' `r lifecycle::badge("experimental")` #' #' @param .data A data frame, or data frame extension (e.g. a tibble). For #' `plot_cascade()`, the variable displayed on the x-axis should be named #' `"x"` and the number of observations should be named `"n"`, like the #' tibble returned by `compute_cascade()`. #' @param ... <[`data-masking`][rlang::args_data_masking]> Name-value pairs of #' conditions defining the different statuses to be plotted (see examples). #' @param .weights <[`tidy-select`][dplyr::dplyr_tidy_select]> Optional weights. #' Should select only one variable. #' @param .by <[`tidy-select`][dplyr::dplyr_tidy_select]> A variable or a set #' of variables to group by the computation of the cascade, and to generate #' facets. To select several variables, use [dplyr::pick()] (see examples). #' @param .nrow,.ncol Number of rows and columns, for faceted plots. #' @param .add_n Display the number of observations? #' @param .text_size Size of the labels, passed to [ggplot2::geom_text()]. #' @param .arrows Display arrows between statuses? #' @details #' `ggcascade()` calls `compute_cascade()` to generate a data set passed #' to `plot_cascade()`. Use `compute_cascade()` and `plot_cascade()` for #' more controls. #' @return A `ggplot2` plot or a `tibble`. #' @examples #' ggplot2::diamonds |> #' ggcascade( #' all = TRUE, #' big = carat > .5, #' "big & ideal" = carat > .5 & cut == "Ideal" #' ) #' #' ggplot2::mpg |> #' ggcascade( #' all = TRUE, #' recent = year > 2000, #' "recent & economic" = year > 2000 & displ < 3, #' .by = cyl, #' .ncol = 3, #' .arrows = FALSE, #' .text_size = 3 #' ) #' #' ggplot2::mpg |> #' ggcascade( #' all = TRUE, #' recent = year > 2000, #' "recent & economic" = year > 2000 & displ < 3, #' .by = pick(cyl, drv), #' .add_n = FALSE, #' .text_size = 2 #' ) #' @export ggcascade <- function(.data, ..., .weights = NULL, .by = NULL, .nrow = NULL, .ncol = NULL, .add_n = TRUE, .text_size = 4, .arrows = TRUE) { .data |> compute_cascade(..., .weights = {{ .weights }}, .by = {{ .by }}) |> plot_cascade( .by = {{ .by }}, .nrow = .nrow, .ncol = .ncol, .add_n = .add_n, .text_size = .text_size, .arrows = .arrows ) } #' @rdname ggcascade #' @export compute_cascade <- function(.data, ..., .weights = NULL, .by = NULL) { w <- .data |> dplyr::select({{ .weights }}) if (ncol(w) > 1) cli::cli_abort("{.arg .weights} should select only one column.") if (ncol(w) == 0) { w <- 1 } else { w <- w[[1]] } dots <- rlang::enquos(...) .data |> dplyr::mutate(.w = w) |> dplyr::mutate(!!! dots) |> dplyr::group_by({{ .by }}) |> dplyr::summarise( dplyr::across( dplyr::all_of(names(dots)), \(x) { weighted.sum(x, .data$.w) } ), .groups = "keep" ) |> tidyr::pivot_longer( dplyr::all_of(names(dots)), names_to = "x", values_to = "n" ) |> dplyr::mutate( x = factor(.data$x, levels = names(dots), ordered = TRUE) ) |> dplyr::arrange(.data$x, .by_group = TRUE) } #' @rdname ggcascade #' @export plot_cascade <- function(.data, .by = NULL, .nrow = NULL, .ncol = NULL, .add_n = TRUE, .text_size = 4, .arrows = TRUE) { .data <- .data |> dplyr::group_by({{ .by }}) |> dplyr::mutate( prop = .data$n / max(.data$n), label = scales::percent(.data$prop, accuracy = .1), y_label = dplyr::if_else(.data$prop < .1 & .add_n, .1, .data$prop), xend = dplyr::lead(.data$x), yend = dplyr::lead(.data$prop) / 2, prop_step = dplyr::lead(.data$n) / .data$n, label_step = scales::percent( .data$prop_step, accuracy = .1, prefix = "\u00d7" ) ) p <- ggplot2::ggplot(.data) + ggplot2::aes( x = .data$x, y = .data$prop, fill = .data$x ) + ggplot2::geom_bar( stat = "identity", width = .5, colour = "black", linewidth = .25 ) + ggplot2::geom_text( mapping = ggplot2::aes( y = .data$y_label, label = .data$label ), vjust = 0, nudge_y = .02, size = .text_size ) + ggplot2::scale_y_continuous( breaks = 0:5 / 5, labels = scales::percent ) + ggplot2::xlab("") + ggplot2::ylab("") + ggplot2::theme_minimal() + ggplot2::theme( legend.position = "none", panel.grid.major.x = ggplot2::element_blank(), axis.text.x = ggplot2::element_text(face = "bold") ) if (.add_n) { p <- p + ggplot2::layer( geom = "text", stat = "identity", position = position_nudge(y = .02), mapping = ggplot2::aes( y = 0, label = paste0("n=", .data$n), prop = .data$prop, color = after_scale(hex_bw_threshold(.data$fill, .data$prop, .02)) ), check.aes = FALSE, params = list( vjust = 0, size = .text_size ) ) } if (.arrows) { p <- p + ggplot2::geom_segment( mapping = ggplot2::aes( x = as.integer(.data$x) + .3, xend = as.integer(.data$xend) - .3, y = .data$yend, yend = .data$yend ), na.rm = TRUE, arrow = ggplot2::arrow( type = "closed", length = unit(0.25, "cm") ) ) + ggplot2::geom_text( aes( x = as.integer(.data$x) + .5, y = .data$yend, label = .data$label_step ), vjust = 0, nudge_y = .04, na.rm = TRUE, size = .text_size ) } .by_vars <- dplyr::group_vars(.data) if (length(.by_vars) > 0) { p <- p + ggplot2::facet_wrap( facets = .by_vars, nrow = .nrow, ncol = .ncol ) } p } ggstats/R/signif_stars.R0000644000176200001440000000207414357760261014763 0ustar liggesusers#' Significance Stars #' #' Calculate significance stars #' #' @param x numeric values that will be compared to the `point`, #' `one`, `two`, and `three` values #' @param three threshold below which to display three stars #' @param two threshold below which to display two stars #' @param one threshold below which to display one star #' @param point threshold below which to display one point #' (`NULL` to deactivate) #' @return Character vector containing the appropriate number of #' stars for each `x` value. #' @author Joseph Larmarange #' @export #' @examples #' x <- c(0.5, 0.1, 0.05, 0.01, 0.001) #' signif_stars(x) #' signif_stars(x, one = .15, point = NULL) signif_stars <- function(x, three = 0.001, two = 0.01, one = 0.05, point = 0.1) { res <- rep_len("", length.out = length(x)) if (!is.null(point)) { res[x <= point] <- "." } if (!is.null(one)) { res[x <= one] <- "*" } if (!is.null(two)) { res[x <= two] <- "**" } if (!is.null(three)) { res[x <= three] <- "***" } res } ggstats/R/gglikert.R0000644000176200001440000006224014674033502014072 0ustar liggesusers#' Plotting Likert-type items #' #' Combines several factor variables using the same list of ordered levels #' (e.g. Likert-type scales) into a unique data frame and generates a centered #' bar plot. #' #' You could use `gglikert_data()` to just produce the dataset to be plotted. #' #' If variable labels have been defined (see [labelled::var_label()]), they will #' be considered. You can also pass custom variables labels with the #' `variable_labels` argument. #' #' @param data a data frame #' @param include variables to include, accepts [tidy-select][dplyr::select] #' syntax #' @param weights optional variable name of a weighting variable, #' accepts [tidy-select][dplyr::select] syntax #' @param y name of the variable to be plotted on `y` axis (relevant when #' `.question` is mapped to "facets, see examples), #' accepts [tidy-select][dplyr::select] syntax #' @param variable_labels a named list or a named vector of custom variable #' labels #' @param sort should the factor defined by `factor_to_sort` be sorted according #' to the answers (see `sort_method`)? One of "none" (default), "ascending" or #' "descending" #' @param sort_method method used to sort the variables: `"prop"` sort according #' to the proportion of answers higher than the centered level, `"prop_lower"` #' according to the proportion lower than the centered level, `"mean"` #' considers answer as a score and sort according to the mean score, `"median"` #' used the median and the majority judgment rule for tie-breaking. #' @param sort_prop_include_center when sorting with `"prop"` and if the number #' of levels is uneven, should half of the central level be taken into account #' to compute the proportion? #' @param factor_to_sort name of the factor column to sort if `sort` is not #' equal to `"none"`; by default the list of questions passed to `include`; #' should be one factor column of the tibble returned by `gglikert_data()`; #' accepts [tidy-select][dplyr::select] syntax #' @param exclude_fill_values Vector of values that should not be displayed #' (but still taken into account for computing proportions), #' see [position_likert()] #' @param cutoff number of categories to be displayed negatively (i.e. on the #' left of the x axis or the bottom of the y axis), could be a decimal value: #' `2` to display negatively the two first categories, `2.5` to display #' negatively the two first categories and half of the third, `2.2` to display #' negatively the two first categories and a fifth of the third (see examples). #' By default (`NULL`), it will be equal to the number of categories divided #' by 2, i.e. it will be centered. #' @param data_fun for advanced usage, custom function to be applied to the #' generated dataset at the end of `gglikert_data()` #' @param add_labels should percentage labels be added to the plot? #' @param labels_size size of the percentage labels #' @param labels_color color of the percentage labels (`"auto"` to use #' `hex_bw()` to determine a font color based on background color) #' @param labels_accuracy accuracy of the percentages, see #' [scales::label_percent()] #' @param labels_hide_below if provided, values below will be masked, see #' [label_percent_abs()] #' @param add_totals should the total proportions of negative and positive #' answers be added to plot? **This option is not compatible with facets!** #' @param totals_size size of the total proportions #' @param totals_color color of the total proportions #' @param totals_accuracy accuracy of the total proportions, see #' [scales::label_percent()] #' @param totals_fontface font face of the total proportions #' @param totals_include_center if the number of levels is uneven, should half #' of the center level be added to the total proportions? #' @param totals_hjust horizontal adjustment of totals labels on the x axis #' @param y_reverse should the y axis be reversed? #' @param y_label_wrap number of characters per line for y axis labels, see #' [scales::label_wrap()] #' @param reverse_likert if `TRUE`, will reverse the default stacking order, #' see [position_likert()] #' @param width bar width, see [ggplot2::geom_bar()] #' @param facet_rows,facet_cols A set of variables or expressions quoted by #' [ggplot2::vars()] and defining faceting groups on the rows or columns #' dimension (see examples) #' @param facet_label_wrap number of characters per line for facet labels, see #' [ggplot2::label_wrap_gen()] #' @param symmetric should the x-axis be symmetric? #' @return A `ggplot2` plot or a `tibble`. #' @seealso `vignette("gglikert")`, [position_likert()], [stat_prop()] #' @export #' @examples #' library(ggplot2) #' library(dplyr) #' #' likert_levels <- c( #' "Strongly disagree", #' "Disagree", #' "Neither agree nor disagree", #' "Agree", #' "Strongly agree" #' ) #' set.seed(42) #' df <- #' tibble( #' q1 = sample(likert_levels, 150, replace = TRUE), #' q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), #' q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), #' q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), #' q5 = sample(c(likert_levels, NA), 150, replace = TRUE), #' q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) #' ) |> #' mutate(across(everything(), ~ factor(.x, levels = likert_levels))) #' #' gglikert(df) #' #' gglikert(df, include = q1:3) + #' scale_fill_likert(pal = scales::brewer_pal(palette = "PRGn")) #' #' gglikert(df, sort = "ascending") #' #' \donttest{ #' gglikert(df, sort = "ascending", sort_prop_include_center = TRUE) #' #' gglikert(df, sort = "ascending", sort_method = "mean") #' #' gglikert(df, reverse_likert = TRUE) #' #' gglikert(df, add_totals = FALSE, add_labels = FALSE) #' #' gglikert( #' df, #' totals_include_center = TRUE, #' totals_hjust = .25, #' totals_size = 4.5, #' totals_fontface = "italic", #' totals_accuracy = .01, #' labels_accuracy = 1, #' labels_size = 2.5, #' labels_hide_below = .25 #' ) #' #' gglikert(df, exclude_fill_values = "Neither agree nor disagree") #' #' if (require("labelled")) { #' df |> #' set_variable_labels( #' q1 = "First question", #' q2 = "Second question" #' ) |> #' gglikert( #' variable_labels = c( #' q4 = "a custom label", #' q6 = "a very very very very very very very very very very long label" #' ), #' y_label_wrap = 25 #' ) #' } #' #' # Facets #' df_group <- df #' df_group$group <- sample(c("A", "B"), 150, replace = TRUE) #' #' gglikert(df_group, q1:q6, facet_rows = vars(group)) #' #' gglikert(df_group, q1:q6, facet_cols = vars(group)) #' #' gglikert(df_group, q1:q6, y = "group", facet_rows = vars(.question)) #' #' # Custom function to be applied on data #' f <- function(d) { #' d$.question <- forcats::fct_relevel(d$.question, "q5", "q2") #' d #' } #' gglikert(df, include = q1:q6, data_fun = f) #' #' # Custom center #' gglikert(df, cutoff = 2) #' #' gglikert(df, cutoff = 1) #' #' gglikert(df, cutoff = 1, symmetric = TRUE) #' #' } gglikert <- function(data, include = dplyr::everything(), weights = NULL, y = ".question", variable_labels = NULL, sort = c("none", "ascending", "descending"), sort_method = c("prop", "prop_lower", "mean", "median"), sort_prop_include_center = totals_include_center, factor_to_sort = ".question", exclude_fill_values = NULL, cutoff = NULL, data_fun = NULL, add_labels = TRUE, labels_size = 3.5, labels_color = "auto", labels_accuracy = 1, labels_hide_below = .05, add_totals = TRUE, totals_size = labels_size, totals_color = "black", totals_accuracy = labels_accuracy, totals_fontface = "bold", totals_include_center = FALSE, totals_hjust = .1, y_reverse = TRUE, y_label_wrap = 50, reverse_likert = FALSE, width = .9, facet_rows = NULL, facet_cols = NULL, facet_label_wrap = 50, symmetric = FALSE) { data <- gglikert_data( data, {{ include }}, weights = {{ weights }}, variable_labels = variable_labels, sort = sort, sort_method = sort_method, sort_prop_include_center = sort_prop_include_center, factor_to_sort = {{ factor_to_sort }}, exclude_fill_values = exclude_fill_values, cutoff = cutoff, data_fun = data_fun ) y <- data |> dplyr::select({{ y }}) |> colnames() if (length(y) != 1) cli::cli_abort("{.arg y} should select only one column.") if (!is.factor(data[[y]])) { data[[y]] <- factor(data[[y]]) } if (y_reverse) { data[[y]] <- data[[y]] |> forcats::fct_rev() } p <- ggplot(data) + aes( y = .data[[y]], fill = .data[[".answer"]], by = .data[[y]], weight = .data[[".weights"]] ) + geom_bar( position = position_likert( reverse = reverse_likert, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), stat = StatProp, complete = "fill", width = width ) if (add_labels && labels_color == "auto") { p <- p + geom_text( mapping = aes( label = label_percent_abs( hide_below = labels_hide_below, accuracy = labels_accuracy )(after_stat(prop)), color = after_scale(hex_bw(.data$fill)) ), stat = StatProp, complete = "fill", position = position_likert( vjust = .5, reverse = reverse_likert, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), size = labels_size ) } if (add_labels && labels_color != "auto") { p <- p + geom_text( mapping = aes( label = label_percent_abs( hide_below = labels_hide_below, accuracy = labels_accuracy )(after_stat(prop)) ), stat = StatProp, complete = "fill", position = position_likert( vjust = .5, reverse = reverse_likert, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), size = labels_size, color = labels_color ) } if (add_totals) { dtot <- data |> dplyr::group_by(.data[[y]], !!!facet_rows, !!!facet_cols) |> dplyr::summarise( prop_lower = .prop_lower( .data$.answer, .data$.weights, include_center = TRUE, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), prop_higher = .prop_higher( .data$.answer, .data$.weights, include_center = TRUE, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), label_lower = .prop_lower( .data$.answer, .data$.weights, include_center = totals_include_center, exclude_fill_values = exclude_fill_values, cutoff = cutoff ), label_higher = .prop_higher( .data$.answer, .data$.weights, include_center = totals_include_center, exclude_fill_values = exclude_fill_values, cutoff = cutoff ) ) |> dplyr::ungroup() |> dplyr::mutate( label_lower = label_percent_abs(accuracy = totals_accuracy)(.data$label_lower), label_higher = label_percent_abs(accuracy = totals_accuracy)(.data$label_higher), x_lower = dplyr::if_else( symmetric, -1 * max(.data$prop_lower, .data$prop_higher) - totals_hjust, -1 * max(.data$prop_lower) - totals_hjust ), x_higher = dplyr::if_else( symmetric, max(.data$prop_higher, .data$prop_lower) + totals_hjust, max(.data$prop_higher) + totals_hjust ) ) |> dplyr::group_by(!!!facet_rows, !!!facet_cols) dtot <- dplyr::bind_rows( dtot |> dplyr::select( dplyr::all_of(c(y, x = "x_lower", label = "label_lower")), dplyr::group_cols() ), dtot |> dplyr::select( dplyr::all_of(c(y, x = "x_higher", label = "label_higher")), dplyr::group_cols() ) ) p <- p + geom_text( mapping = aes( y = .data[[y]], x = .data[["x"]], label = .data[["label"]], fill = NULL, by = NULL, weight = NULL ), data = dtot, size = totals_size, color = totals_color, fontface = totals_fontface ) } if (symmetric) { p <- p + scale_x_continuous( labels = label_percent_abs(), limits = symmetric_limits ) } else { p <- p + scale_x_continuous(labels = label_percent_abs()) } p <- p + labs(x = NULL, y = NULL, fill = NULL) + scale_y_discrete(labels = scales::label_wrap(y_label_wrap)) + theme_light() + theme( legend.position = "bottom", panel.grid.major.y = element_blank() ) + scale_fill_likert(cutoff = cutoff) p + facet_grid( rows = facet_rows, cols = facet_cols, labeller = ggplot2::label_wrap_gen(facet_label_wrap) ) } #' @rdname gglikert #' @export gglikert_data <- function(data, include = dplyr::everything(), weights = NULL, variable_labels = NULL, sort = c("none", "ascending", "descending"), sort_method = c( "prop", "prop_lower", "mean", "median" ), sort_prop_include_center = TRUE, factor_to_sort = ".question", exclude_fill_values = NULL, cutoff = NULL, data_fun = NULL) { rlang::check_installed("labelled") sort <- match.arg(sort) sort_method <- match.arg(sort_method) variables <- data |> dplyr::select({{ include }}) |> colnames() weights_var <- data |> dplyr::select({{ weights }}) |> colnames() if (length(weights_var) > 1) cli::cli_abort("{.arg weights} should select only one column.") if (length(weights_var) == 0) { data$.weights <- 1 } else { data$.weights <- data[[weights_var]] } if (!is.numeric(data$.weights)) { cli::cli_abort("{.arg weights} should correspond to a numerical variable.") } if (is.list(variable_labels)) { variable_labels <- unlist(variable_labels) } data_labels <- data |> labelled::var_label(unlist = TRUE, null_action = "fill") if (!is.null(variable_labels)) { data_labels[names(variable_labels)] <- variable_labels } data_labels <- data_labels[variables] data <- data |> dplyr::mutate( dplyr::across(dplyr::all_of(variables), .fns = labelled::to_factor) ) data <- data |> dplyr::mutate( dplyr::bind_cols(forcats::fct_unify(data[, variables])) ) |> tidyr::pivot_longer( cols = dplyr::all_of(variables), names_to = ".question", values_to = ".answer" ) data$.question <- data_labels[data$.question] |> forcats::fct_inorder() factor_to_sort <- data |> dplyr::select({{ factor_to_sort }}) |> colnames() if (length(factor_to_sort) != 1) cli::cli_abort("{.arg factor_to_sort} should select only one column.") if (sort == "ascending" && sort_method == "prop") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .prop_higher, include_center = sort_prop_include_center, exclude_fill_values = exclude_fill_values, cutoff = cutoff, .na_rm = FALSE, .desc = FALSE ) } if (sort == "descending" && sort_method == "prop") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .prop_higher, include_center = sort_prop_include_center, exclude_fill_values = exclude_fill_values, cutoff = cutoff, .na_rm = FALSE, .desc = TRUE ) } if (sort == "ascending" && sort_method == "prop_lower") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .prop_lower, include_center = sort_prop_include_center, exclude_fill_values = exclude_fill_values, cutoff = cutoff, .na_rm = FALSE, .desc = FALSE ) } if (sort == "descending" && sort_method == "prop_lower") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .prop_lower, include_center = sort_prop_include_center, exclude_fill_values = exclude_fill_values, cutoff = cutoff, .na_rm = FALSE, .desc = TRUE ) } if (sort == "ascending" && sort_method == "mean") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .sort_mean, exclude_fill_values = exclude_fill_values, .na_rm = FALSE, .desc = FALSE ) } if (sort == "descending" && sort_method == "mean") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .sort_mean, exclude_fill_values = exclude_fill_values, .na_rm = FALSE, .desc = TRUE ) } if (sort == "ascending" && sort_method == "median") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .sort_median, exclude_fill_values = exclude_fill_values, .na_rm = FALSE, .desc = FALSE ) } if (sort == "descending" && sort_method == "median") { data[[factor_to_sort]] <- data[[factor_to_sort]] |> forcats::fct_reorder2( data$.answer, data$.weights, .fun = .sort_median, exclude_fill_values = exclude_fill_values, .na_rm = FALSE, .desc = TRUE ) } if (!is.null(data_fun)) { if (!is.function(data_fun)) cli::cli_abort("{arg data_fun} should be a function.") data <- data_fun(data) } data } # Compute the proportion being higher than the center # Option to include the centre (if yes, only half taken into account) .prop_higher <- function(x, w, include_center = TRUE, exclude_fill_values = NULL, cutoff = NULL) { N <- sum(as.integer(!is.na(x)) * w) if (!is.factor(x)) x <- factor(x) if (!is.null(exclude_fill_values)) { l <- levels(x) l <- l[!l %in% exclude_fill_values] x <- factor(x, levels = l) } if (is.null(cutoff)) cutoff <- length(levels(x)) / 2 x <- as.numeric(x) m <- ceiling(cutoff) sum( w * as.integer(x >= cutoff + 1), include_center * w * (x == m) * (m - cutoff), na.rm = TRUE ) / N } # Compute the proportion being higher than the center # Option to include the centre (if yes, only half taken into account) .prop_lower <- function(x, w, include_center = TRUE, exclude_fill_values = NULL, cutoff = NULL) { N <- sum(as.integer(!is.na(x)) * w) if (!is.factor(x)) x <- factor(x) if (!is.null(exclude_fill_values)) { l <- levels(x) l <- l[!l %in% exclude_fill_values] x <- factor(x, levels = l) } if (is.null(cutoff)) cutoff <- length(levels(x)) / 2 x <- as.numeric(x) m <- ceiling(cutoff) sum( w * as.integer(x <= cutoff), include_center * w * (x == m) * (cutoff %% 1), na.rm = TRUE ) / N } #' @importFrom stats weighted.mean .sort_mean <- function(x, w, exclude_fill_values = NULL) { if (!is.factor(x)) x <- factor(x) if (!is.null(exclude_fill_values)) { l <- levels(x) l <- l[!l %in% exclude_fill_values] x <- factor(x, levels = l) } x <- as.integer(x) stats::weighted.mean(x, w, na.rm = TRUE) } .sort_median <- function(x, w, exclude_fill_values = NULL) { if (!is.factor(x)) x <- factor(x) if (!is.null(exclude_fill_values)) { l <- levels(x) l <- l[!l %in% exclude_fill_values] x <- factor(x, levels = l) } x <- as.integer(x) med <- weighted.median(x, w, na.rm = TRUE) med + stats::weighted.mean(x > med, w, na.rm = TRUE) - stats::weighted.mean(x < med, w, na.rm = TRUE) } #' @rdname gglikert #' @param add_median_line add a vertical line at 50%? #' @param reverse_fill if `TRUE`, will reverse the default stacking order, #' see [ggplot2::position_fill()] #' @export #' @examples #' gglikert_stacked(df, q1:q6) #' #' gglikert_stacked(df, q1:q6, add_median_line = TRUE, sort = "asc") #' #' \donttest{ #' gglikert_stacked(df_group, q1:q6, y = "group", add_median_line = TRUE) + #' facet_grid(rows = vars(.question)) #' } gglikert_stacked <- function(data, include = dplyr::everything(), weights = NULL, y = ".question", variable_labels = NULL, sort = c("none", "ascending", "descending"), sort_method = c( "prop", "prop_lower", "mean", "median" ), sort_prop_include_center = FALSE, factor_to_sort = ".question", data_fun = NULL, add_labels = TRUE, labels_size = 3.5, labels_color = "auto", labels_accuracy = 1, labels_hide_below = .05, add_median_line = FALSE, y_reverse = TRUE, y_label_wrap = 50, reverse_fill = TRUE, width = .9) { data <- gglikert_data( data, {{ include }}, weights = {{ weights }}, variable_labels = variable_labels, sort = sort, sort_method = sort_method, sort_prop_include_center = sort_prop_include_center, factor_to_sort = {{ factor_to_sort }}, exclude_fill_values = NULL, data_fun = data_fun ) y <- data |> dplyr::select({{ y }}) |> colnames() if (length(y) != 1) cli::cli_abort("{.arg y} should select only one column.") if (!is.factor(data[[y]])) { data[[y]] <- factor(data[[y]]) } if (y_reverse) { data[[y]] <- data[[y]] |> forcats::fct_rev() } p <- ggplot(data) + aes( y = .data[[y]], fill = .data[[".answer"]], by = .data[[y]], weight = .data[[".weights"]] ) + geom_bar( position = position_fill(reverse = reverse_fill), stat = StatProp, complete = "fill", width = width ) if (add_labels && labels_color == "auto") { p <- p + geom_text( mapping = aes( label = label_percent_abs( hide_below = labels_hide_below, accuracy = labels_accuracy )(after_stat(prop)), color = after_scale(hex_bw(.data$fill)) ), stat = StatProp, complete = "fill", position = position_fill( vjust = .5, reverse = reverse_fill ), size = labels_size ) } if (add_labels && labels_color != "auto") { p <- p + geom_text( mapping = aes( label = label_percent_abs( hide_below = labels_hide_below, accuracy = labels_accuracy )(after_stat(prop)) ), stat = StatProp, complete = "fill", position = position_fill( vjust = .5, reverse = reverse_fill ), size = labels_size, color = labels_color ) } if (add_median_line) { p <- p + ggplot2::geom_vline(xintercept = .5) } p <- p + labs(x = NULL, y = NULL, fill = NULL) + scale_x_continuous(labels = label_percent_abs()) + scale_y_discrete(labels = scales::label_wrap(y_label_wrap)) + theme_light() + theme( legend.position = "bottom", panel.grid.major.y = element_blank() ) + scale_fill_extended() p } ggstats/R/hex_bw.R0000644000176200001440000000307114674033502013533 0ustar liggesusers#' Identify a suitable font color (black or white) given a background HEX color #' #' @param hex_code Background color in hex-format. #' @return Either black or white, in hex-format #' @source Adapted from `saros` #' @export #' @examples #' hex_bw("#0dadfd") #' #' library(ggplot2) #' ggplot(diamonds) + #' aes(x = cut, fill = color, label = after_stat(count)) + #' geom_bar() + #' geom_text( #' mapping = aes(color = after_scale(hex_bw(.data$fill))), #' position = position_stack(.5), #' stat = "count", #' size = 2 #' ) hex_bw <- function(hex_code) { rgb_conv <- lapply( grDevices::col2rgb(hex_code), FUN = function(.x) { ifelse( .x / 255 <= 0.04045, .x * 12.92 / 255, ((.x / 255 + 0.055) / 1.055)^2.4 ) } ) |> unlist() |> matrix(ncol = length(hex_code), byrow = FALSE) |> sweep(MARGIN = 1, STATS = c(0.2126, 0.7152, 0.0722), FUN = `*`) |> apply(MARGIN = 2, FUN = sum) bw <- ifelse( rgb_conv > 0.2, # 0.179 in the original code "#000000", "#ffffff" ) bw[is.na(hex_code)] <- "#ffffff" bw } #' @rdname hex_bw #' @description #' `hex_bw_threshold()` is a variation of `hex_bw()`. For `values` below #' `threshold`, black (`"#000000"`) will always be returned, regardless of #' `hex_code`. #' @export #' @param values Values to be compared. #' @param threshold Threshold. hex_bw_threshold <- function(hex_code, values, threshold) { x <- hex_bw(hex_code) x[values < threshold] <- "#000000" x } ggstats/R/symmetric_limits.R0000644000176200001440000000201714657111214015651 0ustar liggesusers#' Symmetric limits #' #' Expand scale limits to make them symmetric around zero. #' Can be passed as argument to parameter `limits` of continuous scales from #' packages `{ggplot2}` or `{scales}`. Can be also used to obtain an enclosing #' symmetric range for numeric vectors. #' #' @param x a vector of numeric values, possibly a range, from which to compute #' enclosing range #' @return A numeric vector of length two with the new limits, which are always #' such that the absolute value of upper and lower limits is the same. #' @source Adapted from the homonym function in `{ggpmisc}` #' @export #' @examples #' library(ggplot2) #' #' ggplot(iris) + #' aes(x = Sepal.Length - 5, y = Sepal.Width - 3, colour = Species) + #' geom_vline(xintercept = 0) + #' geom_hline(yintercept = 0) + #' geom_point() #' #' last_plot() + #' scale_x_continuous(limits = symmetric_limits) + #' scale_y_continuous(limits = symmetric_limits) symmetric_limits <- function(x) { max <- max(abs(x)) c(-max, max) } ggstats/vignettes/0000755000176200001440000000000014674040020013733 5ustar liggesusersggstats/vignettes/ggcoef_model.Rmd0000644000176200001440000002234314674033502017024 0ustar liggesusers--- title: "Plot model coefficients with `ggcoef_model()`" author: Joseph Larmarange output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Plot model coefficients with `ggcoef_model()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) ``` ```{r include=FALSE} if ( !broom.helpers::.assert_package("emmeans", boolean = TRUE) ) { knitr::opts_chunk$set(eval = FALSE) } ``` The purpose of `ggcoef_model()` is to quickly plot the coefficients of a model. It is an updated and improved version of `GGally::ggcoef()` based on `broom.helpers::tidy_plus_plus()`. For displaying a nicely formatted table of the same models, look at `gtsummary::tbl_regression()`. ## Quick coefficients plot To work automatically, this function requires the `{broom.helpers}`. Simply call `ggcoef_model()` with a model object. It could be the result of `stats::lm`, `stats::glm` or any other model covered by `{broom.helpers}`. ```{r ggcoef-reg} data(tips, package = "reshape") mod_simple <- lm(tip ~ day + time + total_bill, data = tips) ggcoef_model(mod_simple) ``` In the case of a logistic regression (or any other model for which coefficients are usually exponentiated), simply indicated `exponentiate = TRUE`. Note that a logarithmic scale will be used for the x-axis. ```{r ggcoef-titanic} d_titanic <- as.data.frame(Titanic) d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes")) mod_titanic <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial ) ggcoef_model(mod_titanic, exponentiate = TRUE) ``` ## Customizing the plot ### Variable labels You can use the `{labelled}` package to define variable labels. They will be automatically used by `ggcoef_model()`. Note that variable labels should be defined before computing the model. ```{r} library(labelled) tips_labelled <- tips |> set_variable_labels( day = "Day of the week", time = "Lunch or Dinner", total_bill = "Bill's total" ) mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled) ggcoef_model(mod_labelled) ``` You can also define custom variable labels directly by passing a named vector to the `variable_labels` option. ```{r} ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ) ) ``` If variable labels are to long, you can pass `ggplot2::label_wrap_gen()` or any other labeller function to `facet_labeller.` ```{r} ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ), facet_labeller = ggplot2::label_wrap_gen(10) ) ``` Use `facet_row = NULL` to hide variable names. ```{r} ggcoef_model(mod_simple, facet_row = NULL, colour_guide = TRUE) ``` ### Term labels Several options allows you to customize term labels. ```{r} ggcoef_model(mod_titanic, exponentiate = TRUE) ggcoef_model( mod_titanic, exponentiate = TRUE, show_p_values = FALSE, signif_stars = FALSE, add_reference_rows = FALSE, categorical_terms_pattern = "{level} (ref: {reference_level})", interaction_sep = " x " ) + ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) ``` By default, for categorical variables using treatment and sum contrasts, reference rows will be added and displayed on the graph. ```{r} mod_titanic2 <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial, contrasts = list(Sex = contr.sum, Class = contr.treatment(4, base = 3)) ) ggcoef_model(mod_titanic2, exponentiate = TRUE) ``` Continuous variables with polynomial terms defined with `stats::poly()` are also properly managed. ```{r} mod_poly <- lm(Sepal.Length ~ poly(Petal.Width, 3) + Petal.Length, data = iris) ggcoef_model(mod_poly) ``` Use `no_reference_row` to indicate which variables should not have a reference row added. ```{r} ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = "Sex" ) ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = broom.helpers::all_dichotomous() ) ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = broom.helpers::all_categorical(), categorical_terms_pattern = "{level}/{reference_level}" ) ``` ### Elements to display Use `intercept = TRUE` to display intercepts. ```{r} ggcoef_model(mod_simple, intercept = TRUE) ``` You can remove confidence intervals with `conf.int = FALSE`. ```{r} ggcoef_model(mod_simple, conf.int = FALSE) ``` By default, significant terms (i.e. with a p-value below 5%) are highlighted using two types of dots. You can control the level of significance with `significance` or remove it with `significance = NULL`. ```{r} ggcoef_model(mod_simple, significance = NULL) ``` By default, dots are colored by variable. You can deactivate this behavior with `colour = NULL`. ```{r} ggcoef_model(mod_simple, colour = NULL) ``` You can display only a subset of terms with **include**. ```{r} ggcoef_model(mod_simple, include = c("time", "total_bill")) ``` It is possible to use `tidyselect` helpers. ```{r} ggcoef_model(mod_simple, include = dplyr::starts_with("t")) ``` You can remove stripped rows with `stripped_rows = FALSE`. ```{r} ggcoef_model(mod_simple, stripped_rows = FALSE) ``` Do not hesitate to consult the help file of `ggcoef_model()` to see all available options. ### ggplot2 elements The plot returned by `ggcoef_model()` is a classic `ggplot2` plot. You can therefore apply `ggplot2` functions to it. ```{r} ggcoef_model(mod_simple) + ggplot2::xlab("Coefficients") + ggplot2::ggtitle("Custom title") + ggplot2::scale_color_brewer(palette = "Set1") + ggplot2::theme(legend.position = "right") ``` ## Forest plot with a coefficient table `ggcoef_table()` is a variant of `ggcoef_model()` displaying a coefficient table on the right of the forest plot. ```{r} ggcoef_table(mod_simple) ggcoef_table(mod_titanic, exponentiate = TRUE) ``` You can easily customize the columns to be displayed. ```{r} ggcoef_table( mod_simple, table_stat = c("label", "estimate", "std.error", "ci"), ci_pattern = "{conf.low} to {conf.high}", table_stat_label = list( estimate = scales::label_number(accuracy = .001), conf.low = scales::label_number(accuracy = .01), conf.high = scales::label_number(accuracy = .01), std.error = scales::label_number(accuracy = .001), label = toupper ), table_header = c("Term", "Coef.", "SE", "CI"), table_witdhs = c(2, 3) ) ``` ## Multinomial models For multinomial models, simply use `ggcoef_multinom()`. Three types of visualizations are available: `"dodged"`, `"faceted"` and `"table"`. ```{r} library(nnet) hec <- as.data.frame(HairEyeColor) mod <- multinom( Hair ~ Eye + Sex, data = hec, weights = hec$Freq ) ggcoef_multinom( mod, exponentiate = TRUE ) ggcoef_multinom( mod, exponentiate = TRUE, type = "faceted" ) ``` ```{r, fig.height=9, fig.width=6} ggcoef_multinom( mod, exponentiate = TRUE, type = "table" ) ``` You can use `y.level_label` to customize the label of each level. ```{r} ggcoef_multinom( mod, type = "faceted", y.level_label = c("Brown" = "Brown\n(ref: Black)"), exponentiate = TRUE ) ``` ## Multi-components models Multi-components models such as zero-inflated Poisson or beta regression generate a set of terms for each of their components. You can use `ggcoef_multicomponents()` which is similar to `ggcoef_multinom()`. ```{r} library(pscl) data("bioChemists", package = "pscl") mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists) ggcoef_multicomponents(mod) ggcoef_multicomponents(mod, type = "f") ``` ```{r, fig.height=7, fig.width=6} ggcoef_multicomponents(mod, type = "t") ggcoef_multicomponents( mod, type = "t", component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") ) ``` ## Comparing several models You can easily compare several models with `ggcoef_compare()`. To be noted, `ggcoef_compare()` is not compatible with multinomial or multi-components models. ```{r} mod1 <- lm(Fertility ~ ., data = swiss) mod2 <- step(mod1, trace = 0) mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) models <- list( "Full model" = mod1, "Simplified model" = mod2, "With interaction" = mod3 ) ggcoef_compare(models) ggcoef_compare(models, type = "faceted") ``` ## Advanced users Advanced users could use their own dataset and pass it to `ggcoef_plot()`. Such dataset could be produced by `ggcoef_model()`, `ggcoef_compare()` or `ggcoef_multinom()` with the option `return_data = TRUE` or by using `broom::tidy()` or `broom.helpers::tidy_plus_plus()`. ## Supported models ```{r, echo=FALSE} broom.helpers::supported_models |> knitr::kable() ``` Note: this list of models has been tested. `{broom.helpers}`, and therefore `ggcoef_model()`, may or may not work properly or partially with other types of models. ggstats/vignettes/stat_weighted_mean.Rmd0000644000176200001440000000526514357760262020261 0ustar liggesusers--- title: "Compute weighted mean with `stat_weighted_mean()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Compute weighted mean with `stat_weighted_mean()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(ggplot2) ``` `stat_weighted_mean()` computes mean value of **y** (taking into account any **weight** aesthetic if provided) for each value of **x**. More precisely, it will return a new data frame with one line per unique value of **x** with the following new variables: - **y**: mean value of the original **y** (i.e. **numerator**/**denominator**) - **numerator** - **denominator** Let's take an example. The following plot shows all tips received according to the day of the week. ```{r} data(tips, package = "reshape") ggplot(tips) + aes(x = day, y = tip) + geom_point() ``` To plot their mean value per day, simply use `stat_weighted_mean()`. ```{r} ggplot(tips) + aes(x = day, y = tip) + stat_weighted_mean() ``` We can specify the geometry we want using `geom` argument. Note that for lines, we need to specify the **group** aesthetic as well. ```{r} ggplot(tips) + aes(x = day, y = tip, group = 1) + stat_weighted_mean(geom = "line") ``` An alternative is to specify the statistic in `ggplot2::geom_line()`. ```{r} ggplot(tips) + aes(x = day, y = tip, group = 1) + geom_line(stat = "weighted_mean") ``` Of course, it could be use with other geometries. Here a bar plot. ```{r} p <- ggplot(tips) + aes(x = day, y = tip, fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + ylab("mean tip") p ``` It is very easy to add facets. In that case, computation will be done separately for each facet. ```{r} p + facet_grid(rows = vars(smoker)) ``` `stat_weighted_mean()` could be also used for computing proportions as a proportion is technically a mean of binary values (0 or 1). ```{r} ggplot(tips) + aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + scale_y_continuous(labels = scales::percent) + ylab("proportion of smoker") ``` Finally, you can use the **weight** aesthetic to indicate weights to take into account for computing means / proportions. ```{r} d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, y = as.integer(Survived == "Yes"), weight = Freq, fill = Sex) + geom_bar(stat = "weighted_mean", position = "dodge") + scale_y_continuous(labels = scales::percent) + labs(y = "Proportion who survived") ``` ggstats/vignettes/gglikert.Rmd0000644000176200001440000002037314674033502016223 0ustar liggesusers--- title: "Plot Likert-type items with `gglikert()`" author: Joseph Larmarange output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Plot Likert-type items with `gglikert()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(dplyr) library(ggplot2) ``` The purpose of `gglikert()` is to generate a centered bar plot comparing the answers of several questions sharing a common Likert-type scale. ## Generating an example dataset ```{r} likert_levels <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree" ) set.seed(42) df <- tibble( q1 = sample(likert_levels, 150, replace = TRUE), q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q5 = sample(c(likert_levels, NA), 150, replace = TRUE), q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) likert_levels_dk <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Don't know" ) df_dk <- tibble( q1 = sample(likert_levels_dk, 150, replace = TRUE), q2 = sample(likert_levels_dk, 150, replace = TRUE, prob = 6:1), q3 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q4 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q5 = sample(c(likert_levels_dk, NA), 150, replace = TRUE), q6 = sample( likert_levels_dk, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0, 1) ) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels_dk))) ``` ## Quick plot Simply call `gglikert()`. ```{r} gglikert(df) ``` The list of variables to plot (all by default) could by specify with `include`. This argument accepts tidy-select syntax. ```{r} gglikert(df, include = q1:q3) ``` ## Customizing the plot The generated plot is a standard `ggplot2` object. You can therefore use `ggplot2` functions to custom many aspects. ```{r} gglikert(df) + ggtitle("A Likert-type items plot", subtitle = "generated with gglikert()") + scale_fill_brewer(palette = "RdYlBu") ``` ### Sorting the questions You can sort the plot with `sort`. ```{r} gglikert(df, sort = "ascending") ``` By default, the plot is sorted based on the proportion being higher than the center level, i.e. in this case the proportion of answers equal to "Agree" or "Strongly Agree". Alternatively, the questions could be transformed into a score and sorted accorded to their mean. ```{r} gglikert(df, sort = "ascending", sort_method = "mean") ``` ### Sorting the answers You can reverse the order of the answers with `reverse_likert`. ```{r} gglikert(df, reverse_likert = TRUE) ``` ### Proportion labels Proportion labels could be removed with `add_labels = FALSE`. ```{r} gglikert(df, add_labels = FALSE) ``` or customized. ```{r} gglikert( df, labels_size = 3, labels_accuracy = .1, labels_hide_below = .2, labels_color = "white" ) ``` ### Totals on each side By default, totals are added on each side of the plot. In case of an uneven number of answer levels, the central level is not taken into account for computing totals. With `totals_include_center = TRUE`, half of the proportion of the central level will be added on each side. ```{r} gglikert( df, totals_include_center = TRUE, sort = "descending", sort_prop_include_center = TRUE ) ``` Totals could be customized. ```{r} gglikert( df, totals_size = 4, totals_color = "blue", totals_fontface = "italic", totals_hjust = .20 ) ``` Or removed. ```{r} gglikert(df, add_totals = FALSE) ``` ## Variable labels If you are using variable labels (see `labelled::set_variable_labels()`), they will be taken automatically into account by `gglikert()`. ```{r} if (require(labelled)) { df <- df |> set_variable_labels( q1 = "first question", q2 = "second question", q3 = "this is the third question with a quite long variable label" ) } gglikert(df) ``` You can also provide custom variable labels with `variable_labels`. ```{r} gglikert( df, variable_labels = c( q1 = "alternative label for the first question", q6 = "another custom label" ) ) ``` You can control how variable labels are wrapped with `y_label_wrap`. ```{r} gglikert(df, y_label_wrap = 20) gglikert(df, y_label_wrap = 200) ``` ## Custom center By default, Likert plots will be centered, i.e. displaying the same number of categories on each side on the graph. When the number of categories is odd, half of the "central" category is displayed negatively and half positively. It is possible to control where to center the graph, using the `cutoff` argument, representing the number of categories to be displayed negatively: `2` to display the two first categories negatively and the others positively; `2.25` to display the two first categories and a quarter of the third negatively. ```{r} gglikert(df, cutoff = 0) gglikert(df, cutoff = 1) gglikert(df, cutoff = 1.25) gglikert(df, cutoff = 1.75) gglikert(df, cutoff = 2) gglikert(df, cutoff = NULL) gglikert(df, cutoff = 4) gglikert(df, cutoff = 5) ``` ## Symmetric x-axis Simply specify `symmetric = TRUE`. ```{r} gglikert(df, cutoff = 1) gglikert(df, cutoff = 1, symmetric = TRUE) ``` ## Removing certain values Sometimes, the dataset could contain certain values that you should not be displayed. ```{r} gglikert(df_dk) ``` A first option could be to convert the don't knows into `NA`. In such case, the proportions will be computed on non missing. ```{r} df_dk |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) |> gglikert() ``` Or, you could use `exclude_fill_values` to not display specific values, but still counting them in the denominator for computing proportions. ```{r} df_dk |> gglikert(exclude_fill_values = "Don't know") ``` ## Facets To define facets, use `facet_rows` and/or `facet_cols`. ```{r message=FALSE} df_group <- df df_group$group1 <- sample(c("A", "B"), 150, replace = TRUE) df_group$group2 <- sample(c("a", "b", "c"), 150, replace = TRUE) gglikert(df_group, q1:q6, facet_cols = vars(group1), labels_size = 3 ) gglikert(df_group, q1:q2, facet_rows = vars(group1, group2), labels_size = 3 ) gglikert(df_group, q3:q6, facet_cols = vars(group1), facet_rows = vars(group2), labels_size = 3 ) + scale_x_continuous( labels = label_percent_abs(), expand = expansion(0, .2) ) ``` To compare answers by subgroup, you can alternatively map `.question` to facets, and define a grouping variable for `y`. ```{r} gglikert(df_group, q1:q4, y = "group1", facet_rows = vars(.question), labels_size = 3, facet_label_wrap = 15 ) ``` ## Stacked plot For a more classical stacked bar plot, you can use `gglikert_stacked()`. ```{r} gglikert_stacked(df) gglikert_stacked( df, sort = "asc", add_median_line = TRUE, add_labels = FALSE ) gglikert_stacked( df_group, include = q1:q4, y = "group2" ) + facet_grid( rows = vars(.question), labeller = label_wrap_gen(15) ) ``` ## Long format dataset Internally, `gglikert()` is calling `gglikert_data()` to generate a long format dataset combining all questions into two columns, `.question` and `.answer`. ```{r} gglikert_data(df) |> head() ``` Such dataset could be useful for other types of plot, for example for a classic stacked bar plot. ```{r} ggplot(gglikert_data(df)) + aes(y = .question, fill = .answer) + geom_bar(position = "fill") ``` ## Weighted data `gglikert()`, `gglikert_stacked()` and `gglikert_data()` accepts a `weights` argument, allowing to specify statistical weights. ```{r} df$sampling_weights <- runif(nrow(df)) gglikert(df, q1:q4, weights = sampling_weights) ``` ## See also The function `position_likert()` used to center bars. ggstats/vignettes/stat_cross.Rmd0000644000176200001440000000601514357760262016604 0ustar liggesusers--- title: "Compute cross-tabulation statistics with `stat_cross()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Compute cross-tabulation statistics with `stat_cross()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(ggplot2) ``` This statistic is intended to be used with two discrete variables mapped to **x** and **y** aesthetics. It will compute several statistics of a cross-tabulated table using `broom::tidy.test()` and `stats::chisq.test()`. More precisely, the computed variables are: - **observed**: number of observations in x,y - **prop**: proportion of total - **row.prop**: row proportion - **col.prop**: column proportion - **expected**: expected count under the null hypothesis - **resid**: Pearson's residual - **std.resid**: standardized residual - **row.observed**: total number of observations within row - **col.observed**: total number of observations within column - **total.observed**: total number of observations within the table - **phi**: phi coefficients, see `augment_chisq_add_phi()` By default, `stat_cross()` is using `ggplot2::geom_points()`. If you want to plot the number of observations, you need to map `after_stat(observed)` to an aesthetic (here **size**): ```{r} d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) + stat_cross() + scale_size_area(max_size = 20) ``` Note that the **weight** aesthetic is taken into account by `stat_cross()`. We can go further using a custom shape and filling points with standardized residual to identify visually cells who are over- or underrepresented. ```{r fig.height=6, fig.width=6} ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(std.resid) ) + stat_cross(shape = 22) + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + scale_size_area(max_size = 20) ``` We can easily recreate a cross-tabulated table. ```{r} ggplot(d) + aes(x = Class, y = Survived, weight = Freq) + geom_tile(fill = "white", colour = "black") + geom_text(stat = "cross", mapping = aes(label = after_stat(observed))) + theme_minimal() ``` Even more complicated, we want to produce a table showing column proportions and where cells are filled with standardized residuals. Note that `stat_cross()` could be used with facets. In that case, computation is done separately in each facet. ```{r} ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = scales::percent(after_stat(col.prop), accuracy = .1), fill = after_stat(std.resid) ) + stat_cross(shape = 22, size = 30) + geom_text(stat = "cross") + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + facet_grid(rows = vars(Sex)) + labs(fill = "Standardized residuals") + theme_minimal() ``` ggstats/vignettes/stat_prop.Rmd0000644000176200001440000001242214674033502016422 0ustar liggesusers--- title: "Compute custom proportions with `stat_prop()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Compute custom proportions with `stat_prop()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(ggplot2) ``` `stat_prop()` is a variation of `ggplot2::stat_count()` allowing to compute custom proportions according to the **by** aesthetic defining the denominator (i.e. all proportions for a same value of **by** will sum to 1). The **by** aesthetic should be a factor. Therefore, `stat_prop()` requires the **by** aesthetic and this **by** aesthetic should be a factor. ## Adding labels on a percent stacked bar plot When using `position = "fill"` with `geom_bar()`, you can produce a percent stacked bar plot. However, the proportions corresponding to the **y** axis are not directly accessible using only `ggplot2`. With `stat_prop()`, you can easily add them on the plot. In the following example, we indicated `stat = "prop"` to `ggplot2::geom_text()` to use `stat_prop()`, we defined the **by** aesthetic (here we want to compute the proportions separately for each value of **x**), and we also used `ggplot2::position_fill()` when calling `ggplot2::geom_text()`. ```{r} d <- as.data.frame(Titanic) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) p ``` Note that `stat_prop()` has properly taken into account the **weight** aesthetic. `stat_prop()` is also compatible with faceting. In that case, proportions are computed separately in each facet. ```{r} p + facet_grid(cols = vars(Sex)) ``` ## Displaying proportions of the total If you want to display proportions of the total, simply map the **by** aesthetic to `1`. Here an example using a stacked bar chart. ```{r} ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = 1) + geom_bar() + geom_text( aes(label = scales::percent(after_stat(prop), accuracy = 1)), stat = "prop", position = position_stack(.5) ) ``` ## A dodged bar plot to compare two distributions A dodged bar plot could be used to compare two distributions. ```{r} ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex) + geom_bar(position = "dodge") ``` On the previous graph, it is difficult to see if first class is over- or under-represented among women, due to the fact they were much more men on the boat. `stat_prop()` could be used to adjust the graph by displaying instead the proportion within each category (i.e. here the proportion by sex). ```{r} ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) + geom_bar(stat = "prop", position = "dodge") + scale_y_continuous(labels = scales::percent) ``` The same example with labels: ```{r} ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) + geom_bar(stat = "prop", position = "dodge") + scale_y_continuous(labels = scales::percent) + geom_text( mapping = aes( label = scales::percent(after_stat(prop), accuracy = .1), y = after_stat(0.01) ), vjust = "bottom", position = position_dodge(.9), stat = "prop" ) ``` ## Displaying unobserved levels With the `complete` argument, it is possible to indicate an aesthetic for those statistics should be completed for unobserved values. ```{r} d <- diamonds |> dplyr::filter(!(cut == "Ideal" & clarity == "I1")) |> dplyr::filter(!(cut == "Very Good" & clarity == "VS2")) |> dplyr::filter(!(cut == "Premium" & clarity == "IF")) p <- ggplot(d) + aes(x = clarity, fill = cut, by = clarity) + geom_bar(position = "fill") p + geom_text( stat = "prop", position = position_fill(.5) ) ``` Adding `complete = "fill"` will generate "0.0%" labels where relevant. ```{r} p + geom_text( stat = "prop", position = position_fill(.5), complete = "fill" ) ``` ## Using `geom_prop_bar()` and `geom_prop_text()` The dedicated geometries `geom_prop_bar()` and `geom_prop_text()` could be used for quick and easy proportional bar plots. They use by default `stat_prop()` with relevant default values. For example, proportions are computed by **x** or **y** if the `by` aesthetic is not specified. It allows to generate a quick proportional bar plot. ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_prop_bar() + geom_prop_text() ``` You can specify a `by` aesthetic. For example, to reproduce the comparison of the two distributions presented earlier. ```{r} d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex) + geom_prop_bar(position = "dodge") + geom_prop_text( position = position_dodge(width = .9), vjust = - 0.5 ) + scale_y_continuous(labels = scales::percent) ``` You can also display counts instead of proportions. ```{r} ggplot(diamonds) + aes(x = clarity, fill = cut) + geom_prop_bar(height = "count") + geom_prop_text( height = "count", labels = "count", labeller = scales::number ) ``` ggstats/vignettes/geom_diverging.Rmd0000644000176200001440000001261014674033502017373 0ustar liggesusers--- title: "Geometries for diverging bar plots" author: Joseph Larmarange output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Geometries for diverging bar plots} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(dplyr) library(ggplot2) library(patchwork) ``` *Note :* if you are looking for an all-in-one function to display Likert-type items, please refer to `gglikert()` and `vignette("gglikert")`. ## New positions Diverging bar plots could be achieved using `position_diverging()` or `position_likert()`. `position_diverging()` stacks bars on top of each other and centers them around zero (the same number of categories are displayed on each side). ```{r} base <- ggplot(diamonds) + aes(y = clarity, fill = cut) + theme(legend.position = "none") p_stack <- base + geom_bar(position = "stack") + ggtitle("position_stack()") p_diverging <- base + geom_bar(position = "diverging") + ggtitle("position_diverging()") p_stack + p_diverging ``` `position_likert()` is similar but uses proportions instead of counts. ```{r} p_fill <- base + geom_bar(position = "fill") + ggtitle("position_fill()") p_likert <- base + geom_bar(position = "likert") + ggtitle("position_likert()") p_fill + p_likert ``` By default, the same number of categories is displayed on each side, i.e. if you have 4 categories, 2 will be displayed negatively and 2 positively. If you have an odd number of categories, half of the central category will be displayed negatively and half positively. The center could be changed with the `cutoff` argument, representing the number of categories to be displayed negatively: `2` to display negatively the two first categories, `2.5` to display negatively the two first categories and half of the third, `2.2` to display negatively the two first categories and a fifth of the third. ```{r} p_1 <- base + geom_bar(position = position_diverging(cutoff = 1)) + ggtitle("cutoff = 1") p_2 <- base + geom_bar(position = position_diverging(cutoff = 2)) + ggtitle("cutoff = 2") p_null <- base + geom_bar(position = position_diverging(cutoff = NULL)) + ggtitle("cutoff = NULL") p_3.75 <- base + geom_bar(position = position_diverging(cutoff = 3.75)) + ggtitle("cutoff = 3.75") p_5 <- base + geom_bar(position = position_diverging(cutoff = 5)) + ggtitle("cutoff = 5") wrap_plots(p_1, p_2, p_null, p_3.75, p_5) ``` ## New scales For a diverging bar plot, it is recommended to use a diverging palette, as provided in the Brewer palettes. Sometimes, the number of available colors is insufficient in the palette. In that case, you could use `pal_extender()` or `scale_fill_extended()`. However, if you use a custom `cutoff`, it is also important to change the center of the palette as well. Therefore, for diverging bar plots, we recommend to use `scale_fill_likert()`. ```{r} wrap_plots( p_1 + scale_fill_likert(cutoff = 1), p_null + scale_fill_likert(), p_3.75 + scale_fill_likert(cutoff = 3.75) ) ``` ## Improving axes You may also want have centered axes. That could be easily achieved with `symmetric_limits()`. You could also use `label_number_abs()` or `label_percent_abs()` to display absolute numbers. ```{r} wrap_plots( p_3.75, p_3.75 + scale_x_continuous( limits = symmetric_limits, labels = label_number_abs() ) ) ``` ## New geometries To facilitate the creation of diverging bar plots, you could use variants of `geom_bar()` and `geom_text()`. ### geom_diverging() & geom_diverging_text() Let's consider the following plot: ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "diverging") + geom_text( aes( label = label_number_abs(hide_below = 800) (after_stat(count)) ), stat = "count", position = position_diverging(.5) ) + scale_fill_likert() + scale_x_continuous( labels = label_number_abs(), limits = symmetric_limits ) ``` The same could be achieved quicker with `geom_diverging()` and `geom_diverging_text()`. ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_diverging() + geom_diverging_text(hide_below = 800) + scale_fill_likert() + scale_x_continuous( labels = label_number_abs(), limits = symmetric_limits ) ``` ### geom_likert() & geom_likert_text() `geom_likert()` and `geom_likert_text()` works similarly. `geom_likert_text()` takes advantages of `stat_prop()` for computing the proportions to be displayed (see `vignette("stat_prop")`). ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_likert() + geom_likert_text(hide_below = 0.10) + scale_fill_likert() + scale_x_continuous( labels = label_percent_abs() ) ``` ### geom_pyramid() & geom_pyramid_text() Finally, `geom_pyramid()` and `geom_pyramid_text()` are variations adapted to display an age-sex pyramid. It uses proportions of the total. ```{r} d <- Titanic |> as.data.frame() ggplot(d) + aes(y = Class, fill = Sex, weight = Freq) + geom_pyramid() + geom_pyramid_text() + scale_x_continuous( labels = label_percent_abs(), limits = symmetric_limits ) ``` ggstats/NAMESPACE0000644000176200001440000000301314674033502013146 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(round_any,POSIXct) S3method(round_any,numeric) export(PositionDiverging) export(PositionLikert) export(StatCross) export(StatProp) export(StatWeightedMean) export(augment_chisq_add_phi) export(compute_cascade) export(geom_diverging) export(geom_diverging_text) export(geom_likert) export(geom_likert_text) export(geom_prop_bar) export(geom_prop_text) export(geom_pyramid) export(geom_pyramid_text) export(geom_stripped_cols) export(geom_stripped_rows) export(ggcascade) export(ggcoef_compare) export(ggcoef_model) export(ggcoef_multicomponents) export(ggcoef_multinom) export(ggcoef_plot) export(ggcoef_table) export(gglikert) export(gglikert_data) export(gglikert_stacked) export(ggsurvey) export(hex_bw) export(hex_bw_threshold) export(label_number_abs) export(label_percent_abs) export(likert_pal) export(pal_extender) export(plot_cascade) export(position_diverging) export(position_likert) export(round_any) export(scale_colour_extended) export(scale_fill_extended) export(scale_fill_likert) export(signif_stars) export(stat_cross) export(stat_prop) export(stat_weighted_mean) export(symmetric_limits) export(weighted.median) export(weighted.quantile) export(weighted.sum) import(ggplot2) importFrom(dplyr,.data) importFrom(dplyr,sym) importFrom(ggplot2,after_scale) importFrom(ggplot2,after_stat) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,deprecated) importFrom(stats,weighted.mean) importFrom(stats,weights) ggstats/NEWS.md0000644000176200001440000000740214674037440013040 0ustar liggesusers# ggstats 0.7.0 **Minor breaking change** * `position_likert_count()` has been renamed as `position_diverging()` (#69) * R minimum version 4.2.0 is now required. **Improvements** * new experimental plot: `ggcascade()` for "cascade" plots (#71) * new scale `scale_fill_likert()` (#64) * new geometries: `geom_prop_bar()` and `geom_prop_text()` (#69) * new geometries: `geom_diverging()`, `geom_likert()`, `geom_pyramid()` and `geom_diverging_text()`, `geom_likert_text()`, `geom_pyramid_text()` (#69) * new helper `symmetric_limits()` to make a scale symmetric (#66) * new helper `pal_extender()` and corresponding `scale_fill_extender()` and `scale_colour_extender()` * new helper `weighted.sum()` for weighted sums (#71) * new sorting option `"prop_lower"` for `gglikert()` (#62) * new argument `symmetric` for `gglikert()` (#66) * new arguments `default_by`, `height`, `labels` and `labeller` for `stat_prop()` (#69) * new returned statistics for `stat_prop()`: `after_stat(denominator)`, `after_stat(height)` and `after_stat(labels)` # ggstats 0.6.0 **Improvements** * new function `hex_bw()` to identify a suitable font color given a background color (#57) * new default value `"auto"` for `labels_color` argument in `gglikert()` and `gglikert_stacked()` (using `hex_bw()`) (#57) * new argument `data_fun` for `gglikert()`, `gglikert_data()` and `gglikert_stacked()` (#60) # ggstats 0.5.1 **Bug fixes** * fix in `ggcoef_model()` and other similar functions: Unicode character removed in significance labels (#49) # ggstats 0.5.0 **Improvements** * new options `labels_color` and `totals_color` in `gglikert()` and `gglikert_stacked()` (#43) **Bug fixes** * fix in `ggcoef_multicomponents()` when `type = "table"` and `exponentiate = TRUE` * fix in `gglikert()`: the function could be called directly with `ggstats::gglikert()` without requiring the full package to be loaded (#47) # ggstats 0.4.0 **New features** * new function `ggcoef_table()` displaying a coefficient table at the right of the forest plot (#32) * new function `ggcoef_multicomponents()` for multi-components models such as zero-inflated Poisson or beta regressions (#38) * new type `"table"` for `ggcoef_multinom()` **Improvements** * `gglikert()` now aligns total proportions when faceting (#28) * new `weights` argument for `gglikert()`, `gglikert_stacked()` and `gglikert_data()` (#29) * new `y` argument for `gglikert()` and `gglikert_stacked()` (#31) * new `facet_label_wrap` argument for `gglikert()` (#31) **New helpers** * `weighted.median()` and `weighted.quantile()` functions # ggstats 0.3.0 **New features** * New functions `gglikert()`, `gglikert_stacked()` and `gglikert_data()` (#25) * New positions `position_likert()` and `position_likert_count()` (#25) * New `complete` argument for `stat_prop()` (#25) **Bug fixes** * Bug fix in `ggcoef_compare()` to preserve the order of model terms and to avoid an error with `add_reference_rows = FALSE` (#23) # ggstats 0.2.1 * Bug fix in `geom_stripped_rows()` and `geom_stripped_cols()` (#20) # ggstats 0.2.0 * Support for pairwise contrasts (#14) * New argument `tidy_args` in `ggcoef_*()` to pass additional arguments to `broom.helpers::tidy_plus_plus()` and to `tidy_fun` (#17) * Now requires `ggplot2` version 3.4.0 or more (#15) * Following change in `geom_rect()`, the `size` aesthetic is now deprecated in `geom_stripped_cols()` and `geom_stripped_rows()`: please use the `linewidth` aesthetic instead (#15) # ggstats 0.1.1 * Examples relying on Internet resources have been removed (#11) # ggstats 0.1.0 * First version, based on dev version of GGally * Fix in `ggcoef_multinom()` to display y levels not listed in `y.level_label` * `stat_cross()` now returns phi coefficients (see also `augment_chisq_add_phi()`) (#6) ggstats/inst/0000755000176200001440000000000014674040006012704 5ustar liggesusersggstats/inst/doc/0000755000176200001440000000000014674040007013452 5ustar liggesusersggstats/inst/doc/ggcoef_model.Rmd0000644000176200001440000002234314674033502016536 0ustar liggesusers--- title: "Plot model coefficients with `ggcoef_model()`" author: Joseph Larmarange output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Plot model coefficients with `ggcoef_model()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) ``` ```{r include=FALSE} if ( !broom.helpers::.assert_package("emmeans", boolean = TRUE) ) { knitr::opts_chunk$set(eval = FALSE) } ``` The purpose of `ggcoef_model()` is to quickly plot the coefficients of a model. It is an updated and improved version of `GGally::ggcoef()` based on `broom.helpers::tidy_plus_plus()`. For displaying a nicely formatted table of the same models, look at `gtsummary::tbl_regression()`. ## Quick coefficients plot To work automatically, this function requires the `{broom.helpers}`. Simply call `ggcoef_model()` with a model object. It could be the result of `stats::lm`, `stats::glm` or any other model covered by `{broom.helpers}`. ```{r ggcoef-reg} data(tips, package = "reshape") mod_simple <- lm(tip ~ day + time + total_bill, data = tips) ggcoef_model(mod_simple) ``` In the case of a logistic regression (or any other model for which coefficients are usually exponentiated), simply indicated `exponentiate = TRUE`. Note that a logarithmic scale will be used for the x-axis. ```{r ggcoef-titanic} d_titanic <- as.data.frame(Titanic) d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes")) mod_titanic <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial ) ggcoef_model(mod_titanic, exponentiate = TRUE) ``` ## Customizing the plot ### Variable labels You can use the `{labelled}` package to define variable labels. They will be automatically used by `ggcoef_model()`. Note that variable labels should be defined before computing the model. ```{r} library(labelled) tips_labelled <- tips |> set_variable_labels( day = "Day of the week", time = "Lunch or Dinner", total_bill = "Bill's total" ) mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled) ggcoef_model(mod_labelled) ``` You can also define custom variable labels directly by passing a named vector to the `variable_labels` option. ```{r} ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ) ) ``` If variable labels are to long, you can pass `ggplot2::label_wrap_gen()` or any other labeller function to `facet_labeller.` ```{r} ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ), facet_labeller = ggplot2::label_wrap_gen(10) ) ``` Use `facet_row = NULL` to hide variable names. ```{r} ggcoef_model(mod_simple, facet_row = NULL, colour_guide = TRUE) ``` ### Term labels Several options allows you to customize term labels. ```{r} ggcoef_model(mod_titanic, exponentiate = TRUE) ggcoef_model( mod_titanic, exponentiate = TRUE, show_p_values = FALSE, signif_stars = FALSE, add_reference_rows = FALSE, categorical_terms_pattern = "{level} (ref: {reference_level})", interaction_sep = " x " ) + ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) ``` By default, for categorical variables using treatment and sum contrasts, reference rows will be added and displayed on the graph. ```{r} mod_titanic2 <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial, contrasts = list(Sex = contr.sum, Class = contr.treatment(4, base = 3)) ) ggcoef_model(mod_titanic2, exponentiate = TRUE) ``` Continuous variables with polynomial terms defined with `stats::poly()` are also properly managed. ```{r} mod_poly <- lm(Sepal.Length ~ poly(Petal.Width, 3) + Petal.Length, data = iris) ggcoef_model(mod_poly) ``` Use `no_reference_row` to indicate which variables should not have a reference row added. ```{r} ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = "Sex" ) ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = broom.helpers::all_dichotomous() ) ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = broom.helpers::all_categorical(), categorical_terms_pattern = "{level}/{reference_level}" ) ``` ### Elements to display Use `intercept = TRUE` to display intercepts. ```{r} ggcoef_model(mod_simple, intercept = TRUE) ``` You can remove confidence intervals with `conf.int = FALSE`. ```{r} ggcoef_model(mod_simple, conf.int = FALSE) ``` By default, significant terms (i.e. with a p-value below 5%) are highlighted using two types of dots. You can control the level of significance with `significance` or remove it with `significance = NULL`. ```{r} ggcoef_model(mod_simple, significance = NULL) ``` By default, dots are colored by variable. You can deactivate this behavior with `colour = NULL`. ```{r} ggcoef_model(mod_simple, colour = NULL) ``` You can display only a subset of terms with **include**. ```{r} ggcoef_model(mod_simple, include = c("time", "total_bill")) ``` It is possible to use `tidyselect` helpers. ```{r} ggcoef_model(mod_simple, include = dplyr::starts_with("t")) ``` You can remove stripped rows with `stripped_rows = FALSE`. ```{r} ggcoef_model(mod_simple, stripped_rows = FALSE) ``` Do not hesitate to consult the help file of `ggcoef_model()` to see all available options. ### ggplot2 elements The plot returned by `ggcoef_model()` is a classic `ggplot2` plot. You can therefore apply `ggplot2` functions to it. ```{r} ggcoef_model(mod_simple) + ggplot2::xlab("Coefficients") + ggplot2::ggtitle("Custom title") + ggplot2::scale_color_brewer(palette = "Set1") + ggplot2::theme(legend.position = "right") ``` ## Forest plot with a coefficient table `ggcoef_table()` is a variant of `ggcoef_model()` displaying a coefficient table on the right of the forest plot. ```{r} ggcoef_table(mod_simple) ggcoef_table(mod_titanic, exponentiate = TRUE) ``` You can easily customize the columns to be displayed. ```{r} ggcoef_table( mod_simple, table_stat = c("label", "estimate", "std.error", "ci"), ci_pattern = "{conf.low} to {conf.high}", table_stat_label = list( estimate = scales::label_number(accuracy = .001), conf.low = scales::label_number(accuracy = .01), conf.high = scales::label_number(accuracy = .01), std.error = scales::label_number(accuracy = .001), label = toupper ), table_header = c("Term", "Coef.", "SE", "CI"), table_witdhs = c(2, 3) ) ``` ## Multinomial models For multinomial models, simply use `ggcoef_multinom()`. Three types of visualizations are available: `"dodged"`, `"faceted"` and `"table"`. ```{r} library(nnet) hec <- as.data.frame(HairEyeColor) mod <- multinom( Hair ~ Eye + Sex, data = hec, weights = hec$Freq ) ggcoef_multinom( mod, exponentiate = TRUE ) ggcoef_multinom( mod, exponentiate = TRUE, type = "faceted" ) ``` ```{r, fig.height=9, fig.width=6} ggcoef_multinom( mod, exponentiate = TRUE, type = "table" ) ``` You can use `y.level_label` to customize the label of each level. ```{r} ggcoef_multinom( mod, type = "faceted", y.level_label = c("Brown" = "Brown\n(ref: Black)"), exponentiate = TRUE ) ``` ## Multi-components models Multi-components models such as zero-inflated Poisson or beta regression generate a set of terms for each of their components. You can use `ggcoef_multicomponents()` which is similar to `ggcoef_multinom()`. ```{r} library(pscl) data("bioChemists", package = "pscl") mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists) ggcoef_multicomponents(mod) ggcoef_multicomponents(mod, type = "f") ``` ```{r, fig.height=7, fig.width=6} ggcoef_multicomponents(mod, type = "t") ggcoef_multicomponents( mod, type = "t", component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") ) ``` ## Comparing several models You can easily compare several models with `ggcoef_compare()`. To be noted, `ggcoef_compare()` is not compatible with multinomial or multi-components models. ```{r} mod1 <- lm(Fertility ~ ., data = swiss) mod2 <- step(mod1, trace = 0) mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) models <- list( "Full model" = mod1, "Simplified model" = mod2, "With interaction" = mod3 ) ggcoef_compare(models) ggcoef_compare(models, type = "faceted") ``` ## Advanced users Advanced users could use their own dataset and pass it to `ggcoef_plot()`. Such dataset could be produced by `ggcoef_model()`, `ggcoef_compare()` or `ggcoef_multinom()` with the option `return_data = TRUE` or by using `broom::tidy()` or `broom.helpers::tidy_plus_plus()`. ## Supported models ```{r, echo=FALSE} broom.helpers::supported_models |> knitr::kable() ``` Note: this list of models has been tested. `{broom.helpers}`, and therefore `ggcoef_model()`, may or may not work properly or partially with other types of models. ggstats/inst/doc/stat_weighted_mean.Rmd0000644000176200001440000000526514357760262017773 0ustar liggesusers--- title: "Compute weighted mean with `stat_weighted_mean()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Compute weighted mean with `stat_weighted_mean()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(ggplot2) ``` `stat_weighted_mean()` computes mean value of **y** (taking into account any **weight** aesthetic if provided) for each value of **x**. More precisely, it will return a new data frame with one line per unique value of **x** with the following new variables: - **y**: mean value of the original **y** (i.e. **numerator**/**denominator**) - **numerator** - **denominator** Let's take an example. The following plot shows all tips received according to the day of the week. ```{r} data(tips, package = "reshape") ggplot(tips) + aes(x = day, y = tip) + geom_point() ``` To plot their mean value per day, simply use `stat_weighted_mean()`. ```{r} ggplot(tips) + aes(x = day, y = tip) + stat_weighted_mean() ``` We can specify the geometry we want using `geom` argument. Note that for lines, we need to specify the **group** aesthetic as well. ```{r} ggplot(tips) + aes(x = day, y = tip, group = 1) + stat_weighted_mean(geom = "line") ``` An alternative is to specify the statistic in `ggplot2::geom_line()`. ```{r} ggplot(tips) + aes(x = day, y = tip, group = 1) + geom_line(stat = "weighted_mean") ``` Of course, it could be use with other geometries. Here a bar plot. ```{r} p <- ggplot(tips) + aes(x = day, y = tip, fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + ylab("mean tip") p ``` It is very easy to add facets. In that case, computation will be done separately for each facet. ```{r} p + facet_grid(rows = vars(smoker)) ``` `stat_weighted_mean()` could be also used for computing proportions as a proportion is technically a mean of binary values (0 or 1). ```{r} ggplot(tips) + aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + scale_y_continuous(labels = scales::percent) + ylab("proportion of smoker") ``` Finally, you can use the **weight** aesthetic to indicate weights to take into account for computing means / proportions. ```{r} d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, y = as.integer(Survived == "Yes"), weight = Freq, fill = Sex) + geom_bar(stat = "weighted_mean", position = "dodge") + scale_y_continuous(labels = scales::percent) + labs(y = "Proportion who survived") ``` ggstats/inst/doc/stat_cross.R0000644000176200001440000000317314674037777016011 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ggstats) library(ggplot2) ## ----------------------------------------------------------------------------- d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) + stat_cross() + scale_size_area(max_size = 20) ## ----fig.height=6, fig.width=6------------------------------------------------ ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(std.resid) ) + stat_cross(shape = 22) + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + scale_size_area(max_size = 20) ## ----------------------------------------------------------------------------- ggplot(d) + aes(x = Class, y = Survived, weight = Freq) + geom_tile(fill = "white", colour = "black") + geom_text(stat = "cross", mapping = aes(label = after_stat(observed))) + theme_minimal() ## ----------------------------------------------------------------------------- ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = scales::percent(after_stat(col.prop), accuracy = .1), fill = after_stat(std.resid) ) + stat_cross(shape = 22, size = 30) + geom_text(stat = "cross") + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + facet_grid(rows = vars(Sex)) + labs(fill = "Standardized residuals") + theme_minimal() ggstats/inst/doc/stat_weighted_mean.R0000644000176200001440000000363614674040005017436 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ggstats) library(ggplot2) ## ----------------------------------------------------------------------------- data(tips, package = "reshape") ggplot(tips) + aes(x = day, y = tip) + geom_point() ## ----------------------------------------------------------------------------- ggplot(tips) + aes(x = day, y = tip) + stat_weighted_mean() ## ----------------------------------------------------------------------------- ggplot(tips) + aes(x = day, y = tip, group = 1) + stat_weighted_mean(geom = "line") ## ----------------------------------------------------------------------------- ggplot(tips) + aes(x = day, y = tip, group = 1) + geom_line(stat = "weighted_mean") ## ----------------------------------------------------------------------------- p <- ggplot(tips) + aes(x = day, y = tip, fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + ylab("mean tip") p ## ----------------------------------------------------------------------------- p + facet_grid(rows = vars(smoker)) ## ----------------------------------------------------------------------------- ggplot(tips) + aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + scale_y_continuous(labels = scales::percent) + ylab("proportion of smoker") ## ----------------------------------------------------------------------------- d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, y = as.integer(Survived == "Yes"), weight = Freq, fill = Sex) + geom_bar(stat = "weighted_mean", position = "dodge") + scale_y_continuous(labels = scales::percent) + labs(y = "Proportion who survived") ggstats/inst/doc/stat_cross.html0000644000176200001440000013107014674037777016552 0ustar liggesusers Compute cross-tabulation statistics with stat_cross()

Compute cross-tabulation statistics with stat_cross()

library(ggstats)
library(ggplot2)

This statistic is intended to be used with two discrete variables mapped to x and y aesthetics. It will compute several statistics of a cross-tabulated table using broom::tidy.test() and stats::chisq.test(). More precisely, the computed variables are:

By default, stat_cross() is using ggplot2::geom_points(). If you want to plot the number of observations, you need to map after_stat(observed) to an aesthetic (here size):

d <- as.data.frame(Titanic)
ggplot(d) +
  aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) +
  stat_cross() +
  scale_size_area(max_size = 20)

Note that the weight aesthetic is taken into account by stat_cross().

We can go further using a custom shape and filling points with standardized residual to identify visually cells who are over- or underrepresented.

ggplot(d) +
  aes(
    x = Class, y = Survived, weight = Freq,
    size = after_stat(observed), fill = after_stat(std.resid)
  ) +
  stat_cross(shape = 22) +
  scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) +
  scale_size_area(max_size = 20)

We can easily recreate a cross-tabulated table.

ggplot(d) +
  aes(x = Class, y = Survived, weight = Freq) +
  geom_tile(fill = "white", colour = "black") +
  geom_text(stat = "cross", mapping = aes(label = after_stat(observed))) +
  theme_minimal()

Even more complicated, we want to produce a table showing column proportions and where cells are filled with standardized residuals. Note that stat_cross() could be used with facets. In that case, computation is done separately in each facet.

ggplot(d) +
  aes(
    x = Class, y = Survived, weight = Freq,
    label = scales::percent(after_stat(col.prop), accuracy = .1),
    fill = after_stat(std.resid)
  ) +
  stat_cross(shape = 22, size = 30) +
  geom_text(stat = "cross") +
  scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) +
  facet_grid(rows = vars(Sex)) +
  labs(fill = "Standardized residuals") +
  theme_minimal()

ggstats/inst/doc/stat_prop.html0000644000176200001440000055701514674040003016364 0ustar liggesusers Compute custom proportions with stat_prop()

Compute custom proportions with stat_prop()

library(ggstats)
library(ggplot2)

stat_prop() is a variation of ggplot2::stat_count() allowing to compute custom proportions according to the by aesthetic defining the denominator (i.e. all proportions for a same value of by will sum to 1). The by aesthetic should be a factor. Therefore, stat_prop() requires the by aesthetic and this by aesthetic should be a factor.

Adding labels on a percent stacked bar plot

When using position = "fill" with geom_bar(), you can produce a percent stacked bar plot. However, the proportions corresponding to the y axis are not directly accessible using only ggplot2. With stat_prop(), you can easily add them on the plot.

In the following example, we indicated stat = "prop" to ggplot2::geom_text() to use stat_prop(), we defined the by aesthetic (here we want to compute the proportions separately for each value of x), and we also used ggplot2::position_fill() when calling ggplot2::geom_text().

d <- as.data.frame(Titanic)
p <- ggplot(d) +
  aes(x = Class, fill = Survived, weight = Freq, by = Class) +
  geom_bar(position = "fill") +
  geom_text(stat = "prop", position = position_fill(.5))
p

Note that stat_prop() has properly taken into account the weight aesthetic.

stat_prop() is also compatible with faceting. In that case, proportions are computed separately in each facet.

p + facet_grid(cols = vars(Sex))

Displaying proportions of the total

If you want to display proportions of the total, simply map the by aesthetic to 1. Here an example using a stacked bar chart.

ggplot(d) +
  aes(x = Class, fill = Survived, weight = Freq, by = 1) +
  geom_bar() +
  geom_text(
    aes(label = scales::percent(after_stat(prop), accuracy = 1)),
    stat = "prop",
    position = position_stack(.5)
  )

A dodged bar plot to compare two distributions

A dodged bar plot could be used to compare two distributions.

ggplot(d) +
  aes(x = Class, fill = Sex, weight = Freq, by = Sex) +
  geom_bar(position = "dodge")

On the previous graph, it is difficult to see if first class is over- or under-represented among women, due to the fact they were much more men on the boat. stat_prop() could be used to adjust the graph by displaying instead the proportion within each category (i.e. here the proportion by sex).

ggplot(d) +
  aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) +
  geom_bar(stat = "prop", position = "dodge") +
  scale_y_continuous(labels = scales::percent)

The same example with labels:

ggplot(d) +
  aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) +
  geom_bar(stat = "prop", position = "dodge") +
  scale_y_continuous(labels = scales::percent) +
  geom_text(
    mapping = aes(
      label = scales::percent(after_stat(prop), accuracy = .1),
      y = after_stat(0.01)
    ),
    vjust = "bottom",
    position = position_dodge(.9),
    stat = "prop"
  )

Displaying unobserved levels

With the complete argument, it is possible to indicate an aesthetic for those statistics should be completed for unobserved values.

d <- diamonds |>
  dplyr::filter(!(cut == "Ideal" & clarity == "I1")) |>
  dplyr::filter(!(cut == "Very Good" & clarity == "VS2")) |>
  dplyr::filter(!(cut == "Premium" & clarity == "IF"))
p <- ggplot(d) +
  aes(x = clarity, fill = cut, by = clarity) +
  geom_bar(position = "fill")
p +
  geom_text(
    stat = "prop",
    position = position_fill(.5)
  )

Adding complete = "fill" will generate “0.0%” labels where relevant.

p +
  geom_text(
    stat = "prop",
    position = position_fill(.5),
    complete = "fill"
  )

Using geom_prop_bar() and geom_prop_text()

The dedicated geometries geom_prop_bar() and geom_prop_text() could be used for quick and easy proportional bar plots. They use by default stat_prop() with relevant default values. For example, proportions are computed by x or y if the by aesthetic is not specified. It allows to generate a quick proportional bar plot.

ggplot(diamonds) +
  aes(y = clarity, fill = cut) +
  geom_prop_bar() +
  geom_prop_text()

You can specify a by aesthetic. For example, to reproduce the comparison of the two distributions presented earlier.

d <- as.data.frame(Titanic)
ggplot(d) +
  aes(x = Class, fill = Sex, weight = Freq, by = Sex) +
  geom_prop_bar(position = "dodge") +
  geom_prop_text(
    position = position_dodge(width = .9),
    vjust = - 0.5
  ) +
  scale_y_continuous(labels = scales::percent)

You can also display counts instead of proportions.

ggplot(diamonds) +
  aes(x = clarity, fill = cut) +
  geom_prop_bar(height = "count") +
  geom_prop_text(
    height = "count",
    labels = "count",
    labeller = scales::number
  )

ggstats/inst/doc/gglikert.Rmd0000644000176200001440000002037314674033502015735 0ustar liggesusers--- title: "Plot Likert-type items with `gglikert()`" author: Joseph Larmarange output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Plot Likert-type items with `gglikert()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(dplyr) library(ggplot2) ``` The purpose of `gglikert()` is to generate a centered bar plot comparing the answers of several questions sharing a common Likert-type scale. ## Generating an example dataset ```{r} likert_levels <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree" ) set.seed(42) df <- tibble( q1 = sample(likert_levels, 150, replace = TRUE), q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q5 = sample(c(likert_levels, NA), 150, replace = TRUE), q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) likert_levels_dk <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Don't know" ) df_dk <- tibble( q1 = sample(likert_levels_dk, 150, replace = TRUE), q2 = sample(likert_levels_dk, 150, replace = TRUE, prob = 6:1), q3 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q4 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q5 = sample(c(likert_levels_dk, NA), 150, replace = TRUE), q6 = sample( likert_levels_dk, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0, 1) ) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels_dk))) ``` ## Quick plot Simply call `gglikert()`. ```{r} gglikert(df) ``` The list of variables to plot (all by default) could by specify with `include`. This argument accepts tidy-select syntax. ```{r} gglikert(df, include = q1:q3) ``` ## Customizing the plot The generated plot is a standard `ggplot2` object. You can therefore use `ggplot2` functions to custom many aspects. ```{r} gglikert(df) + ggtitle("A Likert-type items plot", subtitle = "generated with gglikert()") + scale_fill_brewer(palette = "RdYlBu") ``` ### Sorting the questions You can sort the plot with `sort`. ```{r} gglikert(df, sort = "ascending") ``` By default, the plot is sorted based on the proportion being higher than the center level, i.e. in this case the proportion of answers equal to "Agree" or "Strongly Agree". Alternatively, the questions could be transformed into a score and sorted accorded to their mean. ```{r} gglikert(df, sort = "ascending", sort_method = "mean") ``` ### Sorting the answers You can reverse the order of the answers with `reverse_likert`. ```{r} gglikert(df, reverse_likert = TRUE) ``` ### Proportion labels Proportion labels could be removed with `add_labels = FALSE`. ```{r} gglikert(df, add_labels = FALSE) ``` or customized. ```{r} gglikert( df, labels_size = 3, labels_accuracy = .1, labels_hide_below = .2, labels_color = "white" ) ``` ### Totals on each side By default, totals are added on each side of the plot. In case of an uneven number of answer levels, the central level is not taken into account for computing totals. With `totals_include_center = TRUE`, half of the proportion of the central level will be added on each side. ```{r} gglikert( df, totals_include_center = TRUE, sort = "descending", sort_prop_include_center = TRUE ) ``` Totals could be customized. ```{r} gglikert( df, totals_size = 4, totals_color = "blue", totals_fontface = "italic", totals_hjust = .20 ) ``` Or removed. ```{r} gglikert(df, add_totals = FALSE) ``` ## Variable labels If you are using variable labels (see `labelled::set_variable_labels()`), they will be taken automatically into account by `gglikert()`. ```{r} if (require(labelled)) { df <- df |> set_variable_labels( q1 = "first question", q2 = "second question", q3 = "this is the third question with a quite long variable label" ) } gglikert(df) ``` You can also provide custom variable labels with `variable_labels`. ```{r} gglikert( df, variable_labels = c( q1 = "alternative label for the first question", q6 = "another custom label" ) ) ``` You can control how variable labels are wrapped with `y_label_wrap`. ```{r} gglikert(df, y_label_wrap = 20) gglikert(df, y_label_wrap = 200) ``` ## Custom center By default, Likert plots will be centered, i.e. displaying the same number of categories on each side on the graph. When the number of categories is odd, half of the "central" category is displayed negatively and half positively. It is possible to control where to center the graph, using the `cutoff` argument, representing the number of categories to be displayed negatively: `2` to display the two first categories negatively and the others positively; `2.25` to display the two first categories and a quarter of the third negatively. ```{r} gglikert(df, cutoff = 0) gglikert(df, cutoff = 1) gglikert(df, cutoff = 1.25) gglikert(df, cutoff = 1.75) gglikert(df, cutoff = 2) gglikert(df, cutoff = NULL) gglikert(df, cutoff = 4) gglikert(df, cutoff = 5) ``` ## Symmetric x-axis Simply specify `symmetric = TRUE`. ```{r} gglikert(df, cutoff = 1) gglikert(df, cutoff = 1, symmetric = TRUE) ``` ## Removing certain values Sometimes, the dataset could contain certain values that you should not be displayed. ```{r} gglikert(df_dk) ``` A first option could be to convert the don't knows into `NA`. In such case, the proportions will be computed on non missing. ```{r} df_dk |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) |> gglikert() ``` Or, you could use `exclude_fill_values` to not display specific values, but still counting them in the denominator for computing proportions. ```{r} df_dk |> gglikert(exclude_fill_values = "Don't know") ``` ## Facets To define facets, use `facet_rows` and/or `facet_cols`. ```{r message=FALSE} df_group <- df df_group$group1 <- sample(c("A", "B"), 150, replace = TRUE) df_group$group2 <- sample(c("a", "b", "c"), 150, replace = TRUE) gglikert(df_group, q1:q6, facet_cols = vars(group1), labels_size = 3 ) gglikert(df_group, q1:q2, facet_rows = vars(group1, group2), labels_size = 3 ) gglikert(df_group, q3:q6, facet_cols = vars(group1), facet_rows = vars(group2), labels_size = 3 ) + scale_x_continuous( labels = label_percent_abs(), expand = expansion(0, .2) ) ``` To compare answers by subgroup, you can alternatively map `.question` to facets, and define a grouping variable for `y`. ```{r} gglikert(df_group, q1:q4, y = "group1", facet_rows = vars(.question), labels_size = 3, facet_label_wrap = 15 ) ``` ## Stacked plot For a more classical stacked bar plot, you can use `gglikert_stacked()`. ```{r} gglikert_stacked(df) gglikert_stacked( df, sort = "asc", add_median_line = TRUE, add_labels = FALSE ) gglikert_stacked( df_group, include = q1:q4, y = "group2" ) + facet_grid( rows = vars(.question), labeller = label_wrap_gen(15) ) ``` ## Long format dataset Internally, `gglikert()` is calling `gglikert_data()` to generate a long format dataset combining all questions into two columns, `.question` and `.answer`. ```{r} gglikert_data(df) |> head() ``` Such dataset could be useful for other types of plot, for example for a classic stacked bar plot. ```{r} ggplot(gglikert_data(df)) + aes(y = .question, fill = .answer) + geom_bar(position = "fill") ``` ## Weighted data `gglikert()`, `gglikert_stacked()` and `gglikert_data()` accepts a `weights` argument, allowing to specify statistical weights. ```{r} df$sampling_weights <- runif(nrow(df)) gglikert(df, q1:q4, weights = sampling_weights) ``` ## See also The function `position_likert()` used to center bars. ggstats/inst/doc/geom_diverging.R0000644000176200001440000000663514674037670016610 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ggstats) library(dplyr) library(ggplot2) library(patchwork) ## ----------------------------------------------------------------------------- base <- ggplot(diamonds) + aes(y = clarity, fill = cut) + theme(legend.position = "none") p_stack <- base + geom_bar(position = "stack") + ggtitle("position_stack()") p_diverging <- base + geom_bar(position = "diverging") + ggtitle("position_diverging()") p_stack + p_diverging ## ----------------------------------------------------------------------------- p_fill <- base + geom_bar(position = "fill") + ggtitle("position_fill()") p_likert <- base + geom_bar(position = "likert") + ggtitle("position_likert()") p_fill + p_likert ## ----------------------------------------------------------------------------- p_1 <- base + geom_bar(position = position_diverging(cutoff = 1)) + ggtitle("cutoff = 1") p_2 <- base + geom_bar(position = position_diverging(cutoff = 2)) + ggtitle("cutoff = 2") p_null <- base + geom_bar(position = position_diverging(cutoff = NULL)) + ggtitle("cutoff = NULL") p_3.75 <- base + geom_bar(position = position_diverging(cutoff = 3.75)) + ggtitle("cutoff = 3.75") p_5 <- base + geom_bar(position = position_diverging(cutoff = 5)) + ggtitle("cutoff = 5") wrap_plots(p_1, p_2, p_null, p_3.75, p_5) ## ----------------------------------------------------------------------------- wrap_plots( p_1 + scale_fill_likert(cutoff = 1), p_null + scale_fill_likert(), p_3.75 + scale_fill_likert(cutoff = 3.75) ) ## ----------------------------------------------------------------------------- wrap_plots( p_3.75, p_3.75 + scale_x_continuous( limits = symmetric_limits, labels = label_number_abs() ) ) ## ----------------------------------------------------------------------------- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "diverging") + geom_text( aes( label = label_number_abs(hide_below = 800) (after_stat(count)) ), stat = "count", position = position_diverging(.5) ) + scale_fill_likert() + scale_x_continuous( labels = label_number_abs(), limits = symmetric_limits ) ## ----------------------------------------------------------------------------- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_diverging() + geom_diverging_text(hide_below = 800) + scale_fill_likert() + scale_x_continuous( labels = label_number_abs(), limits = symmetric_limits ) ## ----------------------------------------------------------------------------- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_likert() + geom_likert_text(hide_below = 0.10) + scale_fill_likert() + scale_x_continuous( labels = label_percent_abs() ) ## ----------------------------------------------------------------------------- d <- Titanic |> as.data.frame() ggplot(d) + aes(y = Class, fill = Sex, weight = Freq) + geom_pyramid() + geom_pyramid_text() + scale_x_continuous( labels = label_percent_abs(), limits = symmetric_limits ) ggstats/inst/doc/geom_diverging.html0000644000176200001440000034000114674037672017341 0ustar liggesusers Geometries for diverging bar plots

Geometries for diverging bar plots

Joseph Larmarange

library(ggstats)
library(dplyr)
#> 
#> Attachement du package : 'dplyr'
#> Les objets suivants sont masqués depuis 'package:stats':
#> 
#>     filter, lag
#> Les objets suivants sont masqués depuis 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(ggplot2)
library(patchwork)

Note : if you are looking for an all-in-one function to display Likert-type items, please refer to gglikert() and vignette("gglikert").

New positions

Diverging bar plots could be achieved using position_diverging() or position_likert().

position_diverging() stacks bars on top of each other and centers them around zero (the same number of categories are displayed on each side).

base <-
  ggplot(diamonds) +
  aes(y = clarity, fill = cut) +
  theme(legend.position = "none")

p_stack <-
  base +
  geom_bar(position = "stack") +
  ggtitle("position_stack()")

p_diverging <-
  base +
  geom_bar(position = "diverging") +
  ggtitle("position_diverging()")

p_stack + p_diverging

position_likert() is similar but uses proportions instead of counts.

p_fill <-
  base +
  geom_bar(position = "fill") +
  ggtitle("position_fill()")

p_likert <-
  base +
  geom_bar(position = "likert") +
  ggtitle("position_likert()")

p_fill + p_likert

By default, the same number of categories is displayed on each side, i.e. if you have 4 categories, 2 will be displayed negatively and 2 positively. If you have an odd number of categories, half of the central category will be displayed negatively and half positively.

The center could be changed with the cutoff argument, representing the number of categories to be displayed negatively: 2 to display negatively the two first categories, 2.5 to display negatively the two first categories and half of the third, 2.2 to display negatively the two first categories and a fifth of the third.

p_1 <-
  base +
  geom_bar(position = position_diverging(cutoff = 1)) +
  ggtitle("cutoff = 1")

p_2 <-
  base +
  geom_bar(position = position_diverging(cutoff = 2)) +
  ggtitle("cutoff = 2")

p_null <-
  base +
  geom_bar(position = position_diverging(cutoff = NULL)) +
  ggtitle("cutoff = NULL")

p_3.75 <-
  base +
  geom_bar(position = position_diverging(cutoff = 3.75)) +
  ggtitle("cutoff = 3.75")

p_5 <-
  base +
  geom_bar(position = position_diverging(cutoff = 5)) +
  ggtitle("cutoff = 5")

wrap_plots(p_1, p_2, p_null, p_3.75, p_5)

New scales

For a diverging bar plot, it is recommended to use a diverging palette, as provided in the Brewer palettes. Sometimes, the number of available colors is insufficient in the palette. In that case, you could use pal_extender() or scale_fill_extended(). However, if you use a custom cutoff, it is also important to change the center of the palette as well.

Therefore, for diverging bar plots, we recommend to use scale_fill_likert().

wrap_plots(
  p_1 + scale_fill_likert(cutoff = 1),
  p_null + scale_fill_likert(),
  p_3.75 + scale_fill_likert(cutoff = 3.75)
)

Improving axes

You may also want have centered axes. That could be easily achieved with symmetric_limits().

You could also use label_number_abs() or label_percent_abs() to display absolute numbers.

wrap_plots(
  p_3.75,
  p_3.75 +
    scale_x_continuous(
      limits = symmetric_limits,
      labels = label_number_abs()
    )
)

New geometries

To facilitate the creation of diverging bar plots, you could use variants of geom_bar() and geom_text().

geom_diverging() & geom_diverging_text()

Let’s consider the following plot:

ggplot(diamonds) +
  aes(y = clarity, fill = cut) +
  geom_bar(position = "diverging") +
  geom_text(
    aes(
      label =
        label_number_abs(hide_below = 800)
        (after_stat(count))
    ),
    stat = "count",
    position = position_diverging(.5)
  ) +
  scale_fill_likert() +
  scale_x_continuous(
    labels = label_number_abs(),
    limits = symmetric_limits
  )

The same could be achieved quicker with geom_diverging() and geom_diverging_text().

ggplot(diamonds) +
  aes(y = clarity, fill = cut) +
  geom_diverging() +
  geom_diverging_text(hide_below = 800) +
  scale_fill_likert() +
  scale_x_continuous(
    labels = label_number_abs(),
    limits = symmetric_limits
  )

geom_likert() & geom_likert_text()

geom_likert() and geom_likert_text() works similarly. geom_likert_text() takes advantages of stat_prop() for computing the proportions to be displayed (see vignette("stat_prop")).

ggplot(diamonds) +
  aes(y = clarity, fill = cut) +
  geom_likert() +
  geom_likert_text(hide_below = 0.10) +
  scale_fill_likert() +
  scale_x_continuous(
    labels = label_percent_abs()
  )

geom_pyramid() & geom_pyramid_text()

Finally, geom_pyramid() and geom_pyramid_text() are variations adapted to display an age-sex pyramid. It uses proportions of the total.

d <- Titanic |> as.data.frame()
ggplot(d) +
  aes(y = Class, fill = Sex, weight = Freq) +
  geom_pyramid() +
  geom_pyramid_text() +
  scale_x_continuous(
    labels = label_percent_abs(),
    limits = symmetric_limits
  )

ggstats/inst/doc/gglikert.html0000644000176200001440000227530214674037776016206 0ustar liggesusers Plot Likert-type items with gglikert()

Plot Likert-type items with gglikert()

Joseph Larmarange

library(ggstats)
library(dplyr)
library(ggplot2)

The purpose of gglikert() is to generate a centered bar plot comparing the answers of several questions sharing a common Likert-type scale.

Generating an example dataset

likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)
set.seed(42)
df <-
  tibble(
    q1 = sample(likert_levels, 150, replace = TRUE),
    q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1),
    q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
    q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
    q5 = sample(c(likert_levels, NA), 150, replace = TRUE),
    q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0))
  ) |>
  mutate(across(everything(), ~ factor(.x, levels = likert_levels)))

likert_levels_dk <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree",
  "Don't know"
)
df_dk <-
  tibble(
    q1 = sample(likert_levels_dk, 150, replace = TRUE),
    q2 = sample(likert_levels_dk, 150, replace = TRUE, prob = 6:1),
    q3 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6),
    q4 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6),
    q5 = sample(c(likert_levels_dk, NA), 150, replace = TRUE),
    q6 = sample(
      likert_levels_dk, 150,
      replace = TRUE, prob = c(1, 0, 1, 1, 0, 1)
    )
  ) |>
  mutate(across(everything(), ~ factor(.x, levels = likert_levels_dk)))

Quick plot

Simply call gglikert().

gglikert(df)

The list of variables to plot (all by default) could by specify with include. This argument accepts tidy-select syntax.

gglikert(df, include = q1:q3)

Customizing the plot

The generated plot is a standard ggplot2 object. You can therefore use ggplot2 functions to custom many aspects.

gglikert(df) +
  ggtitle("A Likert-type items plot", subtitle = "generated with gglikert()") +
  scale_fill_brewer(palette = "RdYlBu")
#> Scale for fill is already present.
#> Adding another scale for fill, which will replace the existing scale.

Sorting the questions

You can sort the plot with sort.

gglikert(df, sort = "ascending")

By default, the plot is sorted based on the proportion being higher than the center level, i.e. in this case the proportion of answers equal to “Agree” or “Strongly Agree”. Alternatively, the questions could be transformed into a score and sorted accorded to their mean.

gglikert(df, sort = "ascending", sort_method = "mean")

Sorting the answers

You can reverse the order of the answers with reverse_likert.

gglikert(df, reverse_likert = TRUE)

Proportion labels

Proportion labels could be removed with add_labels = FALSE.

gglikert(df, add_labels = FALSE)

or customized.

gglikert(
  df,
  labels_size = 3,
  labels_accuracy = .1,
  labels_hide_below = .2,
  labels_color = "white"
)

Totals on each side

By default, totals are added on each side of the plot. In case of an uneven number of answer levels, the central level is not taken into account for computing totals. With totals_include_center = TRUE, half of the proportion of the central level will be added on each side.

gglikert(
  df,
  totals_include_center = TRUE,
  sort = "descending",
  sort_prop_include_center = TRUE
)

Totals could be customized.

gglikert(
  df,
  totals_size = 4,
  totals_color = "blue",
  totals_fontface = "italic",
  totals_hjust = .20
)

Or removed.

gglikert(df, add_totals = FALSE)

Variable labels

If you are using variable labels (see labelled::set_variable_labels()), they will be taken automatically into account by gglikert().

if (require(labelled)) {
  df <- df |>
    set_variable_labels(
      q1 = "first question",
      q2 = "second question",
      q3 = "this is the third question with a quite long variable label"
    )
}
gglikert(df)

You can also provide custom variable labels with variable_labels.

gglikert(
  df,
  variable_labels = c(
    q1 = "alternative label for the first question",
    q6 = "another custom label"
  )
)

You can control how variable labels are wrapped with y_label_wrap.

gglikert(df, y_label_wrap = 20)

gglikert(df, y_label_wrap = 200)

Custom center

By default, Likert plots will be centered, i.e. displaying the same number of categories on each side on the graph. When the number of categories is odd, half of the “central” category is displayed negatively and half positively.

It is possible to control where to center the graph, using the cutoff argument, representing the number of categories to be displayed negatively: 2 to display the two first categories negatively and the others positively; 2.25 to display the two first categories and a quarter of the third negatively.

gglikert(df, cutoff = 0)

gglikert(df, cutoff = 1)

gglikert(df, cutoff = 1.25)

gglikert(df, cutoff = 1.75)

gglikert(df, cutoff = 2)

gglikert(df, cutoff = NULL)

gglikert(df, cutoff = 4)

gglikert(df, cutoff = 5)

Symmetric x-axis

Simply specify symmetric = TRUE.

gglikert(df, cutoff = 1)

gglikert(df, cutoff = 1, symmetric = TRUE)

Removing certain values

Sometimes, the dataset could contain certain values that you should not be displayed.

gglikert(df_dk)

A first option could be to convert the don’t knows into NA. In such case, the proportions will be computed on non missing.

df_dk |>
  mutate(across(everything(), ~ factor(.x, levels = likert_levels))) |>
  gglikert()

Or, you could use exclude_fill_values to not display specific values, but still counting them in the denominator for computing proportions.

df_dk |> gglikert(exclude_fill_values = "Don't know")

Facets

To define facets, use facet_rows and/or facet_cols.

df_group <- df
df_group$group1 <- sample(c("A", "B"), 150, replace = TRUE)
df_group$group2 <- sample(c("a", "b", "c"), 150, replace = TRUE)

gglikert(df_group,
  q1:q6,
  facet_cols = vars(group1),
  labels_size = 3
)

gglikert(df_group,
  q1:q2,
  facet_rows = vars(group1, group2),
  labels_size = 3
)

gglikert(df_group,
  q3:q6,
  facet_cols = vars(group1),
  facet_rows = vars(group2),
  labels_size = 3
) +
  scale_x_continuous(
    labels = label_percent_abs(),
    expand = expansion(0, .2)
  )

To compare answers by subgroup, you can alternatively map .question to facets, and define a grouping variable for y.

gglikert(df_group,
  q1:q4,
  y = "group1",
  facet_rows = vars(.question),
  labels_size = 3,
  facet_label_wrap = 15
)

Stacked plot

For a more classical stacked bar plot, you can use gglikert_stacked().

gglikert_stacked(df)


gglikert_stacked(
  df,
  sort = "asc",
  add_median_line = TRUE,
  add_labels = FALSE
)


gglikert_stacked(
  df_group,
  include = q1:q4,
  y = "group2"
) +
  facet_grid(
    rows = vars(.question),
    labeller = label_wrap_gen(15)
  )

Long format dataset

Internally, gglikert() is calling gglikert_data() to generate a long format dataset combining all questions into two columns, .question and .answer.

gglikert_data(df) |>
  head()
#> # A tibble: 6 × 3
#>   .weights .question                                                   .answer  
#>      <dbl> <fct>                                                       <fct>    
#> 1        1 first question                                              Strongly…
#> 2        1 second question                                             Disagree 
#> 3        1 this is the third question with a quite long variable label Agree    
#> 4        1 q4                                                          Disagree 
#> 5        1 q5                                                          Strongly…
#> 6        1 q6                                                          Strongly…

Such dataset could be useful for other types of plot, for example for a classic stacked bar plot.

ggplot(gglikert_data(df)) +
  aes(y = .question, fill = .answer) +
  geom_bar(position = "fill")

Weighted data

gglikert(), gglikert_stacked() and gglikert_data() accepts a weights argument, allowing to specify statistical weights.

df$sampling_weights <- runif(nrow(df))
gglikert(df, q1:q4, weights = sampling_weights)

See also

The function position_likert() used to center bars.

ggstats/inst/doc/ggcoef_model.R0000644000176200001440000001601514674037755016232 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ggstats) ## ----include=FALSE------------------------------------------------------------ if ( !broom.helpers::.assert_package("emmeans", boolean = TRUE) ) { knitr::opts_chunk$set(eval = FALSE) } ## ----ggcoef-reg--------------------------------------------------------------- data(tips, package = "reshape") mod_simple <- lm(tip ~ day + time + total_bill, data = tips) ggcoef_model(mod_simple) ## ----ggcoef-titanic----------------------------------------------------------- d_titanic <- as.data.frame(Titanic) d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes")) mod_titanic <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial ) ggcoef_model(mod_titanic, exponentiate = TRUE) ## ----------------------------------------------------------------------------- library(labelled) tips_labelled <- tips |> set_variable_labels( day = "Day of the week", time = "Lunch or Dinner", total_bill = "Bill's total" ) mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled) ggcoef_model(mod_labelled) ## ----------------------------------------------------------------------------- ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ) ) ## ----------------------------------------------------------------------------- ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ), facet_labeller = ggplot2::label_wrap_gen(10) ) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, facet_row = NULL, colour_guide = TRUE) ## ----------------------------------------------------------------------------- ggcoef_model(mod_titanic, exponentiate = TRUE) ggcoef_model( mod_titanic, exponentiate = TRUE, show_p_values = FALSE, signif_stars = FALSE, add_reference_rows = FALSE, categorical_terms_pattern = "{level} (ref: {reference_level})", interaction_sep = " x " ) + ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) ## ----------------------------------------------------------------------------- mod_titanic2 <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial, contrasts = list(Sex = contr.sum, Class = contr.treatment(4, base = 3)) ) ggcoef_model(mod_titanic2, exponentiate = TRUE) ## ----------------------------------------------------------------------------- mod_poly <- lm(Sepal.Length ~ poly(Petal.Width, 3) + Petal.Length, data = iris) ggcoef_model(mod_poly) ## ----------------------------------------------------------------------------- ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = "Sex" ) ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = broom.helpers::all_dichotomous() ) ggcoef_model( mod_titanic2, exponentiate = TRUE, no_reference_row = broom.helpers::all_categorical(), categorical_terms_pattern = "{level}/{reference_level}" ) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, intercept = TRUE) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, conf.int = FALSE) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, significance = NULL) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, colour = NULL) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, include = c("time", "total_bill")) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, include = dplyr::starts_with("t")) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple, stripped_rows = FALSE) ## ----------------------------------------------------------------------------- ggcoef_model(mod_simple) + ggplot2::xlab("Coefficients") + ggplot2::ggtitle("Custom title") + ggplot2::scale_color_brewer(palette = "Set1") + ggplot2::theme(legend.position = "right") ## ----------------------------------------------------------------------------- ggcoef_table(mod_simple) ggcoef_table(mod_titanic, exponentiate = TRUE) ## ----------------------------------------------------------------------------- ggcoef_table( mod_simple, table_stat = c("label", "estimate", "std.error", "ci"), ci_pattern = "{conf.low} to {conf.high}", table_stat_label = list( estimate = scales::label_number(accuracy = .001), conf.low = scales::label_number(accuracy = .01), conf.high = scales::label_number(accuracy = .01), std.error = scales::label_number(accuracy = .001), label = toupper ), table_header = c("Term", "Coef.", "SE", "CI"), table_witdhs = c(2, 3) ) ## ----------------------------------------------------------------------------- library(nnet) hec <- as.data.frame(HairEyeColor) mod <- multinom( Hair ~ Eye + Sex, data = hec, weights = hec$Freq ) ggcoef_multinom( mod, exponentiate = TRUE ) ggcoef_multinom( mod, exponentiate = TRUE, type = "faceted" ) ## ----fig.height=9, fig.width=6------------------------------------------------ ggcoef_multinom( mod, exponentiate = TRUE, type = "table" ) ## ----------------------------------------------------------------------------- ggcoef_multinom( mod, type = "faceted", y.level_label = c("Brown" = "Brown\n(ref: Black)"), exponentiate = TRUE ) ## ----------------------------------------------------------------------------- library(pscl) data("bioChemists", package = "pscl") mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists) ggcoef_multicomponents(mod) ggcoef_multicomponents(mod, type = "f") ## ----fig.height=7, fig.width=6------------------------------------------------ ggcoef_multicomponents(mod, type = "t") ggcoef_multicomponents( mod, type = "t", component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") ) ## ----------------------------------------------------------------------------- mod1 <- lm(Fertility ~ ., data = swiss) mod2 <- step(mod1, trace = 0) mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) models <- list( "Full model" = mod1, "Simplified model" = mod2, "With interaction" = mod3 ) ggcoef_compare(models) ggcoef_compare(models, type = "faceted") ## ----echo=FALSE--------------------------------------------------------------- broom.helpers::supported_models |> knitr::kable() ggstats/inst/doc/stat_cross.Rmd0000644000176200001440000000601514357760262016316 0ustar liggesusers--- title: "Compute cross-tabulation statistics with `stat_cross()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Compute cross-tabulation statistics with `stat_cross()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(ggplot2) ``` This statistic is intended to be used with two discrete variables mapped to **x** and **y** aesthetics. It will compute several statistics of a cross-tabulated table using `broom::tidy.test()` and `stats::chisq.test()`. More precisely, the computed variables are: - **observed**: number of observations in x,y - **prop**: proportion of total - **row.prop**: row proportion - **col.prop**: column proportion - **expected**: expected count under the null hypothesis - **resid**: Pearson's residual - **std.resid**: standardized residual - **row.observed**: total number of observations within row - **col.observed**: total number of observations within column - **total.observed**: total number of observations within the table - **phi**: phi coefficients, see `augment_chisq_add_phi()` By default, `stat_cross()` is using `ggplot2::geom_points()`. If you want to plot the number of observations, you need to map `after_stat(observed)` to an aesthetic (here **size**): ```{r} d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) + stat_cross() + scale_size_area(max_size = 20) ``` Note that the **weight** aesthetic is taken into account by `stat_cross()`. We can go further using a custom shape and filling points with standardized residual to identify visually cells who are over- or underrepresented. ```{r fig.height=6, fig.width=6} ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(std.resid) ) + stat_cross(shape = 22) + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + scale_size_area(max_size = 20) ``` We can easily recreate a cross-tabulated table. ```{r} ggplot(d) + aes(x = Class, y = Survived, weight = Freq) + geom_tile(fill = "white", colour = "black") + geom_text(stat = "cross", mapping = aes(label = after_stat(observed))) + theme_minimal() ``` Even more complicated, we want to produce a table showing column proportions and where cells are filled with standardized residuals. Note that `stat_cross()` could be used with facets. In that case, computation is done separately in each facet. ```{r} ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = scales::percent(after_stat(col.prop), accuracy = .1), fill = after_stat(std.resid) ) + stat_cross(shape = 22, size = 30) + geom_text(stat = "cross") + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + facet_grid(rows = vars(Sex)) + labs(fill = "Standardized residuals") + theme_minimal() ``` ggstats/inst/doc/stat_prop.R0000644000176200001440000000650214674040003015607 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ggstats) library(ggplot2) ## ----------------------------------------------------------------------------- d <- as.data.frame(Titanic) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) p ## ----------------------------------------------------------------------------- p + facet_grid(cols = vars(Sex)) ## ----------------------------------------------------------------------------- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = 1) + geom_bar() + geom_text( aes(label = scales::percent(after_stat(prop), accuracy = 1)), stat = "prop", position = position_stack(.5) ) ## ----------------------------------------------------------------------------- ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex) + geom_bar(position = "dodge") ## ----------------------------------------------------------------------------- ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) + geom_bar(stat = "prop", position = "dodge") + scale_y_continuous(labels = scales::percent) ## ----------------------------------------------------------------------------- ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) + geom_bar(stat = "prop", position = "dodge") + scale_y_continuous(labels = scales::percent) + geom_text( mapping = aes( label = scales::percent(after_stat(prop), accuracy = .1), y = after_stat(0.01) ), vjust = "bottom", position = position_dodge(.9), stat = "prop" ) ## ----------------------------------------------------------------------------- d <- diamonds |> dplyr::filter(!(cut == "Ideal" & clarity == "I1")) |> dplyr::filter(!(cut == "Very Good" & clarity == "VS2")) |> dplyr::filter(!(cut == "Premium" & clarity == "IF")) p <- ggplot(d) + aes(x = clarity, fill = cut, by = clarity) + geom_bar(position = "fill") p + geom_text( stat = "prop", position = position_fill(.5) ) ## ----------------------------------------------------------------------------- p + geom_text( stat = "prop", position = position_fill(.5), complete = "fill" ) ## ----------------------------------------------------------------------------- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_prop_bar() + geom_prop_text() ## ----------------------------------------------------------------------------- d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex) + geom_prop_bar(position = "dodge") + geom_prop_text( position = position_dodge(width = .9), vjust = - 0.5 ) + scale_y_continuous(labels = scales::percent) ## ----------------------------------------------------------------------------- ggplot(diamonds) + aes(x = clarity, fill = cut) + geom_prop_bar(height = "count") + geom_prop_text( height = "count", labels = "count", labeller = scales::number ) ggstats/inst/doc/stat_prop.Rmd0000644000176200001440000001242214674033502016134 0ustar liggesusers--- title: "Compute custom proportions with `stat_prop()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Compute custom proportions with `stat_prop()`} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(ggplot2) ``` `stat_prop()` is a variation of `ggplot2::stat_count()` allowing to compute custom proportions according to the **by** aesthetic defining the denominator (i.e. all proportions for a same value of **by** will sum to 1). The **by** aesthetic should be a factor. Therefore, `stat_prop()` requires the **by** aesthetic and this **by** aesthetic should be a factor. ## Adding labels on a percent stacked bar plot When using `position = "fill"` with `geom_bar()`, you can produce a percent stacked bar plot. However, the proportions corresponding to the **y** axis are not directly accessible using only `ggplot2`. With `stat_prop()`, you can easily add them on the plot. In the following example, we indicated `stat = "prop"` to `ggplot2::geom_text()` to use `stat_prop()`, we defined the **by** aesthetic (here we want to compute the proportions separately for each value of **x**), and we also used `ggplot2::position_fill()` when calling `ggplot2::geom_text()`. ```{r} d <- as.data.frame(Titanic) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) p ``` Note that `stat_prop()` has properly taken into account the **weight** aesthetic. `stat_prop()` is also compatible with faceting. In that case, proportions are computed separately in each facet. ```{r} p + facet_grid(cols = vars(Sex)) ``` ## Displaying proportions of the total If you want to display proportions of the total, simply map the **by** aesthetic to `1`. Here an example using a stacked bar chart. ```{r} ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = 1) + geom_bar() + geom_text( aes(label = scales::percent(after_stat(prop), accuracy = 1)), stat = "prop", position = position_stack(.5) ) ``` ## A dodged bar plot to compare two distributions A dodged bar plot could be used to compare two distributions. ```{r} ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex) + geom_bar(position = "dodge") ``` On the previous graph, it is difficult to see if first class is over- or under-represented among women, due to the fact they were much more men on the boat. `stat_prop()` could be used to adjust the graph by displaying instead the proportion within each category (i.e. here the proportion by sex). ```{r} ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) + geom_bar(stat = "prop", position = "dodge") + scale_y_continuous(labels = scales::percent) ``` The same example with labels: ```{r} ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex, y = after_stat(prop)) + geom_bar(stat = "prop", position = "dodge") + scale_y_continuous(labels = scales::percent) + geom_text( mapping = aes( label = scales::percent(after_stat(prop), accuracy = .1), y = after_stat(0.01) ), vjust = "bottom", position = position_dodge(.9), stat = "prop" ) ``` ## Displaying unobserved levels With the `complete` argument, it is possible to indicate an aesthetic for those statistics should be completed for unobserved values. ```{r} d <- diamonds |> dplyr::filter(!(cut == "Ideal" & clarity == "I1")) |> dplyr::filter(!(cut == "Very Good" & clarity == "VS2")) |> dplyr::filter(!(cut == "Premium" & clarity == "IF")) p <- ggplot(d) + aes(x = clarity, fill = cut, by = clarity) + geom_bar(position = "fill") p + geom_text( stat = "prop", position = position_fill(.5) ) ``` Adding `complete = "fill"` will generate "0.0%" labels where relevant. ```{r} p + geom_text( stat = "prop", position = position_fill(.5), complete = "fill" ) ``` ## Using `geom_prop_bar()` and `geom_prop_text()` The dedicated geometries `geom_prop_bar()` and `geom_prop_text()` could be used for quick and easy proportional bar plots. They use by default `stat_prop()` with relevant default values. For example, proportions are computed by **x** or **y** if the `by` aesthetic is not specified. It allows to generate a quick proportional bar plot. ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_prop_bar() + geom_prop_text() ``` You can specify a `by` aesthetic. For example, to reproduce the comparison of the two distributions presented earlier. ```{r} d <- as.data.frame(Titanic) ggplot(d) + aes(x = Class, fill = Sex, weight = Freq, by = Sex) + geom_prop_bar(position = "dodge") + geom_prop_text( position = position_dodge(width = .9), vjust = - 0.5 ) + scale_y_continuous(labels = scales::percent) ``` You can also display counts instead of proportions. ```{r} ggplot(diamonds) + aes(x = clarity, fill = cut) + geom_prop_bar(height = "count") + geom_prop_text( height = "count", labels = "count", labeller = scales::number ) ``` ggstats/inst/doc/stat_weighted_mean.html0000644000176200001440000012716314674040005020203 0ustar liggesusers Compute weighted mean with stat_weighted_mean()

Compute weighted mean with stat_weighted_mean()

library(ggstats)
library(ggplot2)

stat_weighted_mean() computes mean value of y (taking into account any weight aesthetic if provided) for each value of x. More precisely, it will return a new data frame with one line per unique value of x with the following new variables:

Let’s take an example. The following plot shows all tips received according to the day of the week.

data(tips, package = "reshape")
ggplot(tips) +
  aes(x = day, y = tip) +
  geom_point()

To plot their mean value per day, simply use stat_weighted_mean().

ggplot(tips) +
  aes(x = day, y = tip) +
  stat_weighted_mean()

We can specify the geometry we want using geom argument. Note that for lines, we need to specify the group aesthetic as well.

ggplot(tips) +
  aes(x = day, y = tip, group = 1) +
  stat_weighted_mean(geom = "line")

An alternative is to specify the statistic in ggplot2::geom_line().

ggplot(tips) +
  aes(x = day, y = tip, group = 1) +
  geom_line(stat = "weighted_mean")

Of course, it could be use with other geometries. Here a bar plot.

p <- ggplot(tips) +
  aes(x = day, y = tip, fill = sex) +
  stat_weighted_mean(geom = "bar", position = "dodge") +
  ylab("mean tip")
p

It is very easy to add facets. In that case, computation will be done separately for each facet.

p + facet_grid(rows = vars(smoker))

stat_weighted_mean() could be also used for computing proportions as a proportion is technically a mean of binary values (0 or 1).

ggplot(tips) +
  aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) +
  stat_weighted_mean(geom = "bar", position = "dodge") +
  scale_y_continuous(labels = scales::percent) +
  ylab("proportion of smoker")

Finally, you can use the weight aesthetic to indicate weights to take into account for computing means / proportions.

d <- as.data.frame(Titanic)
ggplot(d) +
  aes(x = Class, y = as.integer(Survived == "Yes"), weight = Freq, fill = Sex) +
  geom_bar(stat = "weighted_mean", position = "dodge") +
  scale_y_continuous(labels = scales::percent) +
  labs(y = "Proportion who survived")

ggstats/inst/doc/geom_diverging.Rmd0000644000176200001440000001261014674033502017105 0ustar liggesusers--- title: "Geometries for diverging bar plots" author: Joseph Larmarange output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Geometries for diverging bar plots} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ```{r setup} library(ggstats) library(dplyr) library(ggplot2) library(patchwork) ``` *Note :* if you are looking for an all-in-one function to display Likert-type items, please refer to `gglikert()` and `vignette("gglikert")`. ## New positions Diverging bar plots could be achieved using `position_diverging()` or `position_likert()`. `position_diverging()` stacks bars on top of each other and centers them around zero (the same number of categories are displayed on each side). ```{r} base <- ggplot(diamonds) + aes(y = clarity, fill = cut) + theme(legend.position = "none") p_stack <- base + geom_bar(position = "stack") + ggtitle("position_stack()") p_diverging <- base + geom_bar(position = "diverging") + ggtitle("position_diverging()") p_stack + p_diverging ``` `position_likert()` is similar but uses proportions instead of counts. ```{r} p_fill <- base + geom_bar(position = "fill") + ggtitle("position_fill()") p_likert <- base + geom_bar(position = "likert") + ggtitle("position_likert()") p_fill + p_likert ``` By default, the same number of categories is displayed on each side, i.e. if you have 4 categories, 2 will be displayed negatively and 2 positively. If you have an odd number of categories, half of the central category will be displayed negatively and half positively. The center could be changed with the `cutoff` argument, representing the number of categories to be displayed negatively: `2` to display negatively the two first categories, `2.5` to display negatively the two first categories and half of the third, `2.2` to display negatively the two first categories and a fifth of the third. ```{r} p_1 <- base + geom_bar(position = position_diverging(cutoff = 1)) + ggtitle("cutoff = 1") p_2 <- base + geom_bar(position = position_diverging(cutoff = 2)) + ggtitle("cutoff = 2") p_null <- base + geom_bar(position = position_diverging(cutoff = NULL)) + ggtitle("cutoff = NULL") p_3.75 <- base + geom_bar(position = position_diverging(cutoff = 3.75)) + ggtitle("cutoff = 3.75") p_5 <- base + geom_bar(position = position_diverging(cutoff = 5)) + ggtitle("cutoff = 5") wrap_plots(p_1, p_2, p_null, p_3.75, p_5) ``` ## New scales For a diverging bar plot, it is recommended to use a diverging palette, as provided in the Brewer palettes. Sometimes, the number of available colors is insufficient in the palette. In that case, you could use `pal_extender()` or `scale_fill_extended()`. However, if you use a custom `cutoff`, it is also important to change the center of the palette as well. Therefore, for diverging bar plots, we recommend to use `scale_fill_likert()`. ```{r} wrap_plots( p_1 + scale_fill_likert(cutoff = 1), p_null + scale_fill_likert(), p_3.75 + scale_fill_likert(cutoff = 3.75) ) ``` ## Improving axes You may also want have centered axes. That could be easily achieved with `symmetric_limits()`. You could also use `label_number_abs()` or `label_percent_abs()` to display absolute numbers. ```{r} wrap_plots( p_3.75, p_3.75 + scale_x_continuous( limits = symmetric_limits, labels = label_number_abs() ) ) ``` ## New geometries To facilitate the creation of diverging bar plots, you could use variants of `geom_bar()` and `geom_text()`. ### geom_diverging() & geom_diverging_text() Let's consider the following plot: ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "diverging") + geom_text( aes( label = label_number_abs(hide_below = 800) (after_stat(count)) ), stat = "count", position = position_diverging(.5) ) + scale_fill_likert() + scale_x_continuous( labels = label_number_abs(), limits = symmetric_limits ) ``` The same could be achieved quicker with `geom_diverging()` and `geom_diverging_text()`. ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_diverging() + geom_diverging_text(hide_below = 800) + scale_fill_likert() + scale_x_continuous( labels = label_number_abs(), limits = symmetric_limits ) ``` ### geom_likert() & geom_likert_text() `geom_likert()` and `geom_likert_text()` works similarly. `geom_likert_text()` takes advantages of `stat_prop()` for computing the proportions to be displayed (see `vignette("stat_prop")`). ```{r} ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_likert() + geom_likert_text(hide_below = 0.10) + scale_fill_likert() + scale_x_continuous( labels = label_percent_abs() ) ``` ### geom_pyramid() & geom_pyramid_text() Finally, `geom_pyramid()` and `geom_pyramid_text()` are variations adapted to display an age-sex pyramid. It uses proportions of the total. ```{r} d <- Titanic |> as.data.frame() ggplot(d) + aes(y = Class, fill = Sex, weight = Freq) + geom_pyramid() + geom_pyramid_text() + scale_x_continuous( labels = label_percent_abs(), limits = symmetric_limits ) ``` ggstats/inst/doc/gglikert.R0000644000176200001440000001462714674037775015441 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ggstats) library(dplyr) library(ggplot2) ## ----------------------------------------------------------------------------- likert_levels <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree" ) set.seed(42) df <- tibble( q1 = sample(likert_levels, 150, replace = TRUE), q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q5 = sample(c(likert_levels, NA), 150, replace = TRUE), q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) likert_levels_dk <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree", "Don't know" ) df_dk <- tibble( q1 = sample(likert_levels_dk, 150, replace = TRUE), q2 = sample(likert_levels_dk, 150, replace = TRUE, prob = 6:1), q3 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q4 = sample(likert_levels_dk, 150, replace = TRUE, prob = 1:6), q5 = sample(c(likert_levels_dk, NA), 150, replace = TRUE), q6 = sample( likert_levels_dk, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0, 1) ) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels_dk))) ## ----------------------------------------------------------------------------- gglikert(df) ## ----------------------------------------------------------------------------- gglikert(df, include = q1:q3) ## ----------------------------------------------------------------------------- gglikert(df) + ggtitle("A Likert-type items plot", subtitle = "generated with gglikert()") + scale_fill_brewer(palette = "RdYlBu") ## ----------------------------------------------------------------------------- gglikert(df, sort = "ascending") ## ----------------------------------------------------------------------------- gglikert(df, sort = "ascending", sort_method = "mean") ## ----------------------------------------------------------------------------- gglikert(df, reverse_likert = TRUE) ## ----------------------------------------------------------------------------- gglikert(df, add_labels = FALSE) ## ----------------------------------------------------------------------------- gglikert( df, labels_size = 3, labels_accuracy = .1, labels_hide_below = .2, labels_color = "white" ) ## ----------------------------------------------------------------------------- gglikert( df, totals_include_center = TRUE, sort = "descending", sort_prop_include_center = TRUE ) ## ----------------------------------------------------------------------------- gglikert( df, totals_size = 4, totals_color = "blue", totals_fontface = "italic", totals_hjust = .20 ) ## ----------------------------------------------------------------------------- gglikert(df, add_totals = FALSE) ## ----------------------------------------------------------------------------- if (require(labelled)) { df <- df |> set_variable_labels( q1 = "first question", q2 = "second question", q3 = "this is the third question with a quite long variable label" ) } gglikert(df) ## ----------------------------------------------------------------------------- gglikert( df, variable_labels = c( q1 = "alternative label for the first question", q6 = "another custom label" ) ) ## ----------------------------------------------------------------------------- gglikert(df, y_label_wrap = 20) gglikert(df, y_label_wrap = 200) ## ----------------------------------------------------------------------------- gglikert(df, cutoff = 0) gglikert(df, cutoff = 1) gglikert(df, cutoff = 1.25) gglikert(df, cutoff = 1.75) gglikert(df, cutoff = 2) gglikert(df, cutoff = NULL) gglikert(df, cutoff = 4) gglikert(df, cutoff = 5) ## ----------------------------------------------------------------------------- gglikert(df, cutoff = 1) gglikert(df, cutoff = 1, symmetric = TRUE) ## ----------------------------------------------------------------------------- gglikert(df_dk) ## ----------------------------------------------------------------------------- df_dk |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) |> gglikert() ## ----------------------------------------------------------------------------- df_dk |> gglikert(exclude_fill_values = "Don't know") ## ----message=FALSE------------------------------------------------------------ df_group <- df df_group$group1 <- sample(c("A", "B"), 150, replace = TRUE) df_group$group2 <- sample(c("a", "b", "c"), 150, replace = TRUE) gglikert(df_group, q1:q6, facet_cols = vars(group1), labels_size = 3 ) gglikert(df_group, q1:q2, facet_rows = vars(group1, group2), labels_size = 3 ) gglikert(df_group, q3:q6, facet_cols = vars(group1), facet_rows = vars(group2), labels_size = 3 ) + scale_x_continuous( labels = label_percent_abs(), expand = expansion(0, .2) ) ## ----------------------------------------------------------------------------- gglikert(df_group, q1:q4, y = "group1", facet_rows = vars(.question), labels_size = 3, facet_label_wrap = 15 ) ## ----------------------------------------------------------------------------- gglikert_stacked(df) gglikert_stacked( df, sort = "asc", add_median_line = TRUE, add_labels = FALSE ) gglikert_stacked( df_group, include = q1:q4, y = "group2" ) + facet_grid( rows = vars(.question), labeller = label_wrap_gen(15) ) ## ----------------------------------------------------------------------------- gglikert_data(df) |> head() ## ----------------------------------------------------------------------------- ggplot(gglikert_data(df)) + aes(y = .question, fill = .answer) + geom_bar(position = "fill") ## ----------------------------------------------------------------------------- df$sampling_weights <- runif(nrow(df)) gglikert(df, q1:q4, weights = sampling_weights) ggstats/inst/doc/ggcoef_model.html0000644000176200001440000105322514674037756017003 0ustar liggesusers Plot model coefficients with ggcoef_model()

Plot model coefficients with ggcoef_model()

Joseph Larmarange

library(ggstats)

The purpose of ggcoef_model() is to quickly plot the coefficients of a model. It is an updated and improved version of GGally::ggcoef() based on broom.helpers::tidy_plus_plus(). For displaying a nicely formatted table of the same models, look at gtsummary::tbl_regression().

Quick coefficients plot

To work automatically, this function requires the {broom.helpers}. Simply call ggcoef_model() with a model object. It could be the result of stats::lm, stats::glm or any other model covered by {broom.helpers}.

data(tips, package = "reshape")
mod_simple <- lm(tip ~ day + time + total_bill, data = tips)
ggcoef_model(mod_simple)

In the case of a logistic regression (or any other model for which coefficients are usually exponentiated), simply indicated exponentiate = TRUE. Note that a logarithmic scale will be used for the x-axis.

d_titanic <- as.data.frame(Titanic)
d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes"))
mod_titanic <- glm(
  Survived ~ Sex * Age + Class,
  weights = Freq,
  data = d_titanic,
  family = binomial
)
ggcoef_model(mod_titanic, exponentiate = TRUE)

Customizing the plot

Variable labels

You can use the {labelled} package to define variable labels. They will be automatically used by ggcoef_model(). Note that variable labels should be defined before computing the model.

library(labelled)
tips_labelled <- tips |>
  set_variable_labels(
    day = "Day of the week",
    time = "Lunch or Dinner",
    total_bill = "Bill's total"
  )
mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled)
ggcoef_model(mod_labelled)

You can also define custom variable labels directly by passing a named vector to the variable_labels option.

ggcoef_model(
  mod_simple,
  variable_labels = c(
    day = "Week day",
    time = "Time (lunch or dinner ?)",
    total_bill = "Total of the bill"
  )
)

If variable labels are to long, you can pass ggplot2::label_wrap_gen() or any other labeller function to facet_labeller.

ggcoef_model(
  mod_simple,
  variable_labels = c(
    day = "Week day",
    time = "Time (lunch or dinner ?)",
    total_bill = "Total of the bill"
  ),
  facet_labeller = ggplot2::label_wrap_gen(10)
)

Use facet_row = NULL to hide variable names.

ggcoef_model(mod_simple, facet_row = NULL, colour_guide = TRUE)

Term labels

Several options allows you to customize term labels.

ggcoef_model(mod_titanic, exponentiate = TRUE)

ggcoef_model(
  mod_titanic,
  exponentiate = TRUE,
  show_p_values = FALSE,
  signif_stars = FALSE,
  add_reference_rows = FALSE,
  categorical_terms_pattern = "{level} (ref: {reference_level})",
  interaction_sep = " x "
) +
  ggplot2::scale_y_discrete(labels = scales::label_wrap(15))
#> Scale for y is already present.
#> Adding another scale for y, which will replace the existing scale.

By default, for categorical variables using treatment and sum contrasts, reference rows will be added and displayed on the graph.

mod_titanic2 <- glm(
  Survived ~ Sex * Age + Class,
  weights = Freq,
  data = d_titanic,
  family = binomial,
  contrasts = list(Sex = contr.sum, Class = contr.treatment(4, base = 3))
)
ggcoef_model(mod_titanic2, exponentiate = TRUE)

Continuous variables with polynomial terms defined with stats::poly() are also properly managed.

mod_poly <- lm(Sepal.Length ~ poly(Petal.Width, 3) + Petal.Length, data = iris)
ggcoef_model(mod_poly)

Use no_reference_row to indicate which variables should not have a reference row added.

ggcoef_model(
  mod_titanic2,
  exponentiate = TRUE,
  no_reference_row = "Sex"
)

ggcoef_model(
  mod_titanic2,
  exponentiate = TRUE,
  no_reference_row = broom.helpers::all_dichotomous()
)

ggcoef_model(
  mod_titanic2,
  exponentiate = TRUE,
  no_reference_row = broom.helpers::all_categorical(),
  categorical_terms_pattern = "{level}/{reference_level}"
)

Elements to display

Use intercept = TRUE to display intercepts.

ggcoef_model(mod_simple, intercept = TRUE)

You can remove confidence intervals with conf.int = FALSE.

ggcoef_model(mod_simple, conf.int = FALSE)

By default, significant terms (i.e. with a p-value below 5%) are highlighted using two types of dots. You can control the level of significance with significance or remove it with significance = NULL.

ggcoef_model(mod_simple, significance = NULL)

By default, dots are colored by variable. You can deactivate this behavior with colour = NULL.

ggcoef_model(mod_simple, colour = NULL)

You can display only a subset of terms with include.

ggcoef_model(mod_simple, include = c("time", "total_bill"))

It is possible to use tidyselect helpers.

ggcoef_model(mod_simple, include = dplyr::starts_with("t"))

You can remove stripped rows with stripped_rows = FALSE.

ggcoef_model(mod_simple, stripped_rows = FALSE)

Do not hesitate to consult the help file of ggcoef_model() to see all available options.

ggplot2 elements

The plot returned by ggcoef_model() is a classic ggplot2 plot. You can therefore apply ggplot2 functions to it.

ggcoef_model(mod_simple) +
  ggplot2::xlab("Coefficients") +
  ggplot2::ggtitle("Custom title") +
  ggplot2::scale_color_brewer(palette = "Set1") +
  ggplot2::theme(legend.position = "right")
#> Scale for colour is already present.
#> Adding another scale for colour, which will replace the existing scale.

Forest plot with a coefficient table

ggcoef_table() is a variant of ggcoef_model() displaying a coefficient table on the right of the forest plot.

ggcoef_table(mod_simple)

ggcoef_table(mod_titanic, exponentiate = TRUE)

You can easily customize the columns to be displayed.

ggcoef_table(
  mod_simple,
  table_stat = c("label", "estimate", "std.error", "ci"),
  ci_pattern = "{conf.low} to {conf.high}",
  table_stat_label = list(
    estimate = scales::label_number(accuracy = .001),
    conf.low = scales::label_number(accuracy = .01),
    conf.high = scales::label_number(accuracy = .01),
    std.error = scales::label_number(accuracy = .001),
    label = toupper
  ),
  table_header = c("Term", "Coef.", "SE", "CI"),
  table_witdhs = c(2, 3)
)

Multinomial models

For multinomial models, simply use ggcoef_multinom(). Three types of visualizations are available: "dodged", "faceted" and "table".

library(nnet)
hec <- as.data.frame(HairEyeColor)
mod <- multinom(
  Hair ~ Eye + Sex,
  data = hec,
  weights = hec$Freq
)
#> # weights:  24 (15 variable)
#> initial  value 820.686262 
#> iter  10 value 669.061500
#> iter  20 value 658.888977
#> final  value 658.885327 
#> converged
ggcoef_multinom(
  mod,
  exponentiate = TRUE
)

ggcoef_multinom(
  mod,
  exponentiate = TRUE,
  type = "faceted"
)

ggcoef_multinom(
  mod,
  exponentiate = TRUE,
  type = "table"
)

You can use y.level_label to customize the label of each level.

ggcoef_multinom(
  mod,
  type = "faceted",
  y.level_label = c("Brown" = "Brown\n(ref: Black)"),
  exponentiate = TRUE
)

Multi-components models

Multi-components models such as zero-inflated Poisson or beta regression generate a set of terms for each of their components. You can use ggcoef_multicomponents() which is similar to ggcoef_multinom().

library(pscl)
#> Classes and Methods for R originally developed in the
#> Political Science Computational Laboratory
#> Department of Political Science
#> Stanford University (2002-2015),
#> by and under the direction of Simon Jackman.
#> hurdle and zeroinfl functions by Achim Zeileis.
data("bioChemists", package = "pscl")
mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists)

ggcoef_multicomponents(mod)
#> ℹ <zeroinfl> model detected.
#> ✔ `tidy_zeroinfl()` used instead.
#> ℹ Add `tidy_fun = broom.helpers::tidy_zeroinfl` to quiet these messages.

ggcoef_multicomponents(mod, type = "f")
#> ℹ <zeroinfl> model detected.
#> ✔ `tidy_zeroinfl()` used instead.
#> ℹ Add `tidy_fun = broom.helpers::tidy_zeroinfl` to quiet these messages.

ggcoef_multicomponents(mod, type = "t")
#> ℹ <zeroinfl> model detected.
#> ✔ `tidy_zeroinfl()` used instead.
#> ℹ Add `tidy_fun = broom.helpers::tidy_zeroinfl` to quiet these messages.

ggcoef_multicomponents(
  mod,
  type = "t",
  component_label = c(conditional = "Count", zero_inflated = "Zero-inflated")
)
#> ℹ <zeroinfl> model detected.
#> ✔ `tidy_zeroinfl()` used instead.
#> ℹ Add `tidy_fun = broom.helpers::tidy_zeroinfl` to quiet these messages.

Comparing several models

You can easily compare several models with ggcoef_compare(). To be noted, ggcoef_compare() is not compatible with multinomial or multi-components models.

mod1 <- lm(Fertility ~ ., data = swiss)
mod2 <- step(mod1, trace = 0)
mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss)
models <- list(
  "Full model" = mod1,
  "Simplified model" = mod2,
  "With interaction" = mod3
)

ggcoef_compare(models)

ggcoef_compare(models, type = "faceted")

Advanced users

Advanced users could use their own dataset and pass it to ggcoef_plot(). Such dataset could be produced by ggcoef_model(), ggcoef_compare() or ggcoef_multinom() with the option return_data = TRUE or by using broom::tidy() or broom.helpers::tidy_plus_plus().

Supported models

model notes
betareg::betareg() Use tidy_parameters() as tidy_fun with component argument to control with coefficients to return. broom::tidy() does not support the exponentiate argument for betareg models, use tidy_parameters() instead.
biglm::bigglm()
brms::brm() broom.mixed package required
cmprsk::crr() Limited support. It is recommended to use tidycmprsk::crr() instead.
fixest::feglm() May fail with R <= 4.0.
fixest::femlm() May fail with R <= 4.0.
fixest::feNmlm() May fail with R <= 4.0.
fixest::feols() May fail with R <= 4.0.
gam::gam()
geepack::geeglm()
glmmTMB::glmmTMB() broom.mixed package required
lavaan::lavaan() Limited support for categorical variables
lfe::felm()
lme4::glmer.nb() broom.mixed package required
lme4::glmer() broom.mixed package required
lme4::lmer() broom.mixed package required
logitr::logitr() Requires logitr >= 0.8.0
MASS::glm.nb()
MASS::polr()
mgcv::gam() Use default tidier broom::tidy() for smooth terms only, or gtsummary::tidy_gam() to include parametric terms
mice::mira Limited support. If mod is a mira object, use tidy_fun = function(x, ...) {mice::pool(x) %>% mice::tidy(...)}
mmrm::mmrm()
multgee::nomLORgee() Experimental support. Use tidy_multgee() as tidy_fun.
multgee::ordLORgee() Experimental support. Use tidy_multgee() as tidy_fun.
nnet::multinom()
ordinal::clm() Limited support for models with nominal predictors.
ordinal::clmm() Limited support for models with nominal predictors.
parsnip::model_fit Supported as long as the type of model and the engine is supported.
plm::plm()
pscl::hurdle() Use tidy_zeroinfl() as tidy_fun.
pscl::zeroinfl() Use tidy_zeroinfl() as tidy_fun.
rstanarm::stan_glm() broom.mixed package required
stats::aov() Reference rows are not relevant for such models.
stats::glm()
stats::lm()
stats::nls() Limited support
survey::svycoxph()
survey::svyglm()
survey::svyolr()
survival::cch() Experimental support. | |survival::clogit()| | |survival::coxph()| | |survival::survreg()| | |tidycmprsk::crr()| | |VGAM::vglm()|Limited support. It is recommended to usetidy_parameters()astidy_fun`.

Note: this list of models has been tested. {broom.helpers}, and therefore ggcoef_model(), may or may not work properly or partially with other types of models.

ggstats/inst/WORDLIST0000644000176200001440000000032514674033502014101 0ustar liggesusersBaddeley CMD Codecov Colour DOI GGally Labeller Lifecycle Likert ORCID POSIXct behaviour colour colours dev geom's geoms ggplot ggproto labeller labelling likert resid th tibble unmapped ggstats/README.md0000644000176200001440000001145414674034127013222 0ustar liggesusers # `ggstats`: extension to `ggplot2` for plotting stats [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![R-CMD-check](https://github.com/larmarange/ggstats/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/larmarange/ggstats/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/larmarange/ggstats/graph/badge.svg)](https://app.codecov.io/gh/larmarange/ggstats) [![CRAN status](https://www.r-pkg.org/badges/version/ggstats)](https://CRAN.R-project.org/package=ggstats) [![DOI](https://zenodo.org/badge/547360047.svg)](https://zenodo.org/badge/latestdoi/547360047) The `ggstats` package provides new statistics, new geometries and new positions for `ggplot2` and a suite of functions to facilitate the creation of statistical plots. ## Installation & Documentation To install **stable version**: ``` r install.packages("ggstats") ``` Documentation of stable version: To install **development version**: ``` r remotes::install_github("larmarange/ggstats") ``` Documentation of development version: ## Plot model coefficients ``` r library(ggstats) mod1 <- lm(Fertility ~ ., data = swiss) ggcoef_model(mod1) ``` ``` r ggcoef_table(mod1) ``` ## Comparing several models ``` r mod2 <- step(mod1, trace = 0) mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) models <- list( "Full model" = mod1, "Simplified model" = mod2, "With interaction" = mod3 ) ggcoef_compare(models, type = "faceted") ``` ## Compute custom proportions ``` r library(ggplot2) ggplot(as.data.frame(Titanic)) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) + facet_grid(~Sex) ``` ## Compute weighted mean ``` r data(tips, package = "reshape") ggplot(tips) + aes(x = day, y = total_bill, fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + ylab("Mean total bill per day and sex") ``` ## Compute cross-tabulation statistics ``` r ggplot(as.data.frame(Titanic)) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(std.resid) ) + stat_cross(shape = 22) + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + scale_size_area(max_size = 20) ``` ## Plot survey objects taking into account weights ``` r library(survey, quietly = TRUE) #> #> Attachement du package : 'survey' #> L'objet suivant est masqué depuis 'package:graphics': #> #> dotchart dw <- svydesign( ids = ~1, weights = ~Freq, data = as.data.frame(Titanic) ) ggsurvey(dw) + aes(x = Class, fill = Survived) + geom_bar(position = "fill") + ylab("Weighted proportion of survivors") ``` ## Plot Likert-type items ``` r library(dplyr) #> #> Attachement du package : 'dplyr' #> Les objets suivants sont masqués depuis 'package:stats': #> #> filter, lag #> Les objets suivants sont masqués depuis 'package:base': #> #> intersect, setdiff, setequal, union likert_levels <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree" ) set.seed(42) df <- tibble( q1 = sample(likert_levels, 150, replace = TRUE), q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q5 = sample(c(likert_levels, NA), 150, replace = TRUE), q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) gglikert(df) ``` ## Cascade plot (*experimental*) ``` r ggplot2::diamonds |> ggcascade( all = TRUE, big = carat > .5, "big & ideal" = carat > .5 & cut == "Ideal" ) ``` ggstats/build/0000755000176200001440000000000014674040007013027 5ustar liggesusersggstats/build/vignette.rds0000644000176200001440000000066214674040007015372 0ustar liggesusersS;O0NhPb `[&"#JՍ@q8 }k/vΉ^70{t~LYyl=4$.b<|?M3=@!I$R7h!Eg\K͍)A I$@2@e#cm#z1Q%9I\^M-ҐLC\@9? 7 bR"-2L̆)d#וÊP(8)K"doJ&];)k7X5j)uXe}?^?7EUN{1E:Jk-Nggstats/man/0000755000176200001440000000000014674033502012505 5ustar liggesusersggstats/man/ggcoef_model.Rd0000644000176200001440000004427514674033502015422 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggcoef_model.R \name{ggcoef_model} \alias{ggcoef_model} \alias{ggcoef_table} \alias{ggcoef_compare} \alias{ggcoef_multinom} \alias{ggcoef_multicomponents} \alias{ggcoef_plot} \title{Plot model coefficients} \usage{ ggcoef_model( model, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = 1 - conf.level, significance_labels = NULL, show_p_values = TRUE, signif_stars = TRUE, return_data = FALSE, ... ) ggcoef_table( model, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = 1 - conf.level, significance_labels = NULL, show_p_values = FALSE, signif_stars = FALSE, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), plot_title = NULL, ... ) ggcoef_compare( models, type = c("dodged", "faceted"), tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), add_pairwise_contrasts = FALSE, pairwise_variables = broom.helpers::all_categorical(), keep_model_terms = FALSE, pairwise_reverse = TRUE, emmeans_args = list(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, ... ) ggcoef_multinom( model, type = c("dodged", "faceted", "table"), y.level_label = NULL, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), ... ) ggcoef_multicomponents( model, type = c("dodged", "faceted", "table"), component_col = "component", component_label = NULL, tidy_fun = broom.helpers::tidy_with_broom_or_parameters, tidy_args = NULL, conf.int = TRUE, conf.level = 0.95, exponentiate = FALSE, variable_labels = NULL, term_labels = NULL, interaction_sep = " * ", categorical_terms_pattern = "{level}", add_reference_rows = TRUE, no_reference_row = NULL, intercept = FALSE, include = dplyr::everything(), significance = 1 - conf.level, significance_labels = NULL, return_data = FALSE, table_stat = c("estimate", "ci", "p.value"), table_header = NULL, table_text_size = 3, table_stat_label = NULL, ci_pattern = "{conf.low}, {conf.high}", table_witdhs = c(3, 2), ... ) ggcoef_plot( data, x = "estimate", y = "label", exponentiate = FALSE, point_size = 2, point_stroke = 2, point_fill = "white", colour = NULL, colour_guide = TRUE, colour_lab = "", colour_labels = ggplot2::waiver(), shape = "significance", shape_values = c(16, 21), shape_guide = TRUE, shape_lab = "", errorbar = TRUE, errorbar_height = 0.1, errorbar_coloured = FALSE, stripped_rows = TRUE, strips_odd = "#11111111", strips_even = "#00000000", vline = TRUE, vline_colour = "grey50", dodged = FALSE, dodged_width = 0.8, facet_row = "var_label", facet_col = NULL, facet_labeller = "label_value" ) } \arguments{ \item{model}{a regression model object} \item{tidy_fun}{(\code{function})\cr Option to specify a custom tidier function.} \item{tidy_args}{Additional arguments passed to \code{\link[broom.helpers:tidy_plus_plus]{broom.helpers::tidy_plus_plus()}} and to \code{tidy_fun}} \item{conf.int}{(\code{logical})\cr Should confidence intervals be computed? (see \code{\link[broom:reexports]{broom::tidy()}})} \item{conf.level}{the confidence level to use for the confidence interval if \code{conf.int = TRUE}; must be strictly greater than 0 and less than 1; defaults to 0.95, which corresponds to a 95 percent confidence interval} \item{exponentiate}{if \code{TRUE} a logarithmic scale will be used for x-axis} \item{variable_labels}{(\code{\link[gtsummary:syntax]{formula-list-selector}})\cr A named list or a named vector of custom variable labels.} \item{term_labels}{(\code{list} or \code{vector})\cr A named list or a named vector of custom term labels.} \item{interaction_sep}{(\code{string})\cr Separator for interaction terms.} \item{categorical_terms_pattern}{(\code{\link[glue:glue]{glue pattern}})\cr A \link[glue:glue]{glue pattern} for labels of categorical terms with treatment or sum contrasts (see \code{\link[broom.helpers:model_list_terms_levels]{model_list_terms_levels()}}).} \item{add_reference_rows}{(\code{logical})\cr Should reference rows be added?} \item{no_reference_row}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr Variables for those no reference row should be added, when \code{add_reference_rows = TRUE}.} \item{intercept}{(\code{logical})\cr Should the intercept(s) be included?} \item{include}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr Variables to include. Default is \code{everything()}. See also \code{\link[broom.helpers:all_continuous]{all_continuous()}}, \code{\link[broom.helpers:all_categorical]{all_categorical()}}, \code{\link[broom.helpers:all_dichotomous]{all_dichotomous()}} and \code{\link[broom.helpers:all_interaction]{all_interaction()}}.} \item{add_pairwise_contrasts}{(\code{logical})\cr Apply \code{\link[broom.helpers:tidy_add_pairwise_contrasts]{tidy_add_pairwise_contrasts()}}?} \item{pairwise_variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr Variables to add pairwise contrasts.} \item{keep_model_terms}{(\code{logical})\cr Keep original model terms for variables where pairwise contrasts are added? (default is \code{FALSE})} \item{pairwise_reverse}{(\code{logical})\cr Determines whether to use \code{"pairwise"} (if \code{TRUE}) or \code{"revpairwise"} (if \code{FALSE}), see \code{\link[emmeans:contrast]{emmeans::contrast()}}.} \item{emmeans_args}{(\code{list})\cr List of additional parameter to pass to \code{\link[emmeans:emmeans]{emmeans::emmeans()}} when computing pairwise contrasts.} \item{significance}{level (between 0 and 1) below which a coefficient is consider to be significantly different from 0 (or 1 if \code{exponentiate = TRUE}), \code{NULL} for not highlighting such coefficients} \item{significance_labels}{optional vector with custom labels for significance variable} \item{show_p_values}{if \code{TRUE}, add p-value to labels} \item{signif_stars}{if \code{TRUE}, add significant stars to labels} \item{return_data}{if \code{TRUE}, will return the data.frame used for plotting instead of the plot} \item{...}{parameters passed to \code{\link[=ggcoef_plot]{ggcoef_plot()}}} \item{table_stat}{statistics to display in the table, use any column name returned by the tidier or \code{"ci"} for confidence intervals formatted according to \code{ci_pattern}} \item{table_header}{optional custom headers for the table} \item{table_text_size}{text size for the table} \item{table_stat_label}{optional named list of labeller functions for the displayed statistic (see examples)} \item{ci_pattern}{glue pattern for confidence intervals in the table} \item{table_witdhs}{relative widths of the forest plot and the coefficients table} \item{plot_title}{an optional plot title} \item{models}{named list of models} \item{type}{a dodged plot, a faceted plot or multiple table plots?} \item{y.level_label}{an optional named vector for labeling \code{y.level} (see examples)} \item{component_col}{name of the component column} \item{component_label}{an optional named vector for labeling components} \item{data}{a data frame containing data to be plotted, typically the output of \code{ggcoef_model()}, \code{ggcoef_compare()} or \code{ggcoef_multinom()} with the option \code{return_data = TRUE}} \item{x, y}{variables mapped to x and y axis} \item{point_size}{size of the points} \item{point_stroke}{thickness of the points} \item{point_fill}{fill colour for the points} \item{colour}{optional variable name to be mapped to colour aesthetic} \item{colour_guide}{should colour guide be displayed in the legend?} \item{colour_lab}{label of the colour aesthetic in the legend} \item{colour_labels}{labels argument passed to \code{\link[ggplot2:scale_colour_discrete]{ggplot2::scale_colour_discrete()}} and \code{\link[ggplot2:discrete_scale]{ggplot2::discrete_scale()}}} \item{shape}{optional variable name to be mapped to the shape aesthetic} \item{shape_values}{values of the different shapes to use in \code{\link[ggplot2:scale_manual]{ggplot2::scale_shape_manual()}}} \item{shape_guide}{should shape guide be displayed in the legend?} \item{shape_lab}{label of the shape aesthetic in the legend} \item{errorbar}{should error bars be plotted?} \item{errorbar_height}{height of error bars} \item{errorbar_coloured}{should error bars be colored as the points?} \item{stripped_rows}{should stripped rows be displayed in the background?} \item{strips_odd}{color of the odd rows} \item{strips_even}{color of the even rows} \item{vline}{should a vertical line be drawn at 0 (or 1 if \code{exponentiate = TRUE})?} \item{vline_colour}{colour of vertical line} \item{dodged}{should points be dodged (according to the colour aesthetic)?} \item{dodged_width}{width value for \code{\link[ggplot2:position_dodge]{ggplot2::position_dodge()}}} \item{facet_row}{variable name to be used for row facets} \item{facet_col}{optional variable name to be used for column facets} \item{facet_labeller}{labeller function to be used for labeling facets; if labels are too long, you can use \code{\link[ggplot2:labellers]{ggplot2::label_wrap_gen()}} (see examples), more information in the documentation of \code{\link[ggplot2:facet_grid]{ggplot2::facet_grid()}}} } \value{ A \code{ggplot2} plot or a \code{tibble} if \code{return_data = TRUE}. } \description{ \code{ggcoef_model()}, \code{ggcoef_table()}, \code{ggcoef_multinom()}, \code{ggcoef_multicomponents()} and \code{ggcoef_compare()} use \code{\link[broom.helpers:tidy_plus_plus]{broom.helpers::tidy_plus_plus()}} to obtain a \code{tibble} of the model coefficients, apply additional data transformation and then pass the produced \code{tibble} to \code{ggcoef_plot()} to generate the plot. } \details{ For more control, you can use the argument \code{return_data = TRUE} to get the produced \code{tibble}, apply any transformation of your own and then pass your customized \code{tibble} to \code{ggcoef_plot()}. } \section{Functions}{ \itemize{ \item \code{ggcoef_table()}: a variation of \code{\link[=ggcoef_model]{ggcoef_model()}} adding a table with estimates, confidence intervals and p-values \item \code{ggcoef_compare()}: designed for displaying several models on the same plot. \item \code{ggcoef_multinom()}: a variation of \code{\link[=ggcoef_model]{ggcoef_model()}} adapted to multinomial logistic regressions performed with \code{\link[nnet:multinom]{nnet::multinom()}}. \item \code{ggcoef_multicomponents()}: a variation of \code{\link[=ggcoef_model]{ggcoef_model()}} adapted to multi-component models such as zero-inflated models or beta regressions. \code{\link[=ggcoef_multicomponents]{ggcoef_multicomponents()}} has been tested with \code{pscl::zeroinfl()}, \code{pscl::hurdle()} and \code{betareg::betareg()} \item \code{ggcoef_plot()}: plot a tidy \code{tibble} of coefficients }} \examples{ mod <- lm(Sepal.Length ~ Sepal.Width + Species, data = iris) ggcoef_model(mod) ggcoef_table(mod) \donttest{ ggcoef_table(mod, table_stat = c("estimate", "ci")) ggcoef_table( mod, table_stat_label = list( estimate = scales::label_number(.001) ) ) ggcoef_table(mod, table_text_size = 5, table_witdhs = c(1, 1)) # a logistic regression example d_titanic <- as.data.frame(Titanic) d_titanic$Survived <- factor(d_titanic$Survived, c("No", "Yes")) mod_titanic <- glm( Survived ~ Sex * Age + Class, weights = Freq, data = d_titanic, family = binomial ) # use 'exponentiate = TRUE' to get the Odds Ratio ggcoef_model(mod_titanic, exponentiate = TRUE) ggcoef_table(mod_titanic, exponentiate = TRUE) # display intercepts ggcoef_model(mod_titanic, exponentiate = TRUE, intercept = TRUE) # customize terms labels ggcoef_model( mod_titanic, exponentiate = TRUE, show_p_values = FALSE, signif_stars = FALSE, add_reference_rows = FALSE, categorical_terms_pattern = "{level} (ref: {reference_level})", interaction_sep = " x " ) + ggplot2::scale_y_discrete(labels = scales::label_wrap(15)) # display only a subset of terms ggcoef_model(mod_titanic, exponentiate = TRUE, include = c("Age", "Class")) # do not change points' shape based on significance ggcoef_model(mod_titanic, exponentiate = TRUE, significance = NULL) # a black and white version ggcoef_model( mod_titanic, exponentiate = TRUE, colour = NULL, stripped_rows = FALSE ) # show dichotomous terms on one row ggcoef_model( mod_titanic, exponentiate = TRUE, no_reference_row = broom.helpers::all_dichotomous(), categorical_terms_pattern = "{ifelse(dichotomous, paste0(level, ' / ', reference_level), level)}", show_p_values = FALSE ) } \dontshow{if (requireNamespace("reshape")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ data(tips, package = "reshape") mod_simple <- lm(tip ~ day + time + total_bill, data = tips) ggcoef_model(mod_simple) # custom variable labels # you can use the labelled package to define variable labels # before computing model if (requireNamespace("labelled")) { tips_labelled <- tips |> labelled::set_variable_labels( day = "Day of the week", time = "Lunch or Dinner", total_bill = "Bill's total" ) mod_labelled <- lm(tip ~ day + time + total_bill, data = tips_labelled) ggcoef_model(mod_labelled) } # you can provide custom variable labels with 'variable_labels' ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ) ) # if labels are too long, you can use 'facet_labeller' to wrap them ggcoef_model( mod_simple, variable_labels = c( day = "Week day", time = "Time (lunch or dinner ?)", total_bill = "Total of the bill" ), facet_labeller = ggplot2::label_wrap_gen(10) ) # do not display variable facets but add colour guide ggcoef_model(mod_simple, facet_row = NULL, colour_guide = TRUE) # works also with with polynomial terms mod_poly <- lm( tip ~ poly(total_bill, 3) + day, data = tips, ) ggcoef_model(mod_poly) # or with different type of contrasts # for sum contrasts, the value of the reference term is computed if (requireNamespace("emmeans")) { mod2 <- lm( tip ~ day + time + sex, data = tips, contrasts = list(time = contr.sum, day = contr.treatment(4, base = 3)) ) ggcoef_model(mod2) } } \dontshow{\}) # examplesIf} \donttest{ # Use ggcoef_compare() for comparing several models on the same plot mod1 <- lm(Fertility ~ ., data = swiss) mod2 <- step(mod1, trace = 0) mod3 <- lm(Fertility ~ Agriculture + Education * Catholic, data = swiss) models <- list( "Full model" = mod1, "Simplified model" = mod2, "With interaction" = mod3 ) ggcoef_compare(models) ggcoef_compare(models, type = "faceted") # you can reverse the vertical position of the point by using a negative # value for dodged_width (but it will produce some warnings) ggcoef_compare(models, dodged_width = -.9) } \dontshow{if (requireNamespace("nnet")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ # specific function for nnet::multinom models mod <- nnet::multinom(Species ~ ., data = iris) ggcoef_multinom(mod, exponentiate = TRUE) ggcoef_multinom(mod, type = "faceted") ggcoef_multinom( mod, type = "faceted", y.level_label = c("versicolor" = "versicolor\n(ref: setosa)") ) } \dontshow{\}) # examplesIf} \dontshow{if (requireNamespace("pscl")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \donttest{ library(pscl) data("bioChemists", package = "pscl") mod <- zeroinfl(art ~ fem * mar | fem + mar, data = bioChemists) ggcoef_multicomponents(mod) ggcoef_multicomponents(mod, type = "f") ggcoef_multicomponents(mod, type = "t") ggcoef_multicomponents( mod, type = "t", component_label = c(conditional = "Count", zero_inflated = "Zero-inflated") ) mod2 <- zeroinfl(art ~ fem + mar | 1, data = bioChemists) ggcoef_multicomponents(mod2, type = "t") } \dontshow{\}) # examplesIf} } \seealso{ \code{vignette("ggcoef_model")} } ggstats/man/augment_chisq_add_phi.Rd0000644000176200001440000000226514357760261017307 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat_cross.R \name{augment_chisq_add_phi} \alias{augment_chisq_add_phi} \title{Augment a chi-squared test and compute phi coefficients} \usage{ augment_chisq_add_phi(x) } \arguments{ \item{x}{a chi-squared test as returned by \code{\link[stats:chisq.test]{stats::chisq.test()}}} } \value{ A \code{tibble}. } \description{ Augment a chi-squared test and compute phi coefficients } \details{ Phi coefficients are a measurement of the degree of association between two binary variables. \itemize{ \item A value between -1.0 to -0.7 indicates a strong negative association. \item A value between -0.7 to -0.3 indicates a weak negative association. \item A value between -0.3 to +0.3 indicates a little or no association. \item A value between +0.3 to +0.7 indicates a weak positive association. \item A value between +0.7 to +1.0 indicates a strong positive association. } } \examples{ tab <- xtabs(Freq ~ Sex + Class, data = as.data.frame(Titanic)) augment_chisq_add_phi(chisq.test(tab)) } \seealso{ \code{\link[=stat_cross]{stat_cross()}}, \code{GDAtools::phi.table()} or \code{psych::phi()} } ggstats/man/weighted.median.Rd0000644000176200001440000000435614674013371016042 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/weighted_quantile.R \name{weighted.median} \alias{weighted.median} \alias{weighted.quantile} \title{Weighted Median and Quantiles} \source{ These functions are adapted from their homonyms developed by Adrian Baddeley in the \code{spatstat} package. } \usage{ weighted.median(x, w, na.rm = TRUE, type = 2) weighted.quantile(x, w, probs = seq(0, 1, 0.25), na.rm = TRUE, type = 4) } \arguments{ \item{x}{a numeric vector of values} \item{w}{a numeric vector of weights} \item{na.rm}{a logical indicating whether to ignore \code{NA} values} \item{type}{Integer specifying the rule for calculating the median or quantile, corresponding to the rules available for \code{stats:quantile()}. The only valid choices are type=1, 2 or 4. See Details.} \item{probs}{probabilities for which the quantiles should be computed, a numeric vector of values between 0 and 1} } \value{ A numeric vector. } \description{ Compute the median or quantiles a set of numbers which have weights associated with them. } \details{ The \code{i}th observation \code{x[i]} is treated as having a weight proportional to \code{w[i]}. The weighted median is a value \code{m} such that the total weight of data less than or equal to \code{m} is equal to half the total weight. More generally, the weighted quantile with probability \code{p} is a value \code{q} such that the total weight of data less than or equal to \code{q} is equal to \code{p} times the total weight. If there is no such value, then \itemize{ \item if \code{type = 1}, the next largest value is returned (this is the right-continuous inverse of the left-continuous cumulative distribution function); \item if \code{type = 2}, the average of the two surrounding values is returned (the average of the right-continuous and left-continuous inverses); \item if \code{type = 4}, linear interpolation is performed. } Note that the default rule for \code{weighted.median()} is \code{type = 2}, consistent with the traditional definition of the median, while the default for \code{weighted.quantile()} is \code{type = 4}. } \examples{ x <- 1:20 w <- runif(20) weighted.median(x, w) weighted.quantile(x, w) } ggstats/man/ggstats-package.Rd0000644000176200001440000000143114467450345016050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggstats-package.R \docType{package} \name{ggstats-package} \alias{ggstats} \alias{ggstats-package} \title{ggstats: Extension to 'ggplot2' for Plotting Stats} \description{ Provides new statistics, new geometries and new positions for 'ggplot2' and a suite of functions to facilitate the creation of statistical plots. } \seealso{ Useful links: \itemize{ \item \url{https://larmarange.github.io/ggstats/} \item \url{https://github.com/larmarange/ggstats} \item Report bugs at \url{https://github.com/larmarange/ggstats/issues} } } \author{ \strong{Maintainer}: Joseph Larmarange \email{joseph@larmarange.net} (\href{https://orcid.org/0000-0001-7097-700X}{ORCID}) } \keyword{internal} ggstats/man/position_likert.Rd0000644000176200001440000001233114672600601016210 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/position_likert.R \docType{data} \name{position_likert} \alias{position_likert} \alias{position_diverging} \alias{PositionLikert} \alias{PositionDiverging} \title{Stack objects on top of each another and center them around 0} \usage{ position_likert( vjust = 1, reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL ) position_diverging( vjust = 1, reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL ) } \arguments{ \item{vjust}{Vertical adjustment for geoms that have a position (like points or lines), not a dimension (like bars or areas). Set to \code{0} to align with the bottom, \code{0.5} for the middle, and \code{1} (the default) for the top.} \item{reverse}{If \code{TRUE}, will reverse the default stacking order. This is useful if you're rotating both the plot and legend.} \item{exclude_fill_values}{Vector of values from the variable associated with the \code{fill} aesthetic that should not be displayed (but still taken into account for computing proportions)} \item{cutoff}{number of categories to be displayed negatively (i.e. on the left of the x axis or the bottom of the y axis), could be a decimal value: \code{2} to display negatively the two first categories, \code{2.5} to display negatively the two first categories and half of the third, \code{2.2} to display negatively the two first categories and a fifth of the third (see examples). By default (\code{NULL}), it will be equal to the number of categories divided by 2, i.e. it will be centered.} } \description{ \code{position_diverging()} stacks bars on top of each other and center them around zero (the same number of categories are displayed on each side). \code{position_likert()} uses proportions instead of counts. This type of presentation is commonly used to display Likert-type scales. } \details{ It is recommended to use \code{position_likert()} with \code{stat_prop()} and its \code{complete} argument (see examples). } \examples{ library(ggplot2) ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "fill") + scale_x_continuous(label = scales::label_percent()) + xlab("proportion") ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + scale_x_continuous(label = label_percent_abs()) + scale_fill_likert() + xlab("proportion") ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "stack") + scale_fill_likert(pal = scales::brewer_pal(palette = "PiYG")) ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "diverging") + scale_x_continuous(label = label_number_abs()) + scale_fill_likert() \donttest{ # Reverse order ------------------------------------------------------------- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(reverse = TRUE)) + scale_x_continuous(label = label_percent_abs()) + scale_fill_likert() + xlab("proportion") # Custom center ------------------------------------------------------------- ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(cutoff = 1)) + scale_x_continuous(label = label_percent_abs()) + scale_fill_likert(cutoff = 1) + xlab("proportion") ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(cutoff = 3.75)) + scale_x_continuous(label = label_percent_abs()) + scale_fill_likert(cutoff = 3.75) + xlab("proportion") # Missing items ------------------------------------------------------------- # example with a level not being observed for a specific value of y d <- diamonds d <- d[!(d$cut == "Premium" & d$clarity == "I1"), ] d <- d[!(d$cut \%in\% c("Fair", "Good") & d$clarity == "SI2"), ] # by default, the two lowest bar are not properly centered ggplot(d) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + scale_fill_likert() # use stat_prop() with `complete = "fill"` to fix it ggplot(d) + aes(y = clarity, fill = cut) + geom_bar(position = "likert", stat = "prop", complete = "fill") + scale_fill_likert() # Add labels ---------------------------------------------------------------- custom_label <- function(x) { p <- scales::percent(x, accuracy = 1) p[x < .075] <- "" p } ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + geom_text( aes(by = clarity, label = custom_label(after_stat(prop))), stat = "prop", position = position_likert(vjust = .5) ) + scale_x_continuous(label = label_percent_abs()) + scale_fill_likert() + xlab("proportion") # Do not display specific fill values --------------------------------------- # (but taken into account to compute proportions) ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(exclude_fill_values = "Very Good")) + scale_x_continuous(label = label_percent_abs()) + scale_fill_likert() + xlab("proportion") } } \seealso{ See \code{\link[ggplot2:position_stack]{ggplot2::position_stack()}} and \code{\link[ggplot2:position_stack]{ggplot2::position_fill()}} } \keyword{datasets} ggstats/man/hex_bw.Rd0000644000176200001440000000202514674033502014247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hex_bw.R \name{hex_bw} \alias{hex_bw} \alias{hex_bw_threshold} \title{Identify a suitable font color (black or white) given a background HEX color} \source{ Adapted from \code{saros} } \usage{ hex_bw(hex_code) hex_bw_threshold(hex_code, values, threshold) } \arguments{ \item{hex_code}{Background color in hex-format.} \item{values}{Values to be compared.} \item{threshold}{Threshold.} } \value{ Either black or white, in hex-format } \description{ \code{hex_bw_threshold()} is a variation of \code{hex_bw()}. For \code{values} below \code{threshold}, black (\code{"#000000"}) will always be returned, regardless of \code{hex_code}. } \examples{ hex_bw("#0dadfd") library(ggplot2) ggplot(diamonds) + aes(x = cut, fill = color, label = after_stat(count)) + geom_bar() + geom_text( mapping = aes(color = after_scale(hex_bw(.data$fill))), position = position_stack(.5), stat = "count", size = 2 ) } ggstats/man/ggcascade.Rd0000644000176200001440000000520114674034026014675 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggcascade.R \name{ggcascade} \alias{ggcascade} \alias{compute_cascade} \alias{plot_cascade} \title{Cascade plot} \usage{ ggcascade( .data, ..., .weights = NULL, .by = NULL, .nrow = NULL, .ncol = NULL, .add_n = TRUE, .text_size = 4, .arrows = TRUE ) compute_cascade(.data, ..., .weights = NULL, .by = NULL) plot_cascade( .data, .by = NULL, .nrow = NULL, .ncol = NULL, .add_n = TRUE, .text_size = 4, .arrows = TRUE ) } \arguments{ \item{.data}{A data frame, or data frame extension (e.g. a tibble). For \code{plot_cascade()}, the variable displayed on the x-axis should be named \code{"x"} and the number of observations should be named \code{"n"}, like the tibble returned by \code{compute_cascade()}.} \item{...}{<\code{\link[rlang:args_data_masking]{data-masking}}> Name-value pairs of conditions defining the different statuses to be plotted (see examples).} \item{.weights}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> Optional weights. Should select only one variable.} \item{.by}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> A variable or a set of variables to group by the computation of the cascade, and to generate facets. To select several variables, use \code{\link[dplyr:pick]{dplyr::pick()}} (see examples).} \item{.nrow, .ncol}{Number of rows and columns, for faceted plots.} \item{.add_n}{Display the number of observations?} \item{.text_size}{Size of the labels, passed to \code{\link[ggplot2:geom_text]{ggplot2::geom_text()}}.} \item{.arrows}{Display arrows between statuses?} } \value{ A \code{ggplot2} plot or a \code{tibble}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} } \details{ \code{ggcascade()} calls \code{compute_cascade()} to generate a data set passed to \code{plot_cascade()}. Use \code{compute_cascade()} and \code{plot_cascade()} for more controls. } \examples{ ggplot2::diamonds |> ggcascade( all = TRUE, big = carat > .5, "big & ideal" = carat > .5 & cut == "Ideal" ) ggplot2::mpg |> ggcascade( all = TRUE, recent = year > 2000, "recent & economic" = year > 2000 & displ < 3, .by = cyl, .ncol = 3, .arrows = FALSE, .text_size = 3 ) ggplot2::mpg |> ggcascade( all = TRUE, recent = year > 2000, "recent & economic" = year > 2000 & displ < 3, .by = pick(cyl, drv), .add_n = FALSE, .text_size = 2 ) } ggstats/man/stat_prop.Rd0000644000176200001440000002311714674033502015013 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat_prop.R \docType{data} \name{stat_prop} \alias{stat_prop} \alias{StatProp} \alias{geom_prop_bar} \alias{geom_prop_text} \title{Compute proportions according to custom denominator} \usage{ stat_prop( mapping = NULL, data = NULL, geom = "bar", position = "fill", ..., width = NULL, na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE, complete = NULL, default_by = "total", height = c("count", "prop"), labels = c("prop", "count"), labeller = scales::label_percent(accuracy = 0.1) ) geom_prop_bar( mapping = NULL, data = NULL, stat = "prop", position = position_stack(), ..., complete = NULL, default_by = "x", height = "prop" ) geom_prop_text( mapping = NULL, data = NULL, stat = "prop", position = position_stack(vjust), ..., complete = NULL, default_by = "x", height = "prop", labels = "prop", labeller = scales::label_percent(accuracy = 0.1), vjust = 0.5 ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{Override the default connection with \code{\link[ggplot2:geom_bar]{ggplot2::geom_bar()}}.} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{width}{Bar width. By default, set to 90\% of the \code{\link[ggplot2:resolution]{resolution()}} of the data.} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{complete}{Name (character) of an aesthetic for those statistics should be completed for unobserved values (see example).} \item{default_by}{If the \strong{by} aesthetic is not available, name of another aesthetic that will be used to determine the denominators (e.g. \code{"fill"}), or \code{NULL} or \code{"total"} to compute proportions of the total. To be noted, \code{default_by = "x"} works both for vertical and horizontal bars.} \item{height}{Which statistic (\code{"count"} or \code{"prop"}) should be used, by default, for determining the height/width of the geometry (accessible through \code{after_stat(height)})?} \item{labels}{Which statistic (\code{"prop"} or \code{"count"}) should be used, by default, for generating formatted labels (accessible through \code{after_stat(labels)})?} \item{labeller}{Labeller function to format labels and populate \code{after_stat(labels)}.} \item{stat}{The statistical transformation to use on the data for this layer.} \item{vjust}{Vertical/Horizontal adjustment for the position. Set to 0 to align with the bottom/left, 0.5 (the default) for the middle, and 1 for the top/right.} } \value{ A \code{ggplot2} plot with the added statistic. } \description{ \code{stat_prop()} is a variation of \code{\link[ggplot2:geom_bar]{ggplot2::stat_count()}} allowing to compute custom proportions according to the \strong{by} aesthetic defining the denominator (i.e. all proportions for a same value of \strong{by} will sum to 1). If the \strong{by} aesthetic is not specified, denominators will be determined according to the \code{default_by} argument. } \section{Aesthetics}{ \code{stat_prop()} understands the following aesthetics (required aesthetics are in bold): \itemize{ \item \strong{x \emph{or} y} \item by \item weight } } \section{Computed variables}{ \describe{ \item{\code{after_stat(count)}}{number of points in bin} \item{\code{after_stat(denominator)}}{denominator for the proportions} \item{\code{after_stat(prop)}}{computed proportion, i.e. \code{after_stat(count)}/\code{after_stat(denominator)}} \item{\code{after_stat(height)}}{counts or proportions, according to \code{height}} \item{\code{after_stat(labels)}}{formatted heights, according to \code{labels} and \code{labeller}} } } \examples{ library(ggplot2) d <- as.data.frame(Titanic) p <- ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = Class) + geom_bar(position = "fill") + geom_text(stat = "prop", position = position_fill(.5)) p p + facet_grid(~Sex) ggplot(d) + aes(x = Class, fill = Survived, weight = Freq) + geom_bar(position = "dodge") + geom_text( aes(by = Survived), stat = "prop", position = position_dodge(0.9), vjust = "bottom" ) \donttest{ if (requireNamespace("scales")) { ggplot(d) + aes(x = Class, fill = Survived, weight = Freq, by = 1) + geom_bar() + geom_text( aes(label = scales::percent(after_stat(prop), accuracy = 1)), stat = "prop", position = position_stack(.5) ) } ggplot(d) + aes(y = Class, fill = Survived, weight = Freq) + geom_prop_bar() + geom_prop_text() # displaying unobserved levels with complete d <- diamonds |> dplyr::filter(!(cut == "Ideal" & clarity == "I1")) |> dplyr::filter(!(cut == "Very Good" & clarity == "VS2")) |> dplyr::filter(!(cut == "Premium" & clarity == "IF")) p <- ggplot(d) + aes(x = clarity, fill = cut, by = clarity) + geom_bar(position = "fill") p + geom_text(stat = "prop", position = position_fill(.5)) p + geom_text(stat = "prop", position = position_fill(.5), complete = "fill") } } \seealso{ \code{vignette("stat_prop")}, \code{\link[ggplot2:geom_bar]{ggplot2::stat_count()}}. For an alternative approach, see \url{https://github.com/tidyverse/ggplot2/issues/5505#issuecomment-1791324008}. } \keyword{datasets} ggstats/man/ggsurvey.Rd0000644000176200001440000000312214357760261014654 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggsurvey.R \name{ggsurvey} \alias{ggsurvey} \title{Easy ggplot2 with survey objects} \usage{ ggsurvey(design = NULL, mapping = NULL, ...) } \arguments{ \item{design}{A survey design object, usually created with \code{\link[survey:svydesign]{survey::svydesign()}}} \item{mapping}{Default list of aesthetic mappings to use for plot, to be created with \code{\link[ggplot2:aes]{ggplot2::aes()}}.} \item{...}{Other arguments passed on to methods. Not currently used.} } \value{ A \code{ggplot2} plot. } \description{ A function to facilitate \code{ggplot2} graphs using a survey object. It will initiate a ggplot and map survey weights to the corresponding aesthetic. } \details{ Graphs will be correct as long as only weights are required to compute the graph. However, statistic or geometry requiring correct variance computation (like \code{\link[ggplot2:geom_smooth]{ggplot2::geom_smooth()}}) will be statistically incorrect. } \examples{ \dontshow{if (requireNamespace("survey")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(api, package = "survey") dstrat <- survey::svydesign( id = ~1, strata = ~stype, weights = ~pw, data = apistrat, fpc = ~fpc ) ggsurvey(dstrat) + ggplot2::aes(x = cnum, y = dnum) + ggplot2::geom_count() d <- as.data.frame(Titanic) dw <- survey::svydesign(ids = ~1, weights = ~Freq, data = d) ggsurvey(dw) + ggplot2::aes(x = Class, fill = Survived) + ggplot2::geom_bar(position = "fill") \dontshow{\}) # examplesIf} } ggstats/man/gglikert.Rd0000644000176200001440000002311714674033502014610 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/gglikert.R \name{gglikert} \alias{gglikert} \alias{gglikert_data} \alias{gglikert_stacked} \title{Plotting Likert-type items} \usage{ gglikert( data, include = dplyr::everything(), weights = NULL, y = ".question", variable_labels = NULL, sort = c("none", "ascending", "descending"), sort_method = c("prop", "prop_lower", "mean", "median"), sort_prop_include_center = totals_include_center, factor_to_sort = ".question", exclude_fill_values = NULL, cutoff = NULL, data_fun = NULL, add_labels = TRUE, labels_size = 3.5, labels_color = "auto", labels_accuracy = 1, labels_hide_below = 0.05, add_totals = TRUE, totals_size = labels_size, totals_color = "black", totals_accuracy = labels_accuracy, totals_fontface = "bold", totals_include_center = FALSE, totals_hjust = 0.1, y_reverse = TRUE, y_label_wrap = 50, reverse_likert = FALSE, width = 0.9, facet_rows = NULL, facet_cols = NULL, facet_label_wrap = 50, symmetric = FALSE ) gglikert_data( data, include = dplyr::everything(), weights = NULL, variable_labels = NULL, sort = c("none", "ascending", "descending"), sort_method = c("prop", "prop_lower", "mean", "median"), sort_prop_include_center = TRUE, factor_to_sort = ".question", exclude_fill_values = NULL, cutoff = NULL, data_fun = NULL ) gglikert_stacked( data, include = dplyr::everything(), weights = NULL, y = ".question", variable_labels = NULL, sort = c("none", "ascending", "descending"), sort_method = c("prop", "prop_lower", "mean", "median"), sort_prop_include_center = FALSE, factor_to_sort = ".question", data_fun = NULL, add_labels = TRUE, labels_size = 3.5, labels_color = "auto", labels_accuracy = 1, labels_hide_below = 0.05, add_median_line = FALSE, y_reverse = TRUE, y_label_wrap = 50, reverse_fill = TRUE, width = 0.9 ) } \arguments{ \item{data}{a data frame} \item{include}{variables to include, accepts \link[dplyr:select]{tidy-select} syntax} \item{weights}{optional variable name of a weighting variable, accepts \link[dplyr:select]{tidy-select} syntax} \item{y}{name of the variable to be plotted on \code{y} axis (relevant when \code{.question} is mapped to "facets, see examples), accepts \link[dplyr:select]{tidy-select} syntax} \item{variable_labels}{a named list or a named vector of custom variable labels} \item{sort}{should the factor defined by \code{factor_to_sort} be sorted according to the answers (see \code{sort_method})? One of "none" (default), "ascending" or "descending"} \item{sort_method}{method used to sort the variables: \code{"prop"} sort according to the proportion of answers higher than the centered level, \code{"prop_lower"} according to the proportion lower than the centered level, \code{"mean"} considers answer as a score and sort according to the mean score, \code{"median"} used the median and the majority judgment rule for tie-breaking.} \item{sort_prop_include_center}{when sorting with \code{"prop"} and if the number of levels is uneven, should half of the central level be taken into account to compute the proportion?} \item{factor_to_sort}{name of the factor column to sort if \code{sort} is not equal to \code{"none"}; by default the list of questions passed to \code{include}; should be one factor column of the tibble returned by \code{gglikert_data()}; accepts \link[dplyr:select]{tidy-select} syntax} \item{exclude_fill_values}{Vector of values that should not be displayed (but still taken into account for computing proportions), see \code{\link[=position_likert]{position_likert()}}} \item{cutoff}{number of categories to be displayed negatively (i.e. on the left of the x axis or the bottom of the y axis), could be a decimal value: \code{2} to display negatively the two first categories, \code{2.5} to display negatively the two first categories and half of the third, \code{2.2} to display negatively the two first categories and a fifth of the third (see examples). By default (\code{NULL}), it will be equal to the number of categories divided by 2, i.e. it will be centered.} \item{data_fun}{for advanced usage, custom function to be applied to the generated dataset at the end of \code{gglikert_data()}} \item{add_labels}{should percentage labels be added to the plot?} \item{labels_size}{size of the percentage labels} \item{labels_color}{color of the percentage labels (\code{"auto"} to use \code{hex_bw()} to determine a font color based on background color)} \item{labels_accuracy}{accuracy of the percentages, see \code{\link[scales:label_percent]{scales::label_percent()}}} \item{labels_hide_below}{if provided, values below will be masked, see \code{\link[=label_percent_abs]{label_percent_abs()}}} \item{add_totals}{should the total proportions of negative and positive answers be added to plot? \strong{This option is not compatible with facets!}} \item{totals_size}{size of the total proportions} \item{totals_color}{color of the total proportions} \item{totals_accuracy}{accuracy of the total proportions, see \code{\link[scales:label_percent]{scales::label_percent()}}} \item{totals_fontface}{font face of the total proportions} \item{totals_include_center}{if the number of levels is uneven, should half of the center level be added to the total proportions?} \item{totals_hjust}{horizontal adjustment of totals labels on the x axis} \item{y_reverse}{should the y axis be reversed?} \item{y_label_wrap}{number of characters per line for y axis labels, see \code{\link[scales:label_wrap]{scales::label_wrap()}}} \item{reverse_likert}{if \code{TRUE}, will reverse the default stacking order, see \code{\link[=position_likert]{position_likert()}}} \item{width}{bar width, see \code{\link[ggplot2:geom_bar]{ggplot2::geom_bar()}}} \item{facet_rows, facet_cols}{A set of variables or expressions quoted by \code{\link[ggplot2:vars]{ggplot2::vars()}} and defining faceting groups on the rows or columns dimension (see examples)} \item{facet_label_wrap}{number of characters per line for facet labels, see \code{\link[ggplot2:labellers]{ggplot2::label_wrap_gen()}}} \item{symmetric}{should the x-axis be symmetric?} \item{add_median_line}{add a vertical line at 50\%?} \item{reverse_fill}{if \code{TRUE}, will reverse the default stacking order, see \code{\link[ggplot2:position_stack]{ggplot2::position_fill()}}} } \value{ A \code{ggplot2} plot or a \code{tibble}. } \description{ Combines several factor variables using the same list of ordered levels (e.g. Likert-type scales) into a unique data frame and generates a centered bar plot. } \details{ You could use \code{gglikert_data()} to just produce the dataset to be plotted. If variable labels have been defined (see \code{\link[labelled:var_label]{labelled::var_label()}}), they will be considered. You can also pass custom variables labels with the \code{variable_labels} argument. } \examples{ library(ggplot2) library(dplyr) likert_levels <- c( "Strongly disagree", "Disagree", "Neither agree nor disagree", "Agree", "Strongly agree" ) set.seed(42) df <- tibble( q1 = sample(likert_levels, 150, replace = TRUE), q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1), q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5), q5 = sample(c(likert_levels, NA), 150, replace = TRUE), q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0)) ) |> mutate(across(everything(), ~ factor(.x, levels = likert_levels))) gglikert(df) gglikert(df, include = q1:3) + scale_fill_likert(pal = scales::brewer_pal(palette = "PRGn")) gglikert(df, sort = "ascending") \donttest{ gglikert(df, sort = "ascending", sort_prop_include_center = TRUE) gglikert(df, sort = "ascending", sort_method = "mean") gglikert(df, reverse_likert = TRUE) gglikert(df, add_totals = FALSE, add_labels = FALSE) gglikert( df, totals_include_center = TRUE, totals_hjust = .25, totals_size = 4.5, totals_fontface = "italic", totals_accuracy = .01, labels_accuracy = 1, labels_size = 2.5, labels_hide_below = .25 ) gglikert(df, exclude_fill_values = "Neither agree nor disagree") if (require("labelled")) { df |> set_variable_labels( q1 = "First question", q2 = "Second question" ) |> gglikert( variable_labels = c( q4 = "a custom label", q6 = "a very very very very very very very very very very long label" ), y_label_wrap = 25 ) } # Facets df_group <- df df_group$group <- sample(c("A", "B"), 150, replace = TRUE) gglikert(df_group, q1:q6, facet_rows = vars(group)) gglikert(df_group, q1:q6, facet_cols = vars(group)) gglikert(df_group, q1:q6, y = "group", facet_rows = vars(.question)) # Custom function to be applied on data f <- function(d) { d$.question <- forcats::fct_relevel(d$.question, "q5", "q2") d } gglikert(df, include = q1:q6, data_fun = f) # Custom center gglikert(df, cutoff = 2) gglikert(df, cutoff = 1) gglikert(df, cutoff = 1, symmetric = TRUE) } gglikert_stacked(df, q1:q6) gglikert_stacked(df, q1:q6, add_median_line = TRUE, sort = "asc") \donttest{ gglikert_stacked(df_group, q1:q6, y = "group", add_median_line = TRUE) + facet_grid(rows = vars(.question)) } } \seealso{ \code{vignette("gglikert")}, \code{\link[=position_likert]{position_likert()}}, \code{\link[=stat_prop]{stat_prop()}} } ggstats/man/weighted.sum.Rd0000644000176200001440000000076314674033502015405 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/weighted_sum.R \name{weighted.sum} \alias{weighted.sum} \title{Weighted Sum} \usage{ weighted.sum(x, w, na.rm = TRUE) } \arguments{ \item{x}{a numeric vector of values} \item{w}{a numeric vector of weights} \item{na.rm}{a logical indicating whether to ignore \code{NA} values} } \value{ A numeric vector. } \description{ Weighted Sum } \examples{ x <- 1:20 w <- runif(20) weighted.sum(x, w) } ggstats/man/round_any.Rd0000644000176200001440000000111314600506645014770 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/round_any.R \name{round_any} \alias{round_any} \title{Round to multiple of any number.} \source{ adapted from \code{plyr} } \usage{ round_any(x, accuracy, f = round) } \arguments{ \item{x}{numeric or date-time (POSIXct) vector to round} \item{accuracy}{number to round to; for POSIXct objects, a number of seconds} \item{f}{rounding function: \code{\link{floor}}, \code{\link{ceiling}} or \code{\link{round}}} } \description{ Round to multiple of any number. } \examples{ round_any(1.865, accuracy = .25) } ggstats/man/signif_stars.Rd0000644000176200001440000000165114357760261015501 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/signif_stars.R \name{signif_stars} \alias{signif_stars} \title{Significance Stars} \usage{ signif_stars(x, three = 0.001, two = 0.01, one = 0.05, point = 0.1) } \arguments{ \item{x}{numeric values that will be compared to the \code{point}, \code{one}, \code{two}, and \code{three} values} \item{three}{threshold below which to display three stars} \item{two}{threshold below which to display two stars} \item{one}{threshold below which to display one star} \item{point}{threshold below which to display one point (\code{NULL} to deactivate)} } \value{ Character vector containing the appropriate number of stars for each \code{x} value. } \description{ Calculate significance stars } \examples{ x <- c(0.5, 0.1, 0.05, 0.01, 0.001) signif_stars(x) signif_stars(x, one = .15, point = NULL) } \author{ Joseph Larmarange } ggstats/man/pal_extender.Rd0000644000176200001440000000345314625277577015475 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pal_extender.R \name{pal_extender} \alias{pal_extender} \alias{scale_fill_extended} \alias{scale_colour_extended} \title{Extend a discrete colour palette} \usage{ pal_extender(pal = scales::brewer_pal(palette = "BrBG")) scale_fill_extended( name = waiver(), ..., pal = scales::brewer_pal(palette = "BrBG"), aesthetics = "fill" ) scale_colour_extended( name = waiver(), ..., pal = scales::brewer_pal(palette = "BrBG"), aesthetics = "colour" ) } \arguments{ \item{pal}{A palette function, such as returned by \link[scales:pal_brewer]{scales::brewer_pal}, taking a number of colours as entry and returning a list of colours.} \item{name}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be omitted.} \item{...}{Other arguments passed on to \code{discrete_scale()} to control name, limits, breaks, labels and so forth.} \item{aesthetics}{Character string or vector of character strings listing the name(s) of the aesthetic(s) that this scale works with. This can be useful, for example, to apply colour settings to the colour and fill aesthetics at the same time, via \code{aesthetics = c("colour", "fill")}.} } \value{ A palette function. } \description{ If the palette returns less colours than requested, the list of colours will be expanded using \code{\link[scales:pal_gradient_n]{scales::pal_gradient_n()}}. To be used with a sequential or diverging palette. Not relevant for qualitative palettes. } \examples{ pal <- scales::pal_brewer(palette = "PiYG") scales::show_col(pal(16)) scales::show_col(pal_extender(pal)(16)) } ggstats/man/symmetric_limits.Rd0000644000176200001440000000216214657111214016370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/symmetric_limits.R \name{symmetric_limits} \alias{symmetric_limits} \title{Symmetric limits} \source{ Adapted from the homonym function in \code{{ggpmisc}} } \usage{ symmetric_limits(x) } \arguments{ \item{x}{a vector of numeric values, possibly a range, from which to compute enclosing range} } \value{ A numeric vector of length two with the new limits, which are always such that the absolute value of upper and lower limits is the same. } \description{ Expand scale limits to make them symmetric around zero. Can be passed as argument to parameter \code{limits} of continuous scales from packages \code{{ggplot2}} or \code{{scales}}. Can be also used to obtain an enclosing symmetric range for numeric vectors. } \examples{ library(ggplot2) ggplot(iris) + aes(x = Sepal.Length - 5, y = Sepal.Width - 3, colour = Species) + geom_vline(xintercept = 0) + geom_hline(yintercept = 0) + geom_point() last_plot() + scale_x_continuous(limits = symmetric_limits) + scale_y_continuous(limits = symmetric_limits) } ggstats/man/stat_weighted_mean.Rd0000644000176200001440000001546314625277577016662 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat_weighted_mean.R \docType{data} \name{stat_weighted_mean} \alias{stat_weighted_mean} \alias{StatWeightedMean} \title{Compute weighted y mean} \usage{ stat_weighted_mean( mapping = NULL, data = NULL, geom = "point", position = "identity", ..., na.rm = FALSE, orientation = NA, show.legend = NA, inherit.aes = TRUE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{Override the default connection with \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}}.} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{orientation}{The orientation of the layer. The default (\code{NA}) automatically determines the orientation from the aesthetic mapping. In the rare event that this fails it can be given explicitly by setting \code{orientation} to either \code{"x"} or \code{"y"}. See the \emph{Orientation} section for more detail.} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} } \value{ A \code{ggplot2} plot with the added statistic. } \description{ This statistic will compute the mean of \strong{y} aesthetic for each unique value of \strong{x}, taking into account \strong{weight} aesthetic if provided. } \section{Computed variables}{ \describe{ \item{y}{weighted y (numerator / denominator)} \item{numerator}{numerator} \item{denominator}{denominator} } } \examples{ \dontshow{if (requireNamespace("reshape")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} \dontshow{\}) # examplesIf} library(ggplot2) data(tips, package = "reshape") ggplot(tips) + aes(x = day, y = total_bill) + geom_point() ggplot(tips) + aes(x = day, y = total_bill) + stat_weighted_mean() \donttest{ ggplot(tips) + aes(x = day, y = total_bill, group = 1) + stat_weighted_mean(geom = "line") ggplot(tips) + aes(x = day, y = total_bill, colour = sex, group = sex) + stat_weighted_mean(geom = "line") ggplot(tips) + aes(x = day, y = total_bill, fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") # computing a proportion on the fly if (requireNamespace("scales")) { ggplot(tips) + aes(x = day, y = as.integer(smoker == "Yes"), fill = sex) + stat_weighted_mean(geom = "bar", position = "dodge") + scale_y_continuous(labels = scales::percent) } } library(ggplot2) # taking into account some weights if (requireNamespace("scales")) { d <- as.data.frame(Titanic) ggplot(d) + aes( x = Class, y = as.integer(Survived == "Yes"), weight = Freq, fill = Sex ) + geom_bar(stat = "weighted_mean", position = "dodge") + scale_y_continuous(labels = scales::percent) + labs(y = "Survived") } } \seealso{ \code{vignette("stat_weighted_mean")} } \keyword{datasets} ggstats/man/figures/0000755000176200001440000000000014674033502014151 5ustar liggesusersggstats/man/figures/README-unnamed-chunk-4-1.png0000644000176200001440000001500214674034122020643 0ustar liggesusersPNG  IHDRMR/MPLTE:f:::f:fff}::::f:::::::f:::ff:f:f::MMMMMnMMMnMnMff:fff:f::ffff:ffffnMMnMnnMnnnnMMMnMnMn::::fff:ff:fېnMnnnnȫff::ffې۶ȎMې:ېf۶f۶ېnkvmfȎې۶Cj" pHYsod[IDATxWG[nAvf3DXIXd!bφceA.ow땄ѥ~hPDg9{]ʠ#P2AG oVdTt%W1m$Aʀ@%!PJ(B: (J ,ՍS='f}xNjټ#"5>ж)xz^_5IYr<k6KooT fJ̕hwb>lSyn`tl#,B9cTW,:0a>7 P?@{fhr[rz ecת@x ׬:q\;ھqqTک:hifGEj\~_kx~hw^hZkNVLUy7"ND'USZ%(IdO߽|+.xLgfkNf%!PJ(B: (J ,(X#P eQx2 #P e@TGʀ@BԫWF'P$У:{x`|Tk]|y}r,:tt_F<@u@Skv#:Nz|5RZ7W;;A1;_? fNtNH<^KsҺǧwNkF 1RݭNڇt@ٓx =]Y[?'m|G:p3MSbt Izz ^kPA?| *@Kεk%@IC*>x8rv >xGp>a3Q"P"P{י>69Y(@r< f P e@TGʀ@BE:@u TBYE9* TB2 #PPD`@"PE:P(@QJ(B:P@u* ,((X#PTG`@%E PAʀ@%!PJ(B"eEJF@@Y#P2AG :ehLQ-_s"PiCr<TB2 #P e@TG`E@"Pݸ@;UcLu'f}`ϋ#v."-R]y}y]DEjBrk'ҟΐowN55<3hg,EERIgҟryNLmZYޓ jwoRK+8"15hОs}{EzbVufm;V'@]w|"",B9_wݭǻM7M Τc#}mE (J5 ̠rp JEA8F/}`G tTǿ$E:P(@QJ(B:P@u* ,((X#PTG`@%E PAʀ@%!PJ(B:]`O\(zQz1Y[=[q~;g O%t k,t݈,Ku7 h`QD Բn}Un|m^ 3zNxT|ǜAMaAu@4l%|(x@__΍rנn@BA4t!Wu.<t}iBW>[=Z-o͸_DKs>"P,P n"% eQx:"Aʀ@%!P%@u ,(@r<TB2 #P e@TG`E@"PE:@u*, PP@u* TB(X(@Q"PTG`@"PJ((ǃ@%!PJ(B:P@uEʊj"F :e(@tʠ+мa&Z$S/i4 P@u* TB(X(@Q"PTG`n\1rяyq?:1ٽ)#"5>Еx2^lqE(cRmމYN;k ~o1v;Z^s->"1!Ps%y%)lZjes@xLt ZqE_q{^ P؉juh gPm]n^7(Ei C33(JTMi' ک5(N&fXG7`7Fv^WoOD:%IBYE9* TB2 #PPD`@"PE:P(@QJ(B:P@u* ,((X)@'n߾=dq Thc`Gwzܿ8{xE_9X~,CfTt݈m%;Nkw~I}Ot`Qpr4~#n}Uo}n2xw{}Y}{}0@/ݩMGΫl@[?n_ph28m6;a=]=V#LxΠYD%D8 :l@נ(|54@'m*YD:IC*~##trIGǫxWx/F:W&p9eP(@QP+lW%P@u@@@x2 #PPD`@"PE:P(@QJ(B:P@u* ,((X#PTG`@%E PAʀ@%!PJ(B: (J ,(X#P eQx2 #P e@TGʀ@YQ-PVAG :e(@tʠ+м߸c&Z$N_4 P@u* TB(X(@Q"PTG`nlgƼ8~ԩb26UZkV~}Sj0MIYr<jJzMc*S :kfϠۗgE(c\m<;o^A+?7桽7u7<hqZaԊOvk7P=fx.=jok %(Mz 8&"͠(nU"SիGEjAÿj46Cx^)%IBYE9* TB2 #PPD`@"PE:P(@QJ(B:P@u* ,((X [z(=ݬoɷZv _>9@Mؼ 7Ln(̤Ftto+ޱp;Ⳇ&"Բn}UnA%.}#_H oh( C\=>{pZs5ܔ}0ʖ|'z{xN-P_4\@9X@FϏQt-&Q_~3 h1 fPg(_р{ r<(ˮAó Pk{~& ]lo$#[Li]AuX@*}xy͙CQ3Q_t`@9>ZfS/I(( hhP@u* ,((X#PTG`@%E PAʀ@%!PJ(B: (J ,(X#P eQx2 #P e@TGʀ@BE:@u TBYE9* TB2 +"PVdT 1e(@tʠ#P]4"ԧyT%W1m(@QJ(B:P@u* ,((XY71Em>Ny4DEjrʡ＾b=@9v'-RT^+=5)T5QǙ=1+gvRR|Z; }Z2_iP(@QD@+?7aV[K vugnwKzyOpw;ƜBMt1w+d}s]ެ[vv]hnW,!Pt@;եǻ@Wv֖OP3*O˻s%,B9u)~[ȟ Ϡּ.AH*TS5 t~T4d譪j=@{ͰWnfwOxjw Wt=#P]NI盡Z6KZsM(ǃP@u* TB(X(@Q"PTG`@"PJ((ǃ@%!PJ(B:P@u  P,8/_?hc`Gwzܿ\˃9X~]Ȑ -?52.ѽtGtz|56fQwڝxGwNҭ>;|7e4!  @݃pwSVͣݭwc."c׷i,S=GJv}t3}l]>\h5*ggP9_~ ?ޟ (J(@%Uk{}F# %W>[۞nT_θG h΁!ycv̦:_"i4DYr<TB2 #PPD`@"PE:P(@QJ(B:P@u* ,((X#PTG`@%E PAʀ@%!PJ(B: (J ,(X#P eQx2 #P e@TGʀ@YQ-BYuTBC{7(Î@tʠ#P24|SwGþ'Zn<܇sh3ҏ9ao*vӁB&= Iιp4|/}7~N%Ctf70$0נG#rc aHҏv=|(Đ}PQU<(@tʠ#P2AG׍t0WO 5fo=[-8^jo?J:@Fm-oi׿eR+7E\n~s@KA9T~~S|'LE@SjuZh3>\Τ5OoxocgNCعkes^KAERmT}/p(x1wyY5lj*??3¿!J :e(@tʠ#P2AG :e(@tʠ#P2AG :e(@tʠ#P2AG :e(@tʠ#P#Sԁ,$7nyW_ 1fg "61^s=j/oÓc>!P.Nu{V_GϜ>I=!R.ZlNf?Fh[_g:c?!R.d3;N*'ي'% 3O.נLLf:ih{.G_z1(]`U3]zd t}5'@ڨy}ٟpGk$nw.t~q'ͽ?|pƅ7+Lm9zޱ%ͽJ=96X h -:8L o~8> O>6X`#+~;*k8Omm"h5haDP3 eJࠂ5hxY]Mӑ/{dx>!s$<-/?ŏkԲyA~eA_}a&)ksA(#H[9I_QxifB(WFOwi[Т(  :f΀Y 34IQ.*\UAsT$9APT*rT$y.*\UAsT$9APT*rT$y.*\UAsT@Ny߽咠)AiAiAi\TZQwoe9%U5{TVz vAJQuo#*EPT <AI MЯ{W{_v᱌sAP9_n- M گ)Խ S!9}z09fFa ?mѾ J"hx7:{^j`hڏ j6oNCU"hJPvYφ]Q.֠m^h A}!8Agj*QjFEA tY.<>ٝQA} נR4%YhuvL^9e 3m:#JAPT*@$EPT <A@Py.*@$A@P9APT*pMgoIrM= ԓ矟ih hn6\PTA/9P0xa4#.<?S[,~%(A #}?o|k֕o=;)yG_6f^9^Y*=e : r j!4>iIC|PٙPP遱]寠]}a4]KIO6.LJj˅4-衯A N ts)>GRРo>m=Pӑ?8n4I+ur틟b${HJ:Z9mO[W_=wR`7c* 6o;>VS4}RܳHJ:4t *?-hQ"|@L4 uAaIrT"*EPT $APT*rT $sT"*EPT $APT*rT $sT"*EPT rM,H4 N4 N4 N㒠7֊{/)A ^ A[ z-zGPT <A@Py.*@$A@P9_<Ҳ~1{.0APgXZНpڲr4HЎx?UN;um껦-s=/- (ADoXPS3F葝NկWkZ .- r4AZ󬋑G4brpW_>K|ʷ5gB#G>3[Тy-~'?| G_#njgO߼8мS +~2+C+ NVŕX\AAb|s%D_??4Wf2~!,w)>>i¨DB[ hEA A͌/!z뷮9{mނ{)te$MLrAL"?xcA(}Љ6G.&iR2+!j(4'OfL/1,h LsC,J/*샰ނ?,+-4 uAA@PgXoAi\UAsT"4IrT UA 4I\UAsT"4IrT UA 4I\UAsT"/{/%AR (8 (8 (8 Ӹ$ rJP~B練#CP((AT"*EPT $APT&y{OJkzCx#'vF6fa& t[NC<49Θ0u9V91lz;uro/nvh4[FśꕺTǪ΂K˂&)EVjGoo[ zO}Wg6t;`wk?(o7t .- r4A ,⇯FG^.~S>|YL_'kwbò)a (8 (8 (8 hg<վ hHPۙs{j hneU%tT M jF̗^qg|]ҾMA}os}(/־n ^~ۯoOၠ )BꅦVZ `f|=\4A$u2 5e?d4A$hT~}pcjۦwY6 ^FMRk՟Fn`$藺f?W{yn2 N4 N4 N4 N4 N4 N4 N4 N4 N4 N4 N4 N4 N4 N4 N4!Q7+F蟸-"]`wQ'7x>Ņ*mߵ<6Sf8DA Ah6OPX+AiAiAiAiAiAiAiAiAiAiAiAi=H'@)IENDB`ggstats/man/figures/README-unnamed-chunk-7-1.png0000644000176200001440000001232714674034125020660 0ustar liggesusersPNG  IHDRMR/PLTE:f:f:f333::::f:f:f:MMMMMnMMMnMnMff:fff:f::ff:fffffffnMMnMnnMnnnnnnMMMnMnMM::::fff۶nMnnnMȫff:fffې۶ȎMې:ېfnvmfȎېHoW pHYsoduIDATx흍V@[R3>Ru$b`,%.'Id]s~mҠJlɽ  @(tNCi"PUSE(%@QG/)%:zI)!PKJ ^RJuR‰z4lAQG/)%:zI)!PKJ ^RJuRBE(%@QG/)%:zI)!ФPhOE)Rh,@BhR4M BI!X4) &@c!Фh,@BhR4M BI!X4) &@c!Фh,@BX T@ 4zI)!P^RJ@%%@ 4zI)!P^RJ@%%@ 4zI)!P^RJN_{Yv~H%Z(<:N/>@ @\.ߞdW''7C("4ߊN_(6Y0'72 +QVJ0Ы7"PMnA/wJ Tw%iO t"?z *8 4@}6G5i߱yPQm@M{&Iw% զn ơMjS7@] @Bq讄@SAM!8tWB Pmh+!T6uS4ݕh*T)J4MCw% զ\%@WxI;%z Pmj^NTZpSզ\%@WxI;%z Pmj^NTZpSզ\%@WxI;%z Pmj^NTZpSզ\%@WxI;%z Pmj^NTZpSզ\%@WxI;%z Pmj^NTZpSզ\%!2p}-/"q%Q p ؂jS vJ@Ԃ+=6 /iDM-K)jS vJ@Ԃ+=6 /iDM-K)jS vJ@Ԃ+=6 /iDM-K)jS vJ@k Tͨl Tͨl Tͨl ԲZ:Ћm ԲZ:l{}}EJ-h z[/'Pj@GЗexVBҁ^ _y zZ<Џ@QRKZt <EZ-p8Dҁ^ IW Tͨln_>#4rBO%e|e5MxQRvjZ-h+?sJtfBZ݁@9&EZ-l{ret[و^\W'Yv!PzVnoSjYݱ@=&߂^}u9X]n/6s6'nxT% thi+ԲZt ZTd q8@-Eu]E%KiNnlAv>dW_s uGuA^et]<$^t~M&P5w!Pj@weCҁ.Aҁ u@-hr9jY-"QI6GeS-h Բ@ՌʦZ<&AmʦZ:v~ q7 >%Pj@G' ԲZ:Ћ5RjYMjFeS-h6vx^ڣtХjY-h%jYF;{}+ um:V\"_31$7hqer6|s:)6n:,~w@uH@G\-ً.(ţ =\>;CGeuS[sn:rs떽fM!ţ7| hqbwy;7#P-a)PǠwLk7hwug~ayz@Ck Tͨl Tͨl TͨlB77Q@] jYl'PԢO_dn$:N(7|KJբO_.?9?zswjAuv\g;@lA-;%Pj@oהǠ7)F׏\\Wo8Gv}v'kz$΃TO~uڽ|>|qTw!P0Ǘ՗|^+o:K缗{Lk\< _f jYVb2|1n^/ɽg2cEX^e(5m &P5 LlAՌʦ:/1nA梸ţ^t=\̹jAN_-mEقZVwr Zp8@- Tͨl;·kN3h<yf7 PjU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*jU3*j%B--(j[P&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5&P5fԲ^eeu'|{M_eu']~raN`@v:V{j:$oulaʦ$oc?:$oR(M(OENn[}OENn5۬LRrsBVNuRBE(%@QG/)%:zI)!PKJ ^RJuRBE(%$2!xjE(NC; 4bԁ@(tNCi:}ySI]oqut_iWfTju]e5龏[?bN鳿']sfmZB~SO.W\/Ӿ:oĊFA%/ċB^)ys>? bZIg}.& t!^'߫l/i_慾s,幘@`(г}1KA-CӋc,==}&^-NGǠ>ݻ:Lv0$[@$4 @(tNCi.߂E.*օ@E :\ z=Vwe`;`ymLgCoZbPϟO` /(r;{4h ^ 8-hç@kP_&.Il7@5lIG/ٸ> ZiQP{4h#8O6b-X@p-A : B!P4 @(tN?&8@ȟIENDB`ggstats/man/figures/README-unnamed-chunk-10-1.png0000644000176200001440000002577314674034127020745 0ustar liggesusersPNG  IHDRMR/PLTE,28:Mbf,F.m8:::f:MYRbffq,M.mRMss22222,F2M22mY2mk33,38888b888bb88::::f::::f:::f:f:q::H.H.,HMMMMMnMMMnMMMYYY}\R\bb8bff:fff:f::f:ff:ffff:ffffqffffnMMnMnnMnnnnns,nnn~,~,~}Mm͊ͦ888MMMnMnMn::::fff:q۶Mm}aaHaq~nMnnnMȫbaqݶff::qfې۶ҶmY}aȎMҊ8ү~ې:ېf۶fċېߋ2ߧFYk}nHqκbҊfȎqأې۶0 pHYsod IDATxݏTej45@#d\{wV^V] hbZ4neA 0ڒm%pF v\aQn TS01g}33'39?5 |s2;<_/ 11' nP$P$P$P$P$q*L[ #9xjTcX@#.S w8F\p(N5qQj48phEqЈT>viptxM2dXi/ sP9Vڋ(+E@u :J{QPc(α^@TXi/ sP9Vڋ(+E@u :J{QPc(α^@TXi/ sP9Vڋ(+E@u :J{QPc(α^@TXi/Q+A1h8.v|"ɮn!>յW=]h287coԭ-ђ_;@7\\c\.\c;.7EժDb|Uvqկ<rzJ$A@nj\G`hu_vQgl/x#;p_H{8t~k=?x]~`x[sel7}iɌ^GȼRn/k&7޼.A&5?濶ʼnսن֚ʄ~cMWu)ju~⌍=I:u=ဲ7Tu~6n~,G}~DjKnT b^F$uH.|=|rJWQTH;etg}\*yVGy ^.ɥR >+*zą]iF۠S5.|~m^Kgd4~DcCz2/٬^Σ }qBw޴UQ@ =qZG3V~I頴H<˥߅Ʊ7y/uXUsxxۍ'X' 4?3gbdPt4z30I@_`&Xb -A}Plhu0좾tPԥ.j}+t==%QMAꠧ9:/㱃2sUM ~$L&bA䳺2!U=B 5kH0}CI^V*[g96y}hηL 2}El4:kZ~V4 u"!_mRYdؓhJ{QPc(g9Vڋ(+E@u :J{QPc(α^@TXi/ sP9Vڋ(+E@u :J{QPc(α^@TXi/ sP9Vڋ(+E@u :J{QPcL:UUq1, ũ;@#.S w8F\p(N5qQjçDA%w|gs(tt:^*vE@c ֱ]QPXŮ(ubW@:V+ jPU(Z*vE@c ֱ]QPXŮ(ubW@:V+ jPU(Z*vE@c ֱ]QPXŮ(ubW@:V+ jPU{ΨzD FU_IsmPT_|OW^!Nҋ߿)c5fpzqv@Oݺ;5K6g2 |kWЗk >\#w@NbĂW>IA7BN@iK>:jS՝نtTukVe9_0P;p_w]{vnrɠ>==~_з9_?DN5{izvgN}sfݧN t{LhEMzno/臯PtR-ٺj]BSu|@K#R4*zaZ1LNt<c4t%Is0 3hsP |9uK~:AR9^"9htCq$dwT- z~Ei'c:-O( ubW@:V+ jPU(Z*vE@c ֱ]QPXŮ(ubW@:V+ jPU(Z*vE@c ֱ]QPXŮ(ubW@:V+ j $TV*F\p(N5qQj48phEqЈTFmwB= {S=C@T{@ 0P=  hP}@4LT(jh>&*@@|@P  ZO( PP-'P@@(( aӦ*٧ܾN~+6o0;~q0;.@Oݺ9l-w|m7&4.]L1drõ+Z'ğW;%B& _sIϴͅ?=$F~XO!GGDS|A@5GOdV=~Ŋۏ߿~ۚ:.۝ߜ~pWZ|v ^l'cKۯX\^g ~K:i3u_,N hf0U)U*:tӽz#Ϥ֪F @T}:qU N~6O,}|\.Jb_zu667B@/\+FIJ;0E@agп?`^uj@ @tQ@}]s:+A4Ѐ@|:hz2Z3Fij3SaA ,Z @37~j47P9zᚋddr꫁`O@~Y4puzبbc5NB@?.ҩuK ד@}v`6-,H\*yJ9d˨\*4Mr].PsˆɥnFm1r-q"A)Lާ)e恎ռ-z6cCzu#yt/%sQs%\`xסK<' Bert\灦ǪhM@h6'X' S_$ыMwNk@W^\T&@ h;[C2Gc95feTMAeAGewPēNuߘ'j oKDAs|uSPB>huSHJ^m,7`org*[9(-ƛF]#Ҳ)Ai]$Iyc2UXQ1z /@@|@P  ZO( PP-'P@@(( a@T{@ 0P=  hP}@4L48phEqЈTũ;@#.S w8F\p-+&wӴmPmP}@4LP]P-'P@@P}@4LP]P-'P@@P}@4LP]P-'P@@P}@4LP]P-'P@$(TucaTuzD:@]7;.@Oݺb\96@ 㢥;KW$k >pȀ 񧭉ĂA!XX"D/x. bS3 ;Sg 4]I/5GOd=~ /8sx^G+-:o/MsWK.7ݚjU:b׷OTugeB@GV5\+)jtK:yC7pzظ%LI~6O,}|\.2&w$Wźf$ʄʀNC?@j]B=͡ }aBwތSp@Ih\ud@yZԝ'Ηx2Nȡ4qNǒƱ7fON2 ڞyuXC5Ib]:@i6J:ͷB6u"TH:PCߘ:4gceS 4-&tLdo1Ѥ;hv. ٭yPvqEoTNsPvzu;eߡxܨ|sPZFQ}sP1I @ Y5@}ģ TW"NXu'P@@P}@4LP]P-'P@@P}@4LP]P-'P@@P}@4LP]P-'P@@P}eũư(F\p(N5qQj48phEq@KoUFM:nE3V < " a jO( (j>& 9  h((( a jO( (j>& 9 X3f ]i\+1hRo_/B4w yxqp|q큁0Z[wg2  ׮/WK&Fg M$~Q|*X"_,xU:h75隣}E}/L&{/cY#:~x}o]~`x[sz%e3Re yQWKur}s몃4P{?[TuP<.uB:sz֊u'T εbdY1mjMUJQcUдt 9?.9-o^_~`򿕳Ozjn@_0uknsЍ7S/sP tMr@x+Ar%T tCb♞?.Zt1[*>'>/DlÑ\nTCB0/$֠@_&D]Gu?H;etg}\*yVGy ^.ɥR >nzؕP)}TMӌx7j]B=Exu}MYzR]SQ~=4.>yd::.x7}zHVu:>r+[BT>wJKxN-BXVMS f+Pƒz i.5g虧X' Tm7:MrL$E7X5@wBerH6&fA˼{vA}OIFxIuhpzy&yA.h_][%Qf 4z'}lh$E…*#MMzJ7wOWG|;TQsm,os3YT΀sPvzu5]-?^ZɋB+MeQPn _Kx~;8q=%:@h( (j>& 9  h((( a jO( (j>& 9  hDQUũư(F\p(N5qQj48phEqЈT>s7yNٽQof4P?V(+E@Ƣ JcQPc(X@TXi, 4P?V(+E@Ƣ JcQPc(X@TXi, 4P?V(+E@Ƣ JcQPc(X@TXi, 4uzagӲ}yW"mpWV="rm_1APu J]^!Nvu5K66 %9u(EKMwH&F}2J޸rzp&SHvf:5G|0K6/p=]o Sߜl9+2o/MsWK.sڀrt!Tt{wL<{|kX&mFHqT `%$N~|'rbinu㶁(r%=oP j3dIDAT"]B腝kȲ*ZkC~oA_07l~b_ԕS>teBc?B@uN%<ڤ'Z7Tkn/,yz|mށn"=iTJK.J zxCN'3)Nn>A?;]9haaDRR)b|Z6glK%@<Mr].bT1 gBtVe͕yw m[tsнg\`x@sPtFdZ5_(2/™P"頜*/dYZƱ7bߩ/uuT=4ߊHb&ָm6a'Bv{uJ)јK*^5g!q|yIgu&ߘ-&tLL&!6 !k{>~6sPZ42v*栴,⹧Qm49(-ƛF]g4OHݨw!h tP 4d+Ew4P?V(+E@Ƣ JcQPc(X@TXi, 4P?V(+E@Ƣ JcQPc(X@TXi, 4P?V(+E@Ƣ Jcљ48ЈTũ;@#.S w8F\p(N5qQj48phEqA-0%UpZQ%3 (M """" :Mw$Aza>+̐) zP~l!уkŧ?rL9ϙ]߿Oч8|+!9c>PS7'鑿#qU73Cs|z'=_~?ݴv!3Ѕ;taZfI#$*3qA? @s?\;% AgT_g'1x8yH f ƌTJ@姯Q%{rZ?T TJdRxUqsp=NfDU+ 0?%S"qYHfqOc;jP;[(Y*A'Z>3 T&%b $_3wJdOߡƯ^E)%/ht=+rbNbnsY"PiudaS)~Fa>wSʫx3wJ@d/H){_ȃky>yOW7бlG@s?^U|[V>*Vqwp~NlZ<l_-T@b{ҟ4K7f׭ T- ?Vs ;4Op X*WgRuⶰ^ ߥܿSAs͚RkִoX|907f܁ZHWGLOޓVOrs1' T}dRK;eZ&)`qn uHX n`ʁL]+tH@Z* h*:no:suM9jP(Lmuuuuuuuuuuuuuuu?;Dk{BIENDB`ggstats/man/figures/lifecycle-questioning.svg0000644000176200001440000000171414357760261021206 0ustar liggesuserslifecyclelifecyclequestioningquestioning ggstats/man/figures/lifecycle-stable.svg0000644000176200001440000000167414357760261020120 0ustar liggesuserslifecyclelifecyclestablestable ggstats/man/figures/README-unnamed-chunk-5-1.png0000644000176200001440000001540714674034124020657 0ustar liggesusersPNG  IHDRMR/>PLTE:f:::f:fff8::::f:::::::f:::ff:f:f::MMMMMnMMMnMaff:fff:f::f:fffff:ffffnMMnMnnMnnnMMMnM::::fff:ff:fېېnMȫff::ffې۶ȎMې:ېf۶f۶ې۶ndvmfȎې۶+e{ pHYsodoIDATx q4YJP"65SMiöi2([zvLInE'@5b yYb??LX j:\@P  DAh ( @4@P  DAh ( @4)BiFѢ|˴{>DuF_Du>:pz4.}lуB;UAG[Oo|k4u&L3r9lߏh NYЅN~KAzӤ s՛7A>2"vA$/ Fo&:|ñRt 6q5ݟN΃?1,o%/IIG_ߎ}W?\?s]!tEXaeL2{I29q yH`#dv&y`_)=ʺ3?/&Ҿʾ؆\6*4/SeN_:A0W,̼f6Y薠Hv88Oׂ`gwUdP|gK*huzue~MOΎ!hܾ{[Fd- l&i#Sn'E/!4Mzu͝7!(QK"IҬ FF ̜*rt6\P ԅ-ҪՋe\Q3S+m ڟ;7֠:f_>{T y-BzmnaI^tT;kмBrh _Yu?쿰1۹gv rm@P  D#^']MGQJ|A+~7#ឳ?x\a#-B(!h J@Pv"%u.A=̥'NA= OTz84h6عqfa?r A/LٻQw <$rf;/Yh?Gw=Q.!P4~v~{7}J諒o&A筩@K"iI~&_p#%uHո?/>5[ :RP9?\$41VP@'h^*g'tP4s1R$}C (qrڿt&a!hsgJd (qr._?$}Ss]ӗr A]n&. J@Pv"ZϣIbA A{!_"T9|[[ɂn*XK9MAI:Pv5I5@t3rMA* dAs A-.PA g^ůC$6r&A9:('NDo\P5fjD (Aى(EM&r A|@@P> h"TzMv5I"s A]@PDK]z&@ND@P> h (4 *r=&E$. J@Pv"%uqF@t6E(@P  DAh (xAQBm::PR m_U#ឳ?q**"Ԉ A:e'\BP\zԓ8IAA+h(:jtiϫ;ODOp+h=&E&MA6ՅE:t}47Gir\ocR7Ɋc&j&ٴ{PL zܽca>L %֠>s+]"]|93#68AkA 5T}`OJ6՛MqMZ9]~^zAt5~pOc$zA 5.FGu{=5a6x%"M<$YDd.! r A]KPO$hعn.b % (;)% (;WRUmC]10 h"tcŽO,h&):Z?u ejAw~V KꢽV.稠eZy4I8}Au@~ e'<$jD (Aى(EM&r A|@@P> h"TzMv5I"s A]@PDK]z&@ND@P> h (4 *r=&E$. J@Pv"%uqF@t6E(@P  DAh (xAQBm::PR ZI ɥC ibDIAA@PQ.!v g.=q IH݂zrBÁ|@4MRٜv/Ǽ-Ԉ/-"%eg>ASPUDG"PT:S u{΃,{XK]AD9ED. RP]3ZքS9LҤzo1p "%uLP$h\=ק$=6F]^r A]ƾY) &-AqMqMReMTPO (qrSoBfXV45(=JxAu]|>]}s/?lA$r=&EnK:e'\BP4I$v"%eqFI~924YR7,[}7t# q*%@МjA *M=Iڎ,$m zFE dVf^bC-4n3ɑuy\G~4*hm8+K4#4 eA9uPv"~H䂊7hW$2uA ND.%'h4IDKA"h\IK:e'\BP4I$v"%eAA\Py4I.$%uA@PQ.!4 (@I/(h7@P  DAh Վ:DjQԁ*_or^ +TQFTz% (;hx-'I*= @mAWOzq,M6/H#c2RWո|IgBOl2VzM@MRߋDuJNM:,=WIQAr A]tF35ɦ [A\'/҈r A]TKi7VΤ8F]i w(E OwO# $4S|JKVMKk^ JԿ:;tVН.^}Ϙr A7I"h\f. J@Pv"%u.A=ADIb'\BPF'͛79]ࡲ &ږ nZ8&ہY#&*USny?Am|BmI]Mo.o jゖBC[J@Pv 8Ly4I9]|h!(NDo\P5fjD (Aى(EM&r A|@@P> h"TzMv5I"s A]@PDK]z&@ND@P> h (4 *r=&E$. J@Pv"%uqF@t6E(@P  DAh (xAQBm::PR ZI ɥC ibDIAA@PQ.!v g.=q IH݂zrBÁ|@tF'3>βl#7fz8eA|r8C>2$(\ϱ:n#r=&E&I˕&;Vc/ygr0=WV񭤓vx^Aѽ|9V#c>LE^0i=śɵFd.!S]-1̺SW׳|?;|-h t."hOw= +Y JׂƃJ4<$F'10?_4 Jׂ=o-Ac%e䚂ћV;KN A A A;z8uAu޹Wt5OśʪNAkUu=J_ h=&E7Tϯ*E^r A]@PDGu۬>BP~凖/RO\^=|i^_{A< 3R4I*ʷ!7R* TiBoנa. u+uf(M#".$%uA@PQ.!v $M;2A|@D.<$jD (Aى(EM&r A|@@P> h"TzMv5I"s A]@PDKdBm::PR @4@P 6}хtu*ܻG~=g UTE%>;uA ND.%')'a#u q AAPW4QJu&fsڽ~P׾7WOz49_\r A/h>AAwV'Vr#"ZϣIrI*TG݋:=MUAHjTvLM ncpvnunbٗPI!a).sdzkBόcf3Iq^kx~agT<7 z&>@| 7HТ&S pD/9GK"l5*JAg֥4=n 7w-+zs#'hm*+(qcJ\ԛ4Mh zYP%N%5vw[.!(#^kP]l=VhT^~FYl:ϓjV'!9=A'<$YDd.! r A]KPO$|MwߡIʁp #=@P>'w7NA "ZϷI~f~%]M@ i2S)Ǘ (&]z&@Aف7I@PNp?(;h\fƉ(uA ND.%'h4IDKA"h\IK:e'\BP4I$v"%eAA\Py4I.$%uA@PQ.!4 (@I/h5O"dH# iH# 5rAA[@4@P XWwO?[;w~4[H# u#H㝿7~ao?6~2[H# u38/O;_uͻ$'҈B݌4NA}?s[ܳK4PO_?,p.-xZF_޹cNr~7]\4:A߯rɻt6Ƃ"(ԍHO_Psj8ry.&҈B݌ {w w^JiAh ( @4@P9,й?o:A@P9Jmrؙ.@$L &?Tot|AP{Y6z+׉yҽh:&r(נӤ<{3^ԖA@WIgv&Vիg| 5Nj MuMss5mKAAÔkA$f   Aߟn맪` @P  DAh ( @4@P  DAh ( @4@P  DAh ( @4@P  DAh ( ժUQQaDqbj;=.-?E[zF3כP:4 ނƣl6ܚVEe;ikN(=n7dy"KbIOS^y=ބ⁠A'?_سjlN1ͳ'/_yŌVzkR=le9t hנ0v)XV:b{wkЪykN(nU)~gɘtw5hҁ괗A~­`5>+|ˌ[U=KyN(zL?+M[_[%~ռ' =&J0yA @P  DAh ( @4@P  DAh ( @4@P  DPhszf]WIENDB`ggstats/man/figures/lifecycle-experimental.svg0000644000176200001440000000171614357760261021340 0ustar liggesuserslifecyclelifecycleexperimentalexperimental ggstats/man/figures/lifecycle-deprecated.svg0000644000176200001440000000171214357760261020737 0ustar liggesuserslifecyclelifecycledeprecateddeprecated ggstats/man/figures/lifecycle-superseded.svg0000644000176200001440000000171314357760261021003 0ustar liggesusers lifecyclelifecyclesupersededsuperseded ggstats/man/figures/lifecycle-archived.svg0000644000176200001440000000170714357760261020430 0ustar liggesusers lifecyclelifecyclearchivedarchived ggstats/man/figures/README-unnamed-chunk-8-1.png0000644000176200001440000001257614674034125020667 0ustar liggesusersPNG  IHDRMR/PLTE:f:f333::::f::f::::MMMMMnMMMnMnMff:fff:f:fnMMnMnnMnnnnnn䊀MMMnMnMn::::ff:f۶ېnMnnMȫfwpȎMȎnȎې:nfȎې۶Es pHYsod%IDATxݍ_qPYC9˺4MnJ6˶fd80F߲ L0փO}WQD9=XY((3GiP PR?u]:Y 44-tQ P(@EW+֥FkP*;ih"ZZM] P(@EW+ PѕJTte@@g{Y6Asr5h?:g-d7^Щ8ٽ4pQtvdi+8#N{eH@uTe@@g{C}Ф*Z4ys?(>pNM!C΃U:htJTt%@*] P(@EW+彙\%J@]-iT+ PѕJTt%@*] P(@EW+ PѕJTt%@*/еu@S rQ}#@PRA#@PRA#@PRA#@PRA#@PRA#@PRA,*ucvHe8@-R4VeX@՘ɳ:Ӫ lo눧'VP`eX@ѐ}д*j7<8p}P΃UhtJTt%@*] P(@EW+ PѕJTtgò$Qå4JTt%@*] P(@EW+ PѕJTt%@*] P(@EW+ PѕָZy5M'КK(h[j$Q_ݝx-~^O"@]c٤MPm~oғUkPzih{#@$&x^~>?h>Vh~7ӷmЪգ>bٽ4j@~3;Dh>VW.o{5lGGv苫=h>VW.o2鎑i'M}P%Sh>Vg#m1GuZ5]\;hzwZ [K#pP]@ yPh| }@hu+@pWgХp_|4bM|b oV7it*;ih"Zj>\ P(@EW+ PѕJPѕ]:@Ө(@EW+ PѕJTt%@*] P(@EW+ PѕJTt%@*] P(@EW+}Gҭr? P*64-]5/@S(@EW+ PѕJTt%@*] P(@EW+ PѕJTt%@*]Ie|~Wt4|[N{e8@dxWTmӳlGGv+:H#N{e8@MFCFд*>hZŷ8;7;E?T А*σnσN4'@%WFZSFР+ Pѕ-7ʿ 8KD @Wh>̩}\3к|%hʕ1 (T1ο[gRe@C}LaW+O&WF 8Z+cZ7DtռM2^u>*2^>Tt?}聎A=Hzа+Z?DtM2Zm[yi'2 Hv+:<.'{c;h{WtouۈL;h1t2&R IAӪ >W㦾V8O2 F`M2 5* PѕJTt%@*] P(@EW+ PѕJTt%@*] P(@EW+ Pѕ^<@F%@*] P(@EW+ PѕJTt%@*]!P+_qzo[JjeUQbrtDsл=hGTE-P}mh_@[">@E՜E"tM3k@ f7  &ՇBV1"v:+h"v:+h"v:+hz/oZ &-@T}ЋnZ &z,;T6[mvP >gS jƭëj3Q)hAkZ_lZ &4?}Q|u@$9+hot=sGTΊZګ- Z? @]eY6 sovOxqeb&xiNgE 5#loXF-н<_iwV{5ml'%СݔK3-2EGYITWb͠9)`iyZ&z*H͙*2V#ttuL @]%ƚ9*IPJi9o$))ͧj'Sl<84v0O3-'KSPUI*$uꘓTWH SZ:r*N. }qb:珎FF>+_Wx'DԤ4J@G[)S\2LgO܌c;~@]|]6»kj,?[M|ĕv)XlTϋW(j6["|lwmGIV}~yд+{<] P(@EW+ PѕJTt%@*] P(@EW+ Pѕ= @i]eޮv]e@:˳0RqϽi]e#}ghtw; @h!.*{A}.*{;@(@EW+ PѕJTt%@*] P(@EW+ PѕJTt%@*GvFWХp; @񖏫p @hpO>zvFW'vFW#ЛvFW|4pwU{:] P(@EW+ PѕJTt%@*] P(@EW+ Pѕ=u|1@94~Uv?l.o=htuz1@(v]z *{A *cFW/P׷4U+ PѕJTt%@*] P(@EW+ PѕJTt%@*g,R2 n+U+|Deh574^gcZ@g{[ *Zv,HoHtsJzJte샒Rw0% oW'/p]:Ul(K?:@/~W<ӇO< 4 ǟU!8Mk'/ϿHU対~ ~c6@;P=x!/{jZ //cgu&^u²MSM\&)LObUZ>{sirW\woͦI >t?sY^5^FP=l6*suٛ_^]IͶQ<>fzjL~wÏͦI qYyv4l?ZPv4of[n8gmRwRL˯|g8cN%=,+g 7GPjJ-إz/^os~{4%+2GfS5SfWvȍڦ>w7ՃN& @WfJ_ԈiwEGJDDtJDDtJDDtJDDtJDDtaK>IENDB`ggstats/man/figures/lifecycle-defunct.svg0000644000176200001440000000170414357760261020270 0ustar liggesuserslifecyclelifecycledefunctdefunct ggstats/man/figures/README-unnamed-chunk-9-1.png0000644000176200001440000001411614674034126020661 0ustar liggesusersPNG  IHDRMR/PLTE:f:f333::::f:::::MMMMMnMMMnMnMff:fff:ffnMMnMnnMnnnnnnMMMnMnM::::f۶ېnMnnnMȫffېȎMȎnې:nvmfȎېݍ pHYsodIDATx {YvEmp;A03$tf'cM3W3uJ/$StfZB-E$2BΖ/@Ȳ (I:J$ (I:s{Sw\)Ak։)Żq.5 v\ޔ]8u G;|uboJ.} :#h>:7x>AFk؛RK炠NZ`ϵNM)ޥsAPpQZ'ǹ SFz0x}9AMo׃Wś n|={r zGˏ╳ROAyP嬔lՂ. W>+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[AͳRGPl<+%oq5J[ϳ< +Ra-!$M*lG?OEYWcAaYdz z]-"hp%;w[ELgAy(ܰ㯜fc-.:VՖb0x9>G4Jv|Aa 4 ]a vi؂Vx-&oq5J[ hp%;A,AWAӀ+ٱ"~GV4 Y)~GM|3-s]4 M|=AOYc-Y d-YZA4J6gd-[a&o؂QX Wc @wo"g{9eFAc ̊D WcA_\m !\Ɏ-hv|kxA+Md#(++J6"JdG8 s*++JvTAo9츂 JvlAkAӀ+-6oR@4JvtAa]\Ɏ-h.'%\FP] Wc &rR•|懅1r 处+-VwWo3 Z#\^*hWA^dt).6n~ ~XpXxyrR•쥂[joq,{rw_VãnAXNJ\fgZн~p\{Cc9)J*A`ӯcAmǪ{՛^_1s#p% Xmvs3軏,yAAC:o+O{u`$ ߇Q:XNJ݁oNN3up%ՇAI W;4Ƈmixp%|aj^NJ[PrR•؂ WtyRa#QUМ=fS^IRlkJ6mF)Slʇl1fjFc=A{ g#hAl1ڞ=f,hsL"UАxӻE4 I؂Rg36Ƃ.HlIRag%I#ݮ=5h= c8Ԟ=A۳}&ixMC%;OW^ye4 I؂3MFc6ӟF7O۟OD4$Q N^tݾ +]Ė:ښy#bY$[,{gs^N؂pQ:;ׯ}/7.s{SN{u:7Jߦ,#h>:7x>AFk؛RK炠NZ`ϵNM)ޥsAPpQZ'ǹ S8(s{Sw\)Ak։)Żq.vG]q[F)Aqu GPB:$ (I:JVu F4L?/׃Ih;5TSp۟O*h:F4EٺJ\;nG"ۘkЬ~[./kq_u7O$&>+OŲ9o ʙc Gp77&A E4\h* yy2}=ک =g߾?y|OJ4T+^?g#A Y5hXY)5ȧ~Oݟ>xJf'QA נY w :woIi}Ȃ~Z]\{c0Anfgpx(br08Q`S]-6>+ D$ (I:J2>ʲ'Ay8|5Hт5r }AcA <Ϸ/vorK 3|)y7U 70j͏_w8ѩ%A]fUyHݒ.A\ٻݭ'_nIwAVGŎUvR>hA9ܼy}tVխ/aAZ9z%)oߒ.$ (I:J$ (I:J$ (I:C^IENDB`ggstats/man/figures/README-unnamed-chunk-11-1.png0000644000176200001440000001516014674034127020733 0ustar liggesusersPNG  IHDRMR/PLTE 8:f N44:::d:\f 8 Qx f fN|:Q !f8!|N!d!x!9999 ::::f::::::DsDDTD:DfMMMMMnMMMnMnMeee%ff:fff:ff:fgTgnMMnMnnMnnMnnnnnnnnT:MMMnMnMnnnMn4%::TfnMnnMȫ\%fېfTȎMȎnȫځ%ې:ې۶۶sn䫎Ȏ %fȎېۮD^H pHYsod-IDATx {#ui4P(‚!;e8,lZx6mEqK?Dޢk|Ln;UZޙчcwXG>h̞̝ѓPL4AA5 APP jT (AA5 APP jT͂Qtz}`طEb,huz}wy? ۏav^\kP"zݹ9AE޲GӚwPzݜqU&f@ieFAxKf&EltEm ?idR=of~w}ӅzA흗5SzAwۍSzAM#~bpb ~5鏻˳mP; "ij,(nTCm_Z3X M]W|p9LЭʳk^x>ڗ7U5l AvҚ`Ռݫ N6#OgΕzhV߅Jx|0r 5L7t}R-1@"p9bu{j\M7Ä 2R9iPvWUk Q&|pL(( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "(.`x|0 Z:((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( /V]3X0^+! (,`Jsx޴/o4fk>h "# h45ӾfՌݫ! (+uAZ|=V4|nyAJ 2Oֳkiu{j\M7Ä 2iLvjBNCdvJ$snA]J|w4g DŽ"((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( "((( L_ρU>`?-dpJmDuɮ Q4kt[pD*.J]>Hmyiuz.H h9 ~l%M`4Z~g&c>S|$/I^XKBZ\$AA5  2  2  2 8FRj$LgDAmƏ$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$tW*t+s4kw2EPIh܆s27ͪٚ"$tֲ}iͪWWAC@P)޶NӹR4lehJؕ_Ћ5g=;AJ& * ZjBN/%t3L"LFPEP\W}vW&{ve3: ʳk)9h:$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"$ ((H"L$_ρU>$AK]9-T'I@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PQEPI@PɓJ͘benØ{;…*' q杌MFj惆*# of:Kk}iͪWWAC@PӶNӹR4ls`IRcWN~AmǴnyAJ* Zj$؞wP't3L"#Wtjwحf-4t6~d΅(f:ȡ#h]dۍ `|*twt9:Q&nоt5IlݚvM'-VwLkl$a6"kn-=^&-^D($ߊw5c'NHPSa AGA3uuR{hkwsaګH BGвQtSp#*ϭ]şA5k?Oe e-w ڊ< /:Sw_Z6 0A h_[Il,+ 0~g&c>SXQިWC$ya/I ɇnhq4F$TFAAe$ATFAAe$ATFAAe$ATFAAe$ATFAAe$arw0-I A=CQtxZ: 0Y) &耢Z: pLFAFA&@вQ th$L{v h(H o$LCGвQEPI@PQEPI(|Hr Z:$hO * 2 * 2 * 2 * MPddROLÂBJABQ~ƌN mLg,`-T skA,wb̻iXPS)'[dp dųQ A >6:IWصor,`- KثtT A >zBz34LÂBRAJA0  }:mUiXPS)hR'ez&o$ALÂBJA{k L/Iϑ A >BAAe$ATFAAe$ATFAAe$ATFAt,|f!/fA"eZ4v"fAT3ԁ *@B@P u! (aFbR3X0^+PAP=4Q_\+udEP9<_]ԶthVZ|=V-7r-QسAo,]_T C-7r tiuj\M7Ä*9=&[Zi("!aB?'snAtG-뙃#-EC u! =B~(O(yޜ#䇟|^OC%C@# j|<{{l΅ǓeVKn(yM^L!kt߻H:Q;=Sޓϭ?;Q;=n4[ {Ϟ5#%C@# _ؗ!/<̔(yIЌC7=AG=JAs7%hy8qQ#%C@Л`7EP9P*"fAT3ԁ *@B@P u! (a:PA0C@rT EP9P*/c!hݷrAE=C! :(AKAE4w:BRD! ACDC@ctx AEн{4oz sB Dhx-T4XT EP9P*"fAT3ԁ *@B@P u! (a:PA0C@rT EP9P*"fAT3ԁ *@B@P u! (a:PA0C@rT EP9P*"fAT3ԁ óio~ɷоdt}}}QЇ;x(gKlt*͟^E{(O/3}~fzo>7ɷ~g}ٽLv~ _yzChAם-o'|'v{DЗ?wK+3NgzZ^gton+FQ(_u~vן;?n68AG~-9cm|YEovq zKbOw''({y;Z;F~?E>vkoOL>u~_7x=<z?I;j~kNN/Apt(gvG6*:=0S'y)}Ӵbf Zv5)z5w}Gwm*wAwfcI9,~yi6}tc{ LL?*A?K&ٗ_rtsMGwr$ :o|?u~Ir{m_ %zNNy/ ߨ/o<EcGм! (a:PA0~X0^+PAP=4̜sN}yY5[y"fuLҚU3vC>EP9̜߳t}hPJx|c D~TA漠nzcbOGn3td8MPWU=cAcAs=sP8&  (AA5 APP jT (AA5 APP jT (AA5 ][~AJj5$ Z56|})R Wlʳϳj+HQMSs2|ZXܪ2v}`T)1 4DA'z#+j RbT$hA'Lw7{~AJj8A/W´vV߲﵁ :سhq1 Ma"㊿Ea"(AA5 APP jT (AA5 APP jT (AA5 APP jT (nad"BIENDB`ggstats/man/figures/lifecycle-maturing.svg0000644000176200001440000000170614357760261020470 0ustar liggesuserslifecyclelifecyclematuringmaturing ggstats/man/figures/README-unnamed-chunk-6-1.png0000644000176200001440000002176514674034125020665 0ustar liggesusersPNG  IHDRMR/PLTE,:Nf=++,+n0M:LLfk,kNnn?b?b?b333888,88=8C^::::f:::::????b?b?b?MMMMMnMMMnMnMbb?bbb?b??bb?bbbbbbccc,c=cTmff:fff:ffnMMnMnnMnnnnnn????bbbٌemMMMnMnM::::f۶ېbb?bٽ٫nMnnnMȫ0e=vmffې?bٟȎMȎnCvmٟbٽٟٽې:nT,e=vMv^vmfȎېze pHYsod IDATx흍y7 DX )(vF[9$ؔҴ)iqT:mF/ED!*h繽Y={/ڟۙ/&}jA(jPP@V BV0PZP,  B+BAhEB\4X(H(   r` "X.,V$@ЊbhPZP,HW?{fkQ7,+ }{bF Яo_ۿ8a DJ^W7 aLO~OӏTJ,H(ko_O~ Y~Ϟ0'_f.H(ko?Jk{O׌X4 AO^- $1@Uyyq! Qe^4 3>i PbF {_W𺾢1eO)8xEPbF Џ>%}ѯ0DTtPbF PMϞWuh3⟽T̠ r B+BAhEB\4X(H(   r` "X`@YEՎj¼ Q&@(sPf9I`3 ԤhajR4،05)lFA 6 AM Q&@(sPf9I`3 ԤhajR4،05)lFA 6 AMtZn]鞼-P/ >IQnt_Snߘﯝ2 ԋ9jRK4͠[We2 ԋ9b4o^zgA/Ďza0>|UЍLп^ 7&҂:I|?$O֓dNlq렕[/\8J?-(\TJ>R?}ޗ1?{Pp8̕]۽ıǽ?xpLoe.a6}bڊX֊g,sKT);(%5P?X8ꀖ^w&P(%: V>^[I".&/"|:\ЕL"L.&ʜү5aJ9]dSߏo((0Wttڀ.V<J4]h'́gɑNgb\?g:㝢 6V8JN&Jǎ&Bcwz 07 P.Xp~7:nws~7:nws~7q@Sv#Pu@ 7q@՗Ͻb{W:♽(07 Ȝ#7e#AMVZOW]?S_>.:a.7%/9ZEavTN7X4c}ĄZEav4"~}ĄZEav4K9f1aVrzd]9&le} [ @#brXlVa1aVrzts*Ն^Z'l*Z3C mZ癰Uh9=2 [ʼn[uτZEavT'n}=ZEavTИ~k'n)8>ZEav4pj9 @ 7ڡ(0P;4%fj @psn3CPavhJ9 @ 7ڡ(0P;tkX81fݴ}]/X/x [/. jnm+*-Q)ӥXu= p= ˦KP;4%ܑ.ztij;ٗ@KKP;4%ܑ̋e^2]ڡ(cvtij;y]?,uw4CPǼJ)_wKP;4%f8ԤC݉LvhJƃկ~R_K\qKϙ_ӥnaC c__{ @ Ȟm(y}*BP­7%^mxo_;OVhJ +ݢڧR+4h^G/S:{Zh5!6cqj$YڧR+U 0T"m^"wGyW]{.MPTjB3wf)4wTcFJ ڧR+4 .ǣW69rS?\K>|r-I$&߱7LgGPTj* З "EFMZіj. RO!Ƽ-HѠvjJ~@V" kyN-W[ ieecj4P;4h_̝ PWUOiLGP/dPu@Z= L?|r=][խVj9ׂ{PV+tڡ>~㇂B=]VZӊ1oBڟAoTW}yr3/UkO)(}|h{I^x-VMqߘZTTCKIo@U߽ZO{e7dLnQJy: @QTTb}@0P;4%fj=@uTڷ:X-zJ2h5P jI#)av]Tv$ВnA3%UT+*D`=PR sA\uch7hy:V4k>>4 @920psz7ͯ( _:QCϠf4S<5U3;wD}>I[ 2;T|dP L͊T3u)8RA'O-$ Sii@=?4.J7&b69gc3>ߙY'?a jr @qZpvuhΌ vu&l|=.?^wP P"<NPm4T+~UÜt̙k }܃24 4Uv,@o>?gU@=:L:UUsxpCPb?9 n§|fSJ?=Tt-JJpsuZJJYʜLBEעީ W%^~ @*&e̳d1 hUg%>Hgƹ-8#rtP[#ɧ[% *oHA# аew*B-7 7P<]2xMu7ţo*nG n ㇒d휭74yDV @hg39[F;soVh0wCr8XO75ڙHG$ ^u~ㇿy/!]=ڗV˯45휮74ڙH3?y_/Ĭ9nt8X\Xo`3'!w0T.d?X( s7h>89_ob35SD w;ONnhz=],OՓ%4K|zy ih3g S<ɻ&%~XIrį09NI3mZR hE0wS2=1n @ 7yZeHIps.nws~7:n9q븇u "()t @79qP @79qP @79qP @79qP @w[X1VG2hX sP:afafafa;=eq0@-3N1j(uzP @` ZfJc2P8R:=eq0@-3N1j(uzP @` ZfJc2P8R:=eq0@-3N1j(uzP @` ZfJc2P8R:=eq0@-3N1j(uzP @` ZfJc2P8R# ֕ɻjmnw_v-PZt}cvJm|k4_5TЭ2anHL_(F*J慻*wk⒯ Bq݁cݰn,}㢺Y4RA Z̠[W.}(TT{PъϚG;fXN<ʫzڊ|kj@Nv$c;̣ ITX5h+t2O ر̘Xgrjyd@#DT@g%~"pZL3Jq0wx$(49^ @+c{PqiLJlrDpS$@'IUBY@%3?2299srJ`,Ot2Q2`ˎΎw&sh 􃪆lʡq2M谧@T'+C4M3.aN6MlEWO @#i.[/4uFB\nH( ֭ rк@#X.Z^h$@ bhzP,[/4C鬬NaȗYOT<@'tfSBӉ[:1a PR- J'nRĄ- @IŽU[J:1a PRQU-lwc2@E+I&P=qKɬ'lPJ*%>}@@5|*ʼn[uτ- @IE4'- @IE8QP߄- @I&I,։ [k4P @hfJh6V8fafafaf <n% yTv<@{&'Rf utidP WLgK%=l4uaVobgPM$H P;P @hҞZ^). @7c'͛PLݑ̓Yӥ~wwZHl;]:nwG1Oˎ=ڝ. @7YeD_e.kP. @7\2.M9]:nw$#h=}1xtlM1h\vjhco@-q__;ɷG @-3T89=duJǼ4kue g"̞x;n)1otkV("Dѕ>7-MfYkV("D-ey˷)e '{h 9/e 'E 1V@3u kAw1oBW_ bAg[Ёfӊy: @TK_Ƽ h{_6'DV+t:h @79qP @79qP @79qP @79qP @79qP @79qP @79qP @79qu{nq-^h^|nߘﯝ*;(trr w[,kTtQ;~YEՎj¼ Q @ zQ A{PoV BZ- Zj(jС$s}":\{掄5!tS)}-z|Y>zI\O| B է>T{t,9?G||K[(hu6o&Q,eAq]])&O}XXB@Ъnūχr4f=h\!dJ6tC4^r=&:nI^dL}+-P@V BZ- Zj(jPP@V0A8MIENDB`ggstats/man/geom_diverging.Rd0000644000176200001440000001451214672600601015762 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom_diverging.R \name{geom_diverging} \alias{geom_diverging} \alias{geom_likert} \alias{geom_pyramid} \alias{geom_diverging_text} \alias{geom_likert_text} \alias{geom_pyramid_text} \title{Geometries for diverging bar plots} \usage{ geom_diverging( mapping = NULL, data = NULL, stat = "prop", position = position_diverging(reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff), ..., complete = "fill", default_by = "total", height = "count", reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL ) geom_likert( mapping = NULL, data = NULL, stat = "prop", position = position_likert(reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff), ..., complete = "fill", default_by = "x", height = "prop", reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL ) geom_pyramid( mapping = NULL, data = NULL, stat = "prop", position = position_diverging(reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff), ..., complete = NULL, default_by = "total", height = "prop", reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL ) geom_diverging_text( mapping = NULL, data = NULL, stat = "prop", position = position_diverging(vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff), ..., complete = "fill", default_by = "total", height = "count", labels = "count", labeller = label_number_abs(hide_below = hide_below), reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL, vjust = 0.5, hide_below = NULL ) geom_likert_text( mapping = NULL, data = NULL, stat = "prop", position = position_likert(vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff), ..., complete = "fill", default_by = "x", height = "prop", labels = "prop", labeller = label_percent_abs(accuracy = 1, hide_below = hide_below), reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL, vjust = 0.5, hide_below = NULL ) geom_pyramid_text( mapping = NULL, data = NULL, stat = "prop", position = position_diverging(vjust = vjust, reverse = reverse, exclude_fill_values = exclude_fill_values, cutoff = cutoff), ..., complete = NULL, default_by = "total", height = "prop", labels = "prop", labeller = label_percent_abs(accuracy = 1, hide_below = hide_below), reverse = FALSE, exclude_fill_values = NULL, cutoff = NULL, vjust = 0.5, hide_below = NULL ) } \arguments{ \item{mapping}{Optional set of aesthetic mappings.} \item{data}{The data to be displayed in this layers.} \item{stat}{The statistical transformation to use on the data for this layer.} \item{position}{A position adjustment to use on the data for this layer.} \item{...}{Other arguments passed on to \code{\link[ggplot2:geom_bar]{ggplot2::geom_bar()}}} \item{complete}{An aesthetic for those unobserved values should be completed, see \code{\link[=stat_prop]{stat_prop()}}. Passed only if \code{stat = "prop"}.} \item{default_by}{Name of an aesthetic determining denominators by default, see \code{\link[=stat_prop]{stat_prop()}}. Passed only if \code{stat = "prop"}.} \item{height}{Statistic used, by default, to determine the height/width, see \code{\link[=stat_prop]{stat_prop()}}. Passed only if \code{stat = "prop"}.} \item{reverse}{If \code{TRUE}, will reverse the default stacking order. This is useful if you're rotating both the plot and legend.} \item{exclude_fill_values}{Vector of values from the variable associated with the \code{fill} aesthetic that should not be displayed (but still taken into account for computing proportions)} \item{cutoff}{number of categories to be displayed negatively (i.e. on the left of the x axis or the bottom of the y axis), could be a decimal value: \code{2} to display negatively the two first categories, \code{2.5} to display negatively the two first categories and half of the third, \code{2.2} to display negatively the two first categories and a fifth of the third (see examples). By default (\code{NULL}), it will be equal to the number of categories divided by 2, i.e. it will be centered.} \item{labels}{Statistic used, by default, to determine the labels, see \code{\link[=stat_prop]{stat_prop()}}. Passed only if \code{stat = "prop"}.} \item{labeller}{Labeller function to format labels, see \code{\link[=stat_prop]{stat_prop()}}. Passed only if \code{stat = "prop"}.} \item{vjust}{Vertical adjustment for geoms that have a position (like points or lines), not a dimension (like bars or areas). Set to \code{0} to align with the bottom, \code{0.5} for the middle, and \code{1} (the default) for the top.} \item{hide_below}{If provided, values below \code{hide_below} will be masked. Argument passed to \code{\link[=label_number_abs]{label_number_abs()}} or \code{\link[=label_percent_abs]{label_percent_abs()}}.} } \description{ These geometries are similar to \code{\link[ggplot2:geom_bar]{ggplot2::geom_bar()}} but provides different set of default values. } \details{ \itemize{ \item \code{geom_diverging()} is designed for stacked diverging bar plots, using \code{\link[=position_diverging]{position_diverging()}}. \item \code{geom_likert()} is designed for Likert-type items. Using \code{position_likert()} (each bar sums to 100\%). \item \code{geom_pyramid()} is similar to \code{geom_diverging()} but uses proportions of the total instead of counts. } To add labels on the bar plots, simply use \code{geom_diverging_text()}, \code{geom_likert_text()}, or \code{geom_pyramid_text()}. } \examples{ library(ggplot2) ggplot(diamonds) + aes(x = clarity, fill = cut) + geom_diverging() ggplot(diamonds) + aes(x = clarity, fill = cut) + geom_diverging(cutoff = 4) ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_likert() + geom_likert_text(aes(color = after_scale(hex_bw(.data$fill)))) d <- Titanic |> as.data.frame() ggplot(d) + aes(y = Class, fill = Sex, weight = Freq) + geom_diverging() + geom_diverging_text() ggplot(d) + aes(y = Class, fill = Sex, weight = Freq) + geom_pyramid() + geom_pyramid_text() } ggstats/man/scale_fill_likert.Rd0000644000176200001440000000435014657065717016463 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/scale_fill_likert.R \name{scale_fill_likert} \alias{scale_fill_likert} \alias{likert_pal} \title{Colour scale for Likert-type plots} \usage{ scale_fill_likert( name = waiver(), ..., pal = scales::brewer_pal(palette = "BrBG"), cutoff = NULL, aesthetics = "fill" ) likert_pal(pal = scales::brewer_pal(palette = "BrBG"), cutoff = NULL) } \arguments{ \item{name}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be omitted.} \item{...}{Other arguments passed on to \code{discrete_scale()} to control name, limits, breaks, labels and so forth.} \item{pal}{A palette function taking a number of colours as entry and returning a list of colours (see examples), ideally a diverging palette} \item{cutoff}{Number of categories displayed negatively (see \code{\link[=position_likert]{position_likert()}}) and therefore changing the center of the colour scale (see examples).} \item{aesthetics}{Character string or vector of character strings listing the name(s) of the aesthetic(s) that this scale works with. This can be useful, for example, to apply colour settings to the colour and fill aesthetics at the same time, via \code{aesthetics = c("colour", "fill")}.} } \description{ This scale is similar to other diverging discrete colour scales, but allows to change the "center" of the scale using \code{cutoff} argument, as used by \code{\link[=position_likert]{position_likert()}}. } \examples{ library(ggplot2) ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + scale_x_continuous(label = label_percent_abs()) + xlab("proportion") ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = "likert") + scale_x_continuous(label = label_percent_abs()) + xlab("proportion") + scale_fill_likert() ggplot(diamonds) + aes(y = clarity, fill = cut) + geom_bar(position = position_likert(cutoff = 1)) + scale_x_continuous(label = label_percent_abs()) + xlab("proportion") + scale_fill_likert(cutoff = 1) } ggstats/man/stat_cross.Rd0000644000176200001440000001627214625277577015212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stat_cross.R \docType{data} \name{stat_cross} \alias{stat_cross} \alias{StatCross} \title{Compute cross-tabulation statistics} \usage{ stat_cross( mapping = NULL, data = NULL, geom = "point", position = "identity", ..., na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, keep.zero.cells = FALSE ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{geom}{Override the default connection with \code{\link[ggplot2:geom_point]{ggplot2::geom_point()}}.} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{na.rm}{If \code{TRUE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{keep.zero.cells}{If \code{TRUE}, cells with no observations are kept.} } \value{ A \code{ggplot2} plot with the added statistic. } \description{ Computes statistics of a 2-dimensional matrix using \link[broom:augment.htest]{broom::augment.htest}. } \section{Aesthetics}{ \code{stat_cross()} requires the \strong{x} and the \strong{y} aesthetics. } \section{Computed variables}{ \describe{ \item{observed}{number of observations in x,y} \item{prop}{proportion of total} \item{row.prop}{row proportion} \item{col.prop}{column proportion} \item{expected}{expected count under the null hypothesis} \item{resid}{Pearson's residual} \item{std.resid}{standardized residual} \item{row.observed}{total number of observations within row} \item{col.observed}{total number of observations within column} \item{total.observed}{total number of observations within the table} \item{phi}{phi coefficients, see \code{\link[=augment_chisq_add_phi]{augment_chisq_add_phi()}}} } } \examples{ library(ggplot2) d <- as.data.frame(Titanic) # plot number of observations ggplot(d) + aes(x = Class, y = Survived, weight = Freq, size = after_stat(observed)) + stat_cross() + scale_size_area(max_size = 20) # custom shape and fill colour based on chi-squared residuals ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(std.resid) ) + stat_cross(shape = 22) + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + scale_size_area(max_size = 20) \donttest{ # custom shape and fill colour based on phi coeffients ggplot(d) + aes( x = Class, y = Survived, weight = Freq, size = after_stat(observed), fill = after_stat(phi) ) + stat_cross(shape = 22) + scale_fill_steps2(show.limits = TRUE) + scale_size_area(max_size = 20) # plotting the number of observations as a table ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = after_stat(observed) ) + geom_text(stat = "cross") # Row proportions with standardized residuals ggplot(d) + aes( x = Class, y = Survived, weight = Freq, label = scales::percent(after_stat(row.prop)), size = NULL, fill = after_stat(std.resid) ) + stat_cross(shape = 22, size = 30) + geom_text(stat = "cross") + scale_fill_steps2(breaks = c(-3, -2, 2, 3), show.limits = TRUE) + facet_grid(Sex ~ .) + labs(fill = "Standardized residuals") + theme_minimal() } } \seealso{ \code{vignette("stat_cross")} } \keyword{datasets} ggstats/man/geom_stripped_rows.Rd0000644000176200001440000001535414625277577016741 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom_stripped_rows.R \name{geom_stripped_rows} \alias{geom_stripped_rows} \alias{geom_stripped_cols} \title{Alternating Background Color} \usage{ geom_stripped_rows( mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., show.legend = NA, inherit.aes = TRUE, xfrom = -Inf, xto = Inf, width = 1, nudge_y = 0 ) geom_stripped_cols( mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., show.legend = NA, inherit.aes = TRUE, yfrom = -Inf, yto = Inf, width = 1, nudge_x = 0 ) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and \code{inherit.aes = TRUE} (the default), it is combined with the default mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} \item{data}{The data to be displayed in this layer. There are three options: If \code{NULL}, the default, the data is inherited from the plot data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. A \code{data.frame}, or other object, will override the plot data. All objects will be fortified to produce a data frame. See \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. A \code{function} will be called with a single argument, the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} \item{stat}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} argument can be used the override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. \item A string naming the stat. To give the stat as a string, strip the function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, give the stat as \code{"count"}. \item For more information and other ways to specify the stat, see the \link[ggplot2:layer_stats]{layer stat} documentation. }} \item{position}{A position adjustment to use on the data for this layer. This can be used in various ways, including to prevent overplotting and improving the display. The \code{position} argument accepts the following: \itemize{ \item The result of calling a position function, such as \code{position_jitter()}. This method allows for passing extra arguments to the position. \item A string naming the position adjustment. To give the position as a string, strip the function name of the \code{position_} prefix. For example, to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These arguments broadly fall into one of 4 categories below. Notably, further arguments to the \code{position} argument, or aesthetics that are required can \emph{not} be passed through \code{...}. Unknown arguments that are not part of the 4 categories below are ignored. \itemize{ \item Static aesthetics that are not mapped to a scale, but are at a fixed value and apply to the layer as a whole. For example, \code{colour = "red"} or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} section that lists the available options. The 'required' aesthetics cannot be passed on to the \code{params}. Please note that while passing unmapped aesthetics as vectors is technically possible, the order and required length is not guaranteed to be parallel to the input data. \item When constructing a layer using a \verb{stat_*()} function, the \code{...} argument can be used to pass on parameters to the \code{geom} part of the layer. An example of this is \code{stat_density(geom = "area", outline.type = "both")}. The geom's documentation lists which parameters it can accept. \item Inversely, when constructing a layer using a \verb{geom_*()} function, the \code{...} argument can be used to pass on parameters to the \code{stat} part of the layer. An example of this is \code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation lists which parameters it can accept. \item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through \code{...}. This can be one of the functions described as \link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. }} \item{show.legend}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to display.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} \item{xfrom, xto}{limitation of the strips along the x-axis} \item{width}{width of the strips} \item{yfrom, yto}{limitation of the strips along the y-axis} \item{nudge_x, nudge_y}{horizontal or vertical adjustment to nudge strips by} } \value{ A \code{ggplot2} plot with the added geometry. } \description{ Add alternating background color along the y-axis. The geom takes default aesthetics \code{odd} and \code{even} that receive color codes. } \examples{ \dontshow{if (requireNamespace("reshape")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(tips, package = "reshape") library(ggplot2) p <- ggplot(tips) + aes(x = time, y = day) + geom_count() + theme_light() p p + geom_stripped_rows() p + geom_stripped_cols() p + geom_stripped_rows() + geom_stripped_cols() \donttest{ p <- ggplot(tips) + aes(x = total_bill, y = day) + geom_count() + theme_light() p p + geom_stripped_rows() p + geom_stripped_rows() + scale_y_discrete(expand = expansion(0, 0.5)) p + geom_stripped_rows(xfrom = 10, xto = 35) p + geom_stripped_rows(odd = "blue", even = "yellow") p + geom_stripped_rows(odd = "blue", even = "yellow", alpha = .1) p + geom_stripped_rows(odd = "#00FF0022", even = "#FF000022") p + geom_stripped_cols() p + geom_stripped_cols(width = 10) p + geom_stripped_cols(width = 10, nudge_x = 5) } \dontshow{\}) # examplesIf} } ggstats/man/label_number_abs.Rd0000644000176200001440000000216714527332015016254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/label_number_abs.R \name{label_number_abs} \alias{label_number_abs} \alias{label_percent_abs} \title{Label absolute values} \usage{ label_number_abs(..., hide_below = NULL) label_percent_abs(..., hide_below = NULL) } \arguments{ \item{...}{arguments passed to \code{\link[scales:label_number]{scales::label_number()}} or \code{\link[scales:label_percent]{scales::label_percent()}}} \item{hide_below}{if provided, values below \code{hide_below} will be masked (i.e. an empty string \code{""} will be returned)} } \value{ A "labelling" function, , i.e. a function that takes a vector and returns a character vector of same length giving a label for each input value. } \description{ Label absolute values } \examples{ x <- c(-0.2, -.05, 0, .07, .25, .66) scales::label_number()(x) label_number_abs()(x) scales::label_percent()(x) label_percent_abs()(x) label_percent_abs(hide_below = .1)(x) } \seealso{ \code{\link[scales:label_number]{scales::label_number()}}, \code{\link[scales:label_percent]{scales::label_percent()}} } ggstats/DESCRIPTION0000644000176200001440000000245114674044142013444 0ustar liggesusersPackage: ggstats Type: Package Title: Extension to 'ggplot2' for Plotting Stats Version: 0.7.0 Authors@R: c( person("Joseph", "Larmarange", , "joseph@larmarange.net", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7097-700X")) ) Description: Provides new statistics, new geometries and new positions for 'ggplot2' and a suite of functions to facilitate the creation of statistical plots. License: GPL (>= 3) URL: https://larmarange.github.io/ggstats/, https://github.com/larmarange/ggstats BugReports: https://github.com/larmarange/ggstats/issues Depends: R (>= 4.2) Imports: cli, dplyr, forcats, ggplot2 (>= 3.4.0), lifecycle, patchwork, purrr, rlang, scales, stats, stringr, tidyr Suggests: betareg, broom, broom.helpers (>= 1.17.0), emmeans, glue, gtsummary, knitr, labelled (>= 2.11.0), reshape, rmarkdown, nnet, parameters, pscl, testthat (>= 3.0.0), spelling, survey, survival, vdiffr Encoding: UTF-8 RoxygenNote: 7.3.2 Config/testthat/edition: 3 Language: en-US VignetteBuilder: knitr NeedsCompilation: no Packaged: 2024-09-22 16:04:33 UTC; josep Author: Joseph Larmarange [aut, cre] () Maintainer: Joseph Larmarange Repository: CRAN Date/Publication: 2024-09-22 16:40:02 UTC