mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2025-12-16 09:32:10 +01:00
118 lines
2.8 KiB
R
118 lines
2.8 KiB
R
plot_bar <- function(data, pri, sec, ter = NULL, style = c("stack", "dodge", "fill"), max_level = 30, ...) {
|
|
style <- match.arg(style)
|
|
|
|
if (!is.null(ter)) {
|
|
ds <- split(data, data[ter])
|
|
} else {
|
|
ds <- list(data)
|
|
}
|
|
|
|
out <- lapply(ds, \(.ds){
|
|
plot_bar_single(
|
|
data = .ds,
|
|
pri = pri,
|
|
sec = sec,
|
|
style = style,
|
|
max_level = max_level
|
|
)
|
|
})
|
|
|
|
wrap_plot_list(out, title = glue::glue(i18n$t("Grouped by {get_label(data,ter)}")), ...)
|
|
}
|
|
|
|
|
|
#' Single vertical barplot
|
|
#'
|
|
#' @param style barplot style passed to geom_bar position argument.
|
|
#' One of c("stack", "dodge", "fill")
|
|
#'
|
|
#' @name data-plots
|
|
#'
|
|
#' @returns ggplot object
|
|
#' @export
|
|
#'
|
|
#' @examples
|
|
#' mtcars |>
|
|
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
|
|
#' plot_bar_single(pri = "cyl", sec = "am", style = "fill")
|
|
#'
|
|
#' mtcars |>
|
|
#' dplyr::mutate(cyl = factor(cyl), am = factor(am)) |>
|
|
#' plot_bar_single(pri = "cyl", style = "stack")
|
|
plot_bar_single <- function(data, pri, sec = NULL, style = c("stack", "dodge", "fill"), max_level = 30) {
|
|
style <- match.arg(style)
|
|
|
|
if (identical(sec, "none")) {
|
|
sec <- NULL
|
|
}
|
|
|
|
p_data <- as.data.frame(table(data[c(pri, sec)])) |>
|
|
dplyr::mutate(dplyr::across(tidyselect::any_of(c(pri, sec)), forcats::as_factor),
|
|
p = Freq / NROW(data)
|
|
)
|
|
|
|
|
|
if (nrow(p_data) > max_level) {
|
|
# browser()
|
|
p_data <- sort_by(
|
|
p_data,
|
|
p_data[["Freq"]],
|
|
decreasing = TRUE
|
|
) |>
|
|
head(max_level)
|
|
# if (is.null(sec)){
|
|
# p_data <- sort_by(
|
|
# p_data,
|
|
# p_data[["Freq"]],
|
|
# decreasing=TRUE) |>
|
|
# head(max_level)
|
|
# } else {
|
|
# split(p_data,p_data[[sec]]) |>
|
|
# lapply(\(.x){
|
|
# # browser()
|
|
# sort_by(
|
|
# .x,
|
|
# .x[["Freq"]],
|
|
# decreasing=TRUE) |>
|
|
# head(max_level)
|
|
# }) |> dplyr::bind_rows()
|
|
# }
|
|
}
|
|
|
|
## Shortens long level names
|
|
p_data[[pri]] <- forcats::as_factor(unique_short(as.character(p_data[[pri]]), max = 20))
|
|
|
|
if (!is.null(sec)) {
|
|
fill <- sec
|
|
} else {
|
|
fill <- pri
|
|
}
|
|
|
|
p <- ggplot2::ggplot(
|
|
p_data,
|
|
ggplot2::aes(
|
|
x = .data[[pri]],
|
|
y = p,
|
|
fill = .data[[fill]]
|
|
)
|
|
) +
|
|
ggplot2::geom_bar(position = style, stat = "identity") +
|
|
ggplot2::scale_y_continuous(labels = scales::percent) +
|
|
ggplot2::ylab("Percentage") +
|
|
ggplot2::xlab(get_label(data,pri))
|
|
|
|
## To handle large number of levels and long level names
|
|
if (nrow(p_data) > 10 | any(nchar(as.character(p_data[[pri]])) > 6)) {
|
|
p <- p +
|
|
ggplot2::guides(fill = "none") +
|
|
ggplot2::theme(
|
|
axis.text.x = ggplot2::element_text(
|
|
angle = 90,
|
|
vjust = 1, hjust = 1
|
|
))+
|
|
ggplot2::theme(
|
|
axis.text.x = ggplot2::element_text(vjust = 0.5)
|
|
)
|
|
}
|
|
p
|
|
}
|