Nothing
#' Create a `ggplot2` pie chart
#'
#' @param data data as returned by `prep_summary_to_classes` but
#' summarized by one column (currently, we support
#' `indicator_metric`, `STUDY_SEGMENT`, and `VAR_NAMES`)
#' @param meta_data [meta_data]
#'
#' @return a [ggplot2] plot
#'
#' @family summary_functions
#' @export
prep_render_pie_chart_from_summaryclasses_ggplot2 <- function(data,
meta_data = "item_level") {
if (nrow(data) == 0) {
x <- ggplot() +
annotate("text", x = 0, y = 0, label = "Empty result.") +
theme(
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_blank()
)
x <- util_set_size(x)
return(x)
}
grouped_by <- setdiff(colnames(data), c("class", "value", "percent", "note"))
util_stop_if_not(length(grouped_by) == 1)
groups <- unique(data[[grouped_by]])
util_stop_if_not(length(groups) > 0)
if (length(groups) > 1) {
return(lapply(setNames(nm = groups), function(g) {
prep_render_pie_chart_from_summaryclasses_ggplot2(
data[data[[grouped_by]] == g, , FALSE], meta_data = meta_data)
}))
}
gg_colors <- util_get_colors()
names(gg_colors) <- util_get_labels_grading_class()[names(gg_colors)]
data$class <- factor(data$class,
levels = names(util_get_labels_grading_class()),
labels = util_get_labels_grading_class(),
ordered = TRUE
)
data <- data[order(data$class, -data$value, decreasing = TRUE), , FALSE]
p <- ggplot(data, aes(x = "",
y = value,
fill = class,
label = scales::percent(value / sum(value)))
) +
geom_bar(stat = "identity", width = 1) +
geom_text(position = ggplot2::position_stack(vjust = 0.5)) +
ggplot2::coord_polar("y", start = 0) +
scale_fill_manual(values = gg_colors) +
ggplot2::theme_minimal() +
ggplot2::theme(axis.line = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.title.x = ggplot2::element_blank(),
axis.title.y = ggplot2::element_blank(),
# legend.position = "none",
legend.title = ggplot2::element_blank(),
panel.background = ggplot2::element_blank(),
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
plot.background = ggplot2::element_blank())
if (identical(grouped_by, "indicator_metric")) { # TODO: Hiearchical structure support
title <- util_translate_indicator_metrics(groups, short = TRUE)
subtitle <- groups
} else if (identical(grouped_by, "call_names")) { # TODO: Hiearchical structure support
title <- util_map_labels(groups,
util_get_concept_info("implementations"),
to = "dq_report2_short_title",
from = "function_R",
ifnotfound = NA_character_)
subtitle <- groups
} else if (identical(grouped_by, as.character(STUDY_SEGMENT))) { # TODO: Hiearchical structure support
title <- groups
subtitle <- ""
} else if (identical(grouped_by, as.character(VAR_NAMES))) {
util_expect_data_frame(meta_data)
title <- prep_get_labels(groups,
meta_data = meta_data,
label_class = "LONG")
subtitle <- groups
} else if (identical(grouped_by, as.character("function_name"))) {
title <- vapply(groups, util_alias2caption, long = TRUE,
FUN.VALUE = character(1))
subtitle <- groups
} else {
title <- groups
subtitle <- NULL
# util_error("Unkown grouping by %s", sQuote(grouped_by))
}
p <- p + ggtitle(
title, subtitle
)
p
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.