mirror of
https://github.com/agdamsbo/FreesearchR.git
synced 2026-06-19 04:27:30 +02:00
112 lines
3.2 KiB
R
112 lines
3.2 KiB
R
#' Nice horizontal stacked bars (Grotta bars)
|
|
#'
|
|
#' @returns ggplot2 object
|
|
#' @export
|
|
#'
|
|
#' @name data-plots
|
|
#'
|
|
#' @examples
|
|
#' mtcars |> plot_hbars(pri = "carb", sec = "cyl")
|
|
#' mtcars |> plot_hbars(pri = "carb", sec = "cyl", ter="am")
|
|
#' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Blues")
|
|
#' mtcars |> plot_hbars(pri = "carb", sec = NULL,color.palette="Magma")
|
|
#' mtcars |> plot_hbars(pri = "carb", sec = "am",color.palette="Viridis")
|
|
plot_hbars <- function(data,
|
|
pri,
|
|
sec,
|
|
ter = NULL,
|
|
color.palette = "viridis",
|
|
...) {
|
|
vertical_stacked_bars(
|
|
data = data,
|
|
score = pri,
|
|
group = sec,
|
|
strata = ter,
|
|
color.palette = color.palette,
|
|
...
|
|
)
|
|
}
|
|
|
|
|
|
#' Vertical stacked bar plot wrapper
|
|
#'
|
|
#' @param data data.frame
|
|
#' @param score outcome variable
|
|
#' @param group grouping variable
|
|
#' @param strata stratifying variable
|
|
#' @param t.size text size
|
|
#'
|
|
#' @return ggplot2 object
|
|
#' @export
|
|
#'
|
|
vertical_stacked_bars <- function(data,
|
|
score = "full_score",
|
|
group = "pase_0_q",
|
|
strata = NULL,
|
|
t.size = 8,
|
|
l.color = "black",
|
|
l.size = .5,
|
|
draw.lines = TRUE,
|
|
label.str = "{n}\n{round(100 * p,0)}%",
|
|
color.palette = "viridis",
|
|
reverse = TRUE) {
|
|
if (is.null(group)) {
|
|
df.table <- data[c(score, group, strata)] |>
|
|
dplyr::mutate("All" = 1) |>
|
|
table()
|
|
group <- "All"
|
|
draw.lines <- FALSE
|
|
} else {
|
|
df.table <- data[c(score, group, strata)] |>
|
|
table()
|
|
}
|
|
|
|
p <- df.table |>
|
|
rankinPlot::grottaBar(
|
|
scoreName = score,
|
|
groupName = group,
|
|
textColor = c("black", "white"),
|
|
strataName = strata,
|
|
textCut = 6,
|
|
textSize = 20,
|
|
printNumbers = "none",
|
|
lineSize = l.size,
|
|
returnData = TRUE
|
|
)
|
|
|
|
colors <- generate_colors(n = nrow(df.table), palette = color.palette)
|
|
## Colors are reversed by default as that usually gives the best result
|
|
if (isTRUE(reverse)) {
|
|
colors <- rev(colors)
|
|
}
|
|
|
|
score_label <- data |> get_label(var = score)
|
|
group_label <- data |> get_label(var = group)
|
|
|
|
# browser()
|
|
|
|
p |>
|
|
(\(.x) {
|
|
.x$plot +
|
|
ggplot2::geom_text(
|
|
data = .x$rectData[which(.x$rectData$n >
|
|
0), ],
|
|
size = t.size,
|
|
fontface = "plain",
|
|
ggplot2::aes(
|
|
x = group,
|
|
y = p_prev + 0.49 * p,
|
|
color = contrast_text(colors[as.numeric(score)], threshold = .3),
|
|
# label = paste0(sprintf("%2.0f", 100 * p),"%"),
|
|
# label = sprintf("%2.0f", 100 * p)
|
|
label = glue::glue(label.str)
|
|
)
|
|
) +
|
|
ggplot2::labs(fill = score_label) +
|
|
ggplot2::scale_fill_manual(values = colors) +
|
|
ggplot2::theme(legend.position = "bottom",
|
|
axis.title = ggplot2::element_text(),) +
|
|
ggplot2::xlab(group_label) +
|
|
ggplot2::ylab(NULL)
|
|
})()
|
|
}
|