Nothing
#' Plot IDEA4 results
#'
#' Produces ggplots and/or SVG source code with IDEA data produced by either \code{compute_idea()} or \code{old_idea()} call.
#'
#' @param IDEA_data an IDEA_data or IDEA_group_data object
#' @param choices Which type of plots should be produced ? Can be either "dimensions", "trees" or "radars" or a combination of these 3. Ignored if IDEA_data is of class \code{IDEA_group_data}.
#'
#' @return a named list of plots of class \code{IDEA_plots} or \code{IDEA_group_plots}. The algorithm also adds a "data" attribute containing data introduced in the input of this function.
#'
#' @details This function will produce different plots depending on whether the input data is of class \code{IDEA_data} or \code{IDEA_group_data}.
#'
#' The \code{IDEA_data} class implies that the data comes from an individual analysis pipeline, so individual plots will be produced according to the user's choices specified in the function call :
#'
#' \describe{
#' \item{dimensions}{This option will produce histograms for dimensions, components, and indicators along with a polarised synthetic representation for components.}
#' \item{trees}{This option will produce the colored trees describing the qualitative agregation in the property approach.}
#' \item{radars}{This option will produce polarised histograms (also called 'radars') giving the score (in %) of each indicator, grouped by property}
#' }
#'
#' Important note : All 3 types of plots are required for the "report" option of the \code{write_idea()} function.
#'
#' The \code{IDEA_group_data} class can only be generated by a "\code{diag_idea()}" group call which will iterate either "\code{read_idea() |> compute_idea()}" or "\code{old_idea()}" on each data file before aggregating results and assigning this grouped class.
#'
#' As the \code{IDEA_group_data} class implies that the data comes from a group analysis pipeline, the \code{choices} argument will be ignored. The plots produced for the dimension approach are almost the same as in the individual analysis pipeline but with the histograms being replaced by boxplots. Concerning properties, the only visualization currently considered as relevant is a matrix (or heatmap) of properties * farms, with the cells colored according to the qualitative evaluation for each farm for a given property.
#'
#' Note that plots are using a "\code{theme_idea()}" theme defined in this package.
#'
#' A copy of the blank canvas used for colored trees can be locally exported as svg files with :
#'
#' \code{IDEATools::show_canvas()}
#'
#' Further information about the colored trees ans canvas can be found in this vignette :
#'
#' \code{vignette("colored_trees", package = "IDEATools")}
#'
#' @export
#'
#' @encoding UTF-8
#'
#' @import data.table
#' @importFrom ggimage geom_image
#' @importFrom rlang check_installed
#' @importFrom ggplot2 ggplot geom_bar aes position_dodge geom_hline scale_fill_identity geom_label theme element_text element_blank guides scale_x_discrete labs coord_flip facet_wrap geom_rect geom_col geom_vline coord_polar ylim ggsave xlim theme_void unit geom_segment draw_key_rect scale_size_manual scale_color_manual scale_fill_manual guide_legend element_rect scale_y_continuous geom_tile position_stack scale_alpha_manual geom_text stat_boxplot geom_boxplot geom_point
#' @importFrom ggpubr ggtexttable ttheme colnames_style rownames_style tbody_style ggarrange
#' @importFrom ggtext geom_textbox
#' @importFrom stringi stri_trans_general
#' @importFrom tibble tribble
#'
#' @examples
#' library(IDEATools)
#'
#' ## Example given for a single analysis. See diag_idea() for a group analysis.
#' path <- system.file("example_data/idea_example_1.json", package = "IDEATools")
#' my_data <- read_idea(path)
#' computed_data <- compute_idea(my_data)
#'
#' ## Example without radars or dimensions
#' idea_plots <- plot_idea(computed_data, choices = c("trees"))
plot_idea <- function(IDEA_data, choices = c("dimensions", "trees", "radars")) {
## Check if correct input
if (!any(class(IDEA_data) %in% c("IDEA_data", "IDEA_group_data"))) (stop("The input data is not of class 'IDEA_data'"))
# Initializes the empty plot list to return
plotlist <- list()
# Individual analysis -----------------------------------------------------
if (any(class(IDEA_data) == "IDEA_data")) {
## If the user chooses "dimensions"
if (any(choices == "dimensions")) {
## Vector of colors for dimensions to use with each dimension plot
vec_colors <- c("A" = "#2e9c15", "B" = "#5077FE", "C" = "#FE962B")
data.table::setDT(reference_list[["indic_dim"]])
data.table::setDT(IDEA_data[["dataset"]])
## Dimensions dataset
res_dim <- unique(IDEA_data[["dataset"]][, index := 1][, lapply(.SD, unlist), by = index][, lapply(.SD, as.character), by = index][, .(dimension_code, dimension_value)])[reference_list[["indic_dim"]], on = "dimension_code"][, .(dimension_code, dimension_value, max_dim = 100L, dimension = vec_colors[dimension_code])] |>
unique() |>
transform(dimension_value = as.numeric(dimension_value))
## Finding the lowest dimension value
critiq <- min(res_dim$dimension_value)
## Create the plot
plot_dimensions <- ggplot2::ggplot(res_dim, aes(
x = dimension,
y = dimension_value, group = factor(dimension)
)) +
ggplot2::geom_bar(ggplot2::aes(x = dimension, y = max_dim, fill = dimension),
alpha = 0.3, color = "black", position = ggplot2::position_dodge(width = 0.8),
stat = "identity"
) +
ggplot2::geom_bar(ggplot2::aes(fill = dimension),
color = "black",
position = ggplot2::position_dodge(width = 0.8), stat = "identity"
) +
ggplot2::geom_hline(yintercept = critiq, color = "red", linewidth = 1.5, linetype = 5) +
ggplot2::scale_fill_identity() +
ggplot2::geom_label(ggplot2::aes(label = paste0(dimension_value, "/", max_dim)), fill = "white", size = 5) +
theme_idea(base_size = 16) +
ggplot2::theme(plot.caption = ggplot2::element_text(face = "bold")) +
ggplot2::theme(panel.grid = ggplot2::element_blank()) +
ggplot2::theme(
axis.title = ggplot2::element_blank(),
plot.title = ggplot2::element_blank()
) +
ggplot2::guides(fill = "none") +
ggplot2::scale_x_discrete(labels = c("Agro\u00e9cologique", "Socio-Territoriale", "Economique"))
lbl_dim <- reference_list[["indic_dim"]][, .(dim = dimension, dimension_code)] |> unique()
## Components dataset
res_compo <- unique(IDEA_data[["dataset"]][, index := 1][, lapply(.SD, unlist), by = index][, lapply(.SD, as.character), by = index][, .(dimension_code, dimension_value, component_code, component_value)])[reference_list[["indic_dim"]], on = c("dimension_code", "component_code")][, .(dimension, dimension_code, component_code, component, component_value, component_max)] |>
unique() |>
transform(component = sapply(component, FUN = wrapit, width = 40, USE.NAMES = FALSE)) |>
transform(component = factor(component, levels = rev(component))) |>
transform(dimension = vec_colors[dimension_code]) |>
merge(res_dim, by = c("dimension_code", "dimension")) |>
merge(lbl_dim, by = "dimension_code") |>
transform(facet_label = paste0("Dimension ", dim, " (", dimension_value, "/100)")) |>
transform(facet_label = factor(facet_label, levels = unique(facet_label))) |>
transform(component_value = as.numeric(component_value))
## Plot for components
plot_components <- ggplot2::ggplot(res_compo, ggplot2::aes(
x = component, y = component_value,
group = factor(dimension)
)) +
ggplot2::geom_bar(ggplot2::aes(x = component, y = component_max, fill = dimension),
alpha = 0.3, color = "black", position = ggplot2::position_dodge(width = 0.8),
stat = "identity"
) +
ggplot2::geom_bar(ggplot2::aes(fill = dimension),
color = "black",
position = ggplot2::position_dodge(width = 0.8), stat = "identity"
) +
ggplot2::facet_wrap(~facet_label, scales = "free", ncol = 1) +
ggplot2::geom_label(ggplot2::aes(label = paste0(component_value, "/", component_max)), fill = "white", size = 5.5) +
ggplot2::scale_fill_identity("Dimension", labels = c("Agro\u00e9cologique", "Socio-Territoriale", "Economique"), guide = "legend") +
theme_idea(base_size = 16) +
ggplot2::theme(axis.title = ggplot2::element_blank()) +
ggplot2::theme(panel.grid = ggplot2::element_blank(), strip.text = ggplot2::element_text(size = 18)) +
ggplot2::labs(fill = "Dimension", y = "Valeur de la composante / valeur max") +
ggplot2::theme(legend.position = "bottom") +
ggplot2::coord_flip()
## Indicators dataset
res_indic <- unique(IDEA_data[["dataset"]][, .(indic, scaled_value, component_value)]) |>
merge(reference_list[["indic_dim"]], by.x = "indic", by.y = "indic_code") |>
transform(indic_number = regmatches(indic, regexpr("[[:digit:]]+", indic))) |>
transform(full_name = paste0(indic, " - ", indic_name)) |>
transform(full_name = sapply(full_name, FUN = wrapit, width = 65, USE.NAMES = FALSE)) |>
transform(indic_number = as.numeric(indic_number)) |>
data.table::setorderv(cols = c("dimension_code", "indic_number")) |>
transform(full_name = factor(full_name, levels = rev(full_name))) |>
transform(component = paste0("Composante : ", component, " (", component_value, "/", component_max, ")")) |>
transform(component = sapply(component, FUN = wrapit, width = 70)) |>
transform(component = factor(component, levels = unique(component)))
### Agroecologie
## Subset for dimension A
df <- res_indic[dimension_code == "A"]
## Plot for indicators of dimension A
plot_indic_ae <- ggplot2::ggplot(df, ggplot2::aes(x = full_name, y = scaled_value)) +
ggplot2::geom_bar(ggplot2::aes(x = full_name, y = max_indic),
fill = "#2e9c15",
alpha = 0.3, color = "black", position = ggplot2::position_dodge(width = 0.8), stat = "identity"
) +
ggplot2::geom_bar(fill = "#2e9c15", color = "black", position = ggplot2::position_dodge(width = 0.8), stat = "identity") +
ggplot2::facet_wrap(~component, ncol = 1, scales = "free_y") +
ggplot2::geom_label(ggplot2::aes(label = paste0(scaled_value, "/", max_indic)), fill = "white", size = 4) +
theme_idea(base_size = 14) +
ggplot2::guides(fill = "none") +
ggplot2::labs(fill = "Dimension", y = "Valeur de l'indicateur / valeur max") +
ggplot2::theme(legend.position = "top") +
ggplot2::theme(axis.title = ggplot2::element_blank()) +
ggplot2::theme(panel.grid = ggplot2::element_blank()) +
ggplot2::coord_flip()
### Socio-Territorial
## Subset for dimension B
df <- res_indic[dimension_code == "B"]
## Plot for indicators of dimension B
plot_indic_st <- ggplot2::ggplot(df, ggplot2::aes(x = full_name, y = scaled_value, fill = dimension)) +
ggplot2::geom_bar(ggplot2::aes(x = full_name, y = max_indic),
fill = "#5077FE",
alpha = 0.3, color = "black", position = ggplot2::position_dodge(width = 0.8), stat = "identity"
) +
ggplot2::geom_bar(fill = "#5077FE", color = "black", position = ggplot2::position_dodge(width = 0.8), stat = "identity") +
ggplot2::facet_wrap(~component, ncol = 1, scales = "free_y") +
ggplot2::geom_label(ggplot2::aes(label = paste0(scaled_value, "/", max_indic)), fill = "white", size = 4) +
theme_idea(base_size = 14) +
ggplot2::guides(fill = "none") +
ggplot2::labs(fill = "Dimension", y = "Valeur de l'indicateur / valeur max") +
ggplot2::theme(legend.position = "top") +
ggplot2::theme(axis.title = ggplot2::element_blank()) +
ggplot2::theme(panel.grid = ggplot2::element_blank()) +
ggplot2::coord_flip()
### Economique
## Subset dimension C
df <- res_indic[dimension_code == "C"]
## Plot for indicators of dimension C
plot_indic_ec <- ggplot2::ggplot(df, ggplot2::aes(x = full_name, y = scaled_value, fill = dimension)) +
ggplot2::geom_bar(ggplot2::aes(x = full_name, y = max_indic),
fill = "#FE962B",
alpha = 0.3, color = "black", position = ggplot2::position_dodge(width = 0.8), stat = "identity"
) +
ggplot2::geom_bar(fill = "#FE962B", color = "black", position = ggplot2::position_dodge(width = 0.8), stat = "identity") +
ggplot2::facet_wrap(~component, ncol = 1, scales = "free_y") +
ggplot2::geom_label(ggplot2::aes(label = paste0(scaled_value, "/", max_indic)), fill = "white", size = 4) +
theme_idea(base_size = 14) +
ggplot2::guides(fill = "none") +
ggplot2::labs(fill = "Dimension", y = "Valeur de l'indicateur / valeur max") +
ggplot2::theme(legend.position = "top") +
ggplot2::theme(axis.title = ggplot2::element_blank()) +
ggplot2::theme(panel.grid = ggplot2::element_blank()) +
ggplot2::coord_flip()
### Polarised components plot
# temporary pdf file
temp_pdf <- file.path(tempdir(), "plot.pdf")
# data for standardized components (%)
component_data <- res_compo |>
transform(score = round((component_value / component_max) * 100)) |>
transform(component_code = factor(component_code, levels = unique(component_code)))
## First plot : Polarised histogram exported to pdf
donut <- ggplot2::ggplot(component_data, ggplot2::aes(x = component_code, y = score, fill = dimension)) +
ggplot2::geom_rect(xmin = 0, xmax = 13, ymin = -3, ymax = 0, fill = "black") +
ggplot2::geom_col(color = "black", width = 1) +
ggplot2::geom_vline(xintercept = c(seq(0.5, 13.5, 1)), color = "black") +
ggplot2::geom_hline(yintercept = c(0, 20, 40, 60, 80, 100), color = "black") +
ggplot2::geom_label(x = 0.5, y = 20, label = "20%", size = 5, inherit.aes = FALSE) +
ggplot2::geom_label(x = 0.5, y = 40, label = "40%", size = 5, inherit.aes = FALSE) +
ggplot2::geom_label(x = 0.5, y = 60, label = "60%", size = 5, inherit.aes = FALSE) +
ggplot2::geom_label(x = 0.5, y = 80, label = "80%", size = 5, inherit.aes = FALSE) +
ggplot2::scale_fill_identity() +
ggplot2::coord_polar() +
ggplot2::ylim(-3, 100) +
ggplot2::theme(
panel.background = ggplot2::element_blank(),
panel.border = ggplot2::element_blank(),
axis.text = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank(),
axis.title = ggplot2::element_blank()
) +
ggplot2::guides(fill = "none")
ggplot2::ggsave(temp_pdf, plot = donut, dpi = 320, width = 10.1, height = 7.53, device = cairo_pdf)
## Preparing surrounding donut
donut_data <- data.frame(
category = c("#2e9c15", "#5077FE", "#FE962B"),
count = c(38.46, 30.7, 30.7)
)
donut_data$fraction <- donut_data$count / sum(donut_data$count)
donut_data$ymax <- cumsum(donut_data$fraction)
donut_data$ymin <- c(0, head(donut_data$ymax, n = -1))
## Locate the "img" folder
img_folder <- system.file("img", package = "IDEATools")
## Create a tibble with file paths for each component
path_tab <- tibble::tribble(
~component_code, ~path,
"COMP1", "picto_div.png",
"COMP2", "picto_flux.png",
"COMP3", "picto_ressources.png",
"COMP4", "picto_production.png",
"COMP5", "picto_sante.png",
"COMP6", "picto_alimentation.png",
"COMP7", "picto_circulaire.png",
"COMP8", "picto_emploi.png",
"COMP9", "picto_ethique.png",
"COMP10", "picto_economique.png",
"COMP11", "picto_independance.png",
"COMP12", "picto_transmissibilite.png",
"COMP13", "picto_efficience.png"
) |>
transform(path = file.path(img_folder, path))
## Arrange component data and join with paths
path_data <- component_data |>
transform(order = 1:13) |>
merge(path_tab, by = c("component_code")) |>
data.table::setorderv(cols = c("order"))
# Make the polarised plot
plot_components_polarised <- ggplot2::ggplot(donut_data, ggplot2::aes(
ymax = ymax, ymin = ymin,
xmax = 3.45, xmin = 3, label = category
)) +
ggimage::geom_image(ggplot2::aes(x = 2.0, y = 1), image = temp_pdf, size = I(0.46)) +
ggplot2::geom_rect(ggplot2::aes(fill = category), color = "black", alpha = 0.6) +
ggimage::geom_image(ggplot2::aes(x = 3.35, y = 0.1823), image = file.path(img_folder, "TEXT_AE.png"), size = I(0.13), color = "#2e9c15") +
ggimage::geom_image(ggplot2::aes(x = 3.45, y = 0.5431), image = file.path(img_folder, "TEXT_ST.png"), size = I(0.27), color = "#5077FE") +
ggimage::geom_image(ggplot2::aes(x = 3.45, y = 0.8451), image = file.path(img_folder, "TEXT_ECO.png"), size = I(0.15), color = "#FE962B") +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.15 / 4), image = path_data$path[1], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.23 / 4 * 2), image = path_data$path[2], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.19), image = path_data$path[3], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.27), image = path_data$path[4], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.34), image = path_data$path[5], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.42), image = path_data$path[6], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.499), image = path_data$path[7], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.575), image = path_data$path[8], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.66), image = path_data$path[9], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.735), image = path_data$path[10], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.805), image = path_data$path[11], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.885), image = path_data$path[12], size = I(0.05)) +
ggimage::geom_image(ggplot2::aes(x = 3.225, y = 0.965), image = path_data$path[13], size = I(0.05)) +
ggplot2::coord_polar(theta = "y") +
ggplot2::scale_fill_identity() +
ggplot2::xlim(c(2, 4.9)) +
ggplot2::theme_void() +
ggplot2::guides(fill = "none") +
ggplot2::theme(plot.margin = ggplot2::unit(c(-5, -5, -5, -5), "cm"))
## Aggregate plots in the return plotlist
plotlist$dimensions <- list(
plot_dimensions = plot_dimensions,
plot_components = plot_components,
plot_components_polarised = plot_components_polarised,
plot_indic_ae = plot_indic_ae,
plot_indic_st = plot_indic_st,
plot_indic_ec = plot_indic_ec
)
}
## If user chooses "trees"
if (any(choices == "trees")) {
# Empty return list
prop_list <- list()
## For loop on each property + another synthetic one
for (prop in names(IDEA_data$nodes)) {
structure_list <- tree_structure[[prop]]
nodes <- structure_list$nodes
lines <- structure_list$lines
if (prop != "Global") {
data.table::setDT(IDEA_data$nodes[[prop]])
IDEA_data$nodes[[prop]]$index <- 1
pivoted_data <- IDEA_data$nodes[[prop]][, data.table::melt(.SD, id.vars = "index")]
merged_data <- pivoted_data[, .(indic_code = variable, value)] |>
merge(reference_list$indic_prop, by = "indic_code")
leaves <- merged_data[, prop_code := paste(prop_code, collapse = " "), by = c("indic_code")][, name := paste0(indic_code, "/", prop_code, " ", indic_name)][, .(prop_code, name, value)][, code := sub("\\/.*", "", name)][, .(code, name, value)]
merged_data <- pivoted_data[, .(node_code = variable, value)] |>
merge(reference_list$properties_nodes, by = "node_code")
branches <- merged_data[, .(code = node_code, name = node_name, value)]
data_table <- rbind(leaves, branches) |>
transform(value = paste0(toupper(substr(value, 1, 1)), substr(value, 2, nchar(value))))
rect_df_full <- data_table |>
merge(nodes, by = "code") |>
transform(name = ifelse(name == "Robustesse", yes = "ROBUSTESSE", no = name)) |>
transform(name = ifelse(name == "par l'insertion dans les r\u00e9seaux", yes = "Par l'insertion dans les r\u00e9seaux", no = name)) |>
transform(name = ifelse(name == "Autonomie", yes = toupper(name), no = name)) |>
transform(name = ifelse(name == "Ancrage territorial", yes = toupper(name), no = name)) |>
transform(name = ifelse(name == "Capacit\u00e9 productive et reproductive de biens et de services", yes = "CAPACIT\uc9 PRODUCTIVE ET REPRODUCTIVE DE BIENS ET DE SERVICES", no = name)) |>
transform(name = ifelse(name == "Responsabilit\u00e9 globale", yes = "RESPONSABILIT\uc9 GLOBALE", no = name)) |>
##### ADD OTHERS
transform(col = ifelse(value %in% c("Tr\u00e8s d\u00e9favorable", "Tr\u00e8s favorable"), yes = "white", no = "black"))
if (prop == "Robustesse") {
main <- tibble::tibble(rect_df_full[!code %in% c("R9", "R2"), ])
bonus <- tibble::tibble(rect_df_full[code %in% c("R9", "R2"), ])
prop_list[[prop]] <- ggplot2::ggplot() +
ggplot2::xlim(c(-120, 305)) +
ggplot2::ylim(c(15, 210)) +
ggplot2::geom_segment(data = lines, ggplot2::aes(x = x, y = y, xend = xend, yend = yend), size = 2) +
ggtext::geom_textbox(data = main, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("5.2", "inch"), height = ggplot2::unit("1.2", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("5", "inch"), height = ggplot2::unit("2", "inch"), box.size = 2) +
ggplot2::scale_size_manual(values = c("very very big" = 15, "very big" = 13, "big" = 10, "small" = 7), guide = "none") +
ggplot2::scale_color_manual(values = c("white" = "white", "black" = "black"), guide = "none") +
ggplot2::scale_fill_manual("\uc9valuation", values = color_values, guide = ggplot2::guide_legend(ncol = 6)) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = c(0.5, 0.03), legend.text = ggplot2::element_text(size = 40), legend.title = ggplot2::element_text(size = 45, face = "bold"), legend.direction = "horizontal", legend.key.width = ggplot2::unit(20, "mm"), legend.key = ggplot2::element_rect(color = "black", size = 4))
}
if (prop == "Capacite") {
main <- rect_df_full[!code %in% c("CP7", "CP9", "CP10", "CP5", "CP6", "CP8"), ]
bonus <- rect_df_full[code %in% c("CP7", "CP9", "CP5", "CP6", "CP8"), ]
bonus_prop <- rect_df_full[code %in% c("CP10"), ]
prop_list[[prop]] <- ggplot2::ggplot() +
ggplot2::xlim(c(-450, 330)) +
ggplot2::ylim(c(-10, 215)) +
ggplot2::geom_segment(data = lines, ggplot2::aes(x = x, y = y, xend = xend, yend = yend), size = 2) +
ggtext::geom_textbox(data = main, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("6.2", "inch"), height = ggplot2::unit("1.2", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("6", "inch"), height = ggplot2::unit("2.2", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus_prop, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("8", "inch"), height = ggplot2::unit("3", "inch"), box.size = 2) +
ggplot2::scale_size_manual(values = c("very very big" = 15, "very big" = 13, "big" = 12, "small" = 8.5), guide = "none") +
ggplot2::scale_color_manual(values = c("white" = "white", "black" = "black"), guide = "none") +
ggplot2::scale_fill_manual("\uc9valuation", values = color_values, guide = ggplot2::guide_legend(ncol = 6)) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = c(0.5, 0.03), legend.text = ggplot2::element_text(size = 45), legend.title = ggplot2::element_text(size = 55, face = "bold"), legend.direction = "horizontal", legend.key.width = ggplot2::unit(20, "mm"), legend.key = ggplot2::element_rect(color = "black", size = 4))
}
if (prop == "Autonomie") {
main <- rect_df_full[!code %in% c("AU3", "AU5", "AU4"), ]
bonus <- rect_df_full[code %in% c("AU3", "AU5", "AU4"), ]
prop_list[[prop]] <- ggplot2::ggplot() +
ggplot2::xlim(c(-200, 320)) +
ggplot2::ylim(c(20, 210)) +
ggplot2::geom_segment(data = lines, ggplot2::aes(x = x, y = y, xend = xend, yend = yend), size = 2) +
ggtext::geom_textbox(data = main, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("5.2", "inch"), height = ggplot2::unit("1.2", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("8", "inch"), height = ggplot2::unit("2", "inch"), box.size = 2) +
ggplot2::scale_size_manual(values = c("very very big" = 15, "very big" = 13, "big" = 10, "small" = 7), guide = "none") +
ggplot2::scale_color_manual(values = c("white" = "white", "black" = "black"), guide = "none") +
ggplot2::scale_fill_manual("\uc9valuation", values = color_values, guide = ggplot2::guide_legend(ncol = 6)) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = c(0.5, 0.03), legend.text = ggplot2::element_text(size = 35), legend.title = ggplot2::element_text(size = 33, face = "bold"), legend.direction = "horizontal", legend.key.width = ggplot2::unit(20, "mm"), legend.key = ggplot2::element_rect(color = "black", size = 4))
}
if (prop == "Responsabilite") {
main <- rect_df_full[!code %in% paste0("RG", 1:15), ]
bonus <- rect_df_full[code %in% paste0("RG", 1:15), ]
prop_list[[prop]] <- ggplot2::ggplot() +
ggplot2::xlim(c(-270, 320)) +
ggplot2::ylim(c(20, 370)) +
ggplot2::geom_segment(data = lines, ggplot2::aes(x = x, y = y, xend = xend, yend = yend), size = 2) +
ggtext::geom_textbox(data = main, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("8", "inch"), height = ggplot2::unit("1.2", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("8", "inch"), height = ggplot2::unit("2", "inch"), box.size = 2) +
ggplot2::scale_size_manual(values = c("very very big" = 18, "very big" = 15, "big" = 12.5, "small" = 10), guide = "none") +
ggplot2::scale_color_manual(values = c("white" = "white", "black" = "black"), guide = "none") +
ggplot2::scale_fill_manual("\uc9valuation", values = color_values, guide = ggplot2::guide_legend(ncol = 6)) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = c(0.5, 0.03), legend.text = ggplot2::element_text(size = 50), legend.title = ggplot2::element_text(size = 55, face = "bold"), legend.direction = "horizontal", legend.key.width = ggplot2::unit(20, "mm"), legend.key = ggplot2::element_rect(color = "black", size = 4))
}
if (prop == "Ancrage") {
main <- rect_df_full[!code %in% c("AN2", "AN1", "AN4", "AN5"), ]
bonus <- rect_df_full[code %in% c("AN2", "AN1", "AN4", "AN5"), ]
prop_list[[prop]] <- ggplot2::ggplot() +
ggplot2::xlim(c(-120, 313)) +
ggplot2::ylim(c(80, 210)) +
ggplot2::geom_segment(data = lines, ggplot2::aes(x = x, y = y, xend = xend, yend = yend), size = 2) +
ggtext::geom_textbox(data = main, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("5.2", "inch"), height = ggplot2::unit("1.2", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("6", "inch"), height = ggplot2::unit("2", "inch"), box.size = 2) +
ggplot2::scale_size_manual(values = c("very very big" = 15, "very big" = 13, "big" = 10, "small" = 7), guide = "none") +
ggplot2::scale_color_manual(values = c("white" = "white", "black" = "black"), guide = "none") +
ggplot2::scale_fill_manual("\uc9valuation", values = color_values, guide = ggplot2::guide_legend(ncol = 6)) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = c(0.5, 0.03), legend.text = ggplot2::element_text(size = 35), legend.title = ggplot2::element_text(size = 40, face = "bold"), legend.direction = "horizontal", legend.key.width = ggplot2::unit(20, "mm"), legend.key = ggplot2::element_rect(color = "black", size = 4))
}
} else {
data.table::setDT(IDEA_data$nodes[[prop]])
## Fixing error in reference table
nodes[14, 1] <- "AN4"
pivoted_data <- IDEA_data$nodes[["Global"]][, data.table::melt(.SD, id.vars = "index")]
branches <- pivoted_data |>
merge(reference_list$properties_nodes, by.x = "variable", by.y = "node_code")
branches <- branches[, .(code = variable, name = node_name, value)]
data_table <- branches |>
transform(value = paste0(toupper(substr(value, 1, 1)), substr(value, 2, nchar(value))))
rect_df_full <- data_table |>
merge(nodes, by = "code") |>
transform(name = ifelse(name == "Robustesse", yes = "ROBUSTESSE", no = name)) |>
transform(name = ifelse(name == "Capacit\u00e9 productive et reproductive de biens et de services", yes = "CAPACIT\uc9 PRODUCTIVE ET REPRODUCTIVE DE\u00A0 BIENS ET DE SERVICES", no = name)) |>
transform(name = ifelse(name == "Capacit\u00e9 \u00e0 produire dans le temps des biens et services remun\u00e9r\u00e9s", yes = "Capacit\u00e9 \u00e0 produire dans le temps des\u00A0biens\u00A0et services remun\u00e9r\u00e9s", no = name)) |>
transform(name = ifelse(name == "Disposer d'une libert\u00e9 de d\u00e9cision dans ses choix de gouvernance et de production", yes = "Disposer d'une libert\u00e9 de d\u00e9cision\u00A0dans \u00A0ses\u00A0choix de gouvernance et de production", no = name)) |>
transform(name = ifelse(name == "Autonomie", yes = "AUTONOMIE", no = name)) |>
transform(name = sapply(name, FUN = wrapit, width = 45, USE.NAMES = FALSE)) |>
transform(name = ifelse(name == "Ancrage territorial", yes = "ANCRAGE TERRITORIAL", no = name)) |>
transform(name = ifelse(name == "Responsabilit\u00e9 globale", yes = "RESPONSABILIT\uc9 GLOBALE", no = name)) |>
transform(col = ifelse(value %in% c("Tr\u00e8s d\u00e9favorable", "Tr\u00e8s favorable"), yes = "white", no = "black"))
main <- rect_df_full[!code %in% c("CP10"), ] |> tibble::tibble()
bonus <- rect_df_full[code %in% c("CP10"), ] |> tibble::tibble()
prop_list[[prop]] <- ggplot2::ggplot() +
ggplot2::xlim(c(-270, 320)) +
ggplot2::ylim(c(120, 370)) +
ggplot2::geom_segment(data = lines, ggplot2::aes(x = x, y = y, xend = xend, yend = yend), size = 2) +
ggtext::geom_textbox(data = main, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("9", "inch"), height = ggplot2::unit("1.8", "inch"), box.size = 2) +
ggtext::geom_textbox(data = bonus, ggplot2::aes(x = x, y = y, label = name, fill = value, size = size, text.color = col), halign = 0.5, valign = 0.5, show.legend = TRUE, key_glyph = ggplot2::draw_key_rect, width = ggplot2::unit("8", "inch"), height = ggplot2::unit("3", "inch"), box.size = 2) +
ggtext::geom_textbox(ggplot2::aes(x = 25, y = 280), label = "Exploitation agricole", fill = "white", size = 25, text.color = "black", halign = 0.5, valign = 0.5, width = ggplot2::unit("10", "inch"), height = ggplot2::unit("3", "inch"), box.size = 2) +
ggplot2::scale_size_manual(values = c("very very big" = 20, "very big" = 15, "big" = 15, "small" = 12), guide = "none") +
ggplot2::scale_color_manual(values = c("white" = "white", "black" = "black"), guide = "none") +
ggplot2::scale_fill_manual("\uc9valuation", values = color_values, guide = ggplot2::guide_legend(ncol = 6)) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = c(0.5, 0.03), legend.text = ggplot2::element_text(size = 45), legend.title = ggplot2::element_text(size = 50, face = "bold"), legend.key.width = ggplot2::unit(20, "mm"), legend.direction = "horizontal", legend.key = ggplot2::element_rect(color = "black", size = 4))
}
}
## Add the list of trees to the return plotlist
plotlist$trees <- prop_list
}
## If the user chooses "radars"
if (any(choices == "radars")) {
## Vector of colors for dimensions to use with each dimension plot
vec_colors <- c("A" = "#2e9c15", "B" = "#5077FE", "C" = "#FE962B")
data.table::setDT(IDEA_data$dataset)
## Creating a dataset with standardised indicators (%)
prop_radar <- merge(
unique(IDEA_data$dataset[, .(indic_code = indic, scaled_value)]),
reference_list$indic_dim,
by = "indic_code"
)[, indic_number := regmatches(indic_code, regexpr("[[:digit:]]+", indic_code))] |>
transform(indic_number = as.numeric(indic_number)) |>
data.table::setorderv(cols = c("dimension_code", "indic_number")) |>
transform(score_indic = round(scaled_value / max_indic * 100, 0)) |>
transform(dimension = vec_colors[dimension_code])
## Names
prop_names <- c(
"Ancrage",
"Autonomie",
"Robustesse",
"Responsabilite",
"Capacite"
)
# Empty list
radarlist <- list()
# For loop on each property
for (i in prop_names) {
## Get the list of indicators of a given property
list_indic_prop <- indic_codes[[i]]
# Get the name and the y position of each label
label_data <- prop_radar[indic_code %in% list_indic_prop, ]
label_data$id <- seq(1, nrow(label_data))
number_of_bar <- nrow(label_data)
angle <- 90 - 360 * (label_data$id - 0.5) / number_of_bar
label_data$hjust <- ifelse(angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle + 180, angle)
label_data <- label_data[score_indic > 5, ]
## Build the table on the side of the plot
mytable <- prop_radar[indic_code %in% list_indic_prop, .(indic_code = as.character(indic_code))] |>
merge(reference_list$indic_dim, by = "indic_code") |>
transform(indic_number = regmatches(indic_code, regexpr("[[:digit:]]+", indic_code))) |>
transform(indic_number = as.numeric(indic_number)) |>
transform(indic_name = sapply(indic_name, FUN = wrapit, width = 45, USE.NAMES = FALSE)) |>
data.table::setorderv(cols = c("dimension_code", "indic_number"))
mytable <- unique(mytable[, .(Code = indic_code, `Nom de l'indicateur` = indic_name)])
## Re-identifying names
prop_names <- c(
"Ancrage",
"Autonomie",
"Robustesse",
"Responsabilite",
"Capacite"
)
## (Manually) assigning colors to the table rows according to dimension
colors <- list(
Robustesse = c(rep("#2e9c15", 6), rep("#5077FE", 5), rep("#FE962B", 5)),
"Capacite" = c(rep("#2e9c15", 3), rep("#5077FE", 7), rep("#FE962B", 4)),
Autonomie = c(rep("#2e9c15", 3), rep("#5077FE", 4), rep("#FE962B", 3)),
"Responsabilite" = c(rep("#2e9c15", 8), rep("#5077FE", 13), "#FE962B"),
`Ancrage` = c(rep("#5077FE", 9))
)
## Extracting the right color in this iteration of the loop
mycols <- colors[[i]]
## Creating the table
tab <- ggpubr::ggtexttable(mytable, rows = NULL, theme = ggpubr::ttheme(
colnames.style = ggpubr::colnames_style(color = "black", size = 17, fill = "transparent", linecolor = "black"),
rownames.style = ggpubr::rownames_style(fill = "transparent", size = 15, linecolor = "black"),
tbody.style = ggpubr::tbody_style(fill = mycols, size = 15, linecolor = "black")
))
## Full property name for the plot title
full_prop_name <- switch(i,
"Ancrage" = "Ancrage Territorial",
"Autonomie" = "Autonomie",
"Robustesse" = "Robustesse",
"Responsabilite" = "Responsabilit\u00e9 globale",
"Capacite" = "Capacit\u00e9 productive et reproductive \nde biens et de services"
)
## Building legend
list_dimensions <- unique(prop_radar[indic_code %in% list_indic_prop, dimension_code])
# A simple vector with dimension names
vec_dim <- c("A" = "Agro\u00e9cologique", "B" = "Socio-Territoriale", "C" = "Economique")
## The vector that will be used for legend
vec_legend <- unname(vec_dim[list_dimensions])
## Creating the radar plot (polarised histogram)
p <- ggplot2::ggplot(
prop_radar[indic_code %in% list_indic_prop, ],
ggplot2::aes(x = indic_code, y = score_indic, fill = dimension)
) +
ggplot2::geom_rect(xmin = -Inf, ymin = -20, xmax = Inf, ymax = 100, fill = "white", color = "white") +
ggplot2::geom_col(ggplot2::aes(x = indic_code, y = 100, fill = dimension), alpha = 0.3, color = "black") +
ggplot2::geom_col() +
ggplot2::geom_label(ggplot2::aes(label = paste0(score_indic, "%"))) +
ggplot2::scale_fill_identity("Dimension", labels = vec_legend, guide = "legend") +
theme_idea() +
ggplot2::scale_y_continuous(limits = c(-20, 130), breaks = c(0, 20, 40, 60, 80, 100)) +
ggplot2::theme(axis.text.x = ggplot2::element_text(size = 13, color = "black", face = "bold")) +
ggplot2::theme(axis.text.y = ggplot2::element_blank()) +
ggplot2::theme(axis.title = ggplot2::element_blank()) +
ggplot2::theme(panel.grid = ggplot2::element_blank()) +
ggplot2::labs(fill = "Dimension", title = paste0("Indicateurs de la propri\u00e9t\u00e9 ", full_prop_name, "")) +
ggplot2::theme(legend.position = "top") +
ggplot2::coord_polar()
## Adding the combination plot + table to return list
radarlist[[paste0("radar_", i)]] <- ggpubr::ggarrange(p, tab)
}
## Adding to the output plotlist
plotlist$radars <- radarlist
}
# Saving original data in the list for future usage in write_idea.
plotlist$data$metadata <- IDEA_data$metadata
plotlist$data$dataset <- IDEA_data$dataset
plotlist$data$nodes <- IDEA_data$nodes
## Assigning the appropriate class
class(plotlist) <- c(class(plotlist), "IDEA_plots")
}
# Group analysis ----------------------------------------------------------
if (any(class(IDEA_data) == "IDEA_group_data")) {
# Number of farms
n_farms <- length(unique(IDEA_data$dataset$farm_id))
vec_colors <- c(
"favorable" = "#33FF00",
"defavorable" = "#FF6347",
"tres defavorable" = "#CD0000",
"tres favorable" = "#008B00"
)
## Heatmap for properties
heatmap_data <- IDEA_data$nodes$Global[, data.table::melt(.SD, id.vars = "farm_id")] |>
merge(reference_list$properties_nodes, by.x = "variable", by.y = "node_code") |>
subset(level == "propriete") |>
transform(node_name = ifelse(node_name == "Capacit\u00e9 productive et reproductive de biens et de services", yes = "Capacit\u00e9 productive et \n reproductive de biens et de \n services", no = node_name)) |>
transform(result_ascii = stringi::stri_trans_general(value, id = "Latin-ASCII")) |>
transform(result_ascii = factor(result_ascii, levels = c("tres defavorable", "defavorable", "favorable", "tres favorable"))) |>
data.table::setorderv(cols = c("result_ascii"))
## Building legend
legend_names <- unique(heatmap_data[, value])
heatmap <- heatmap_data |>
transform(value = stringi::stri_trans_general(value, id = "Latin-ASCII")) |>
transform(value = vec_colors[value]) |>
transform(node_name = sapply(node_name, FUN = wrapit, width = 30, USE.NAMES = FALSE)) |>
transform(value = factor(value, levels = c("#CD0000", "#FF6347", "#33FF00", "#008B00"))) |>
ggplot2::ggplot(ggplot2::aes(farm_id, node_name, fill = value)) +
ggplot2::geom_tile(color = "black") +
ggplot2::scale_fill_identity("\uc9valuation", labels = legend_names, guide = "legend") +
ggplot2::labs(x = "Exploitations agricoles", y = "Propri\u00e9t\u00e9", fill = "\uc9valuation") +
theme_idea() +
ggplot2::theme(axis.title.y = ggplot2::element_blank(), axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
freq_data <- heatmap_data[, .(node_name, value)][, .(n = .N), by = .(node_name, value)][, prop := n / sum(n) * 100, by = node_name][, value := stringi::stri_trans_general(value, id = "Latin-ASCII")][, value := vec_colors[value]][, value := factor(value, levels = c("#CD0000", "#FF6347", "#33FF00", "#008B00"))] |>
transform(node_name = sapply(node_name, FUN = wrapit, width = 30, USE.NAMES = FALSE))
freq_plot <- ggplot2::ggplot(freq_data, aes(x = node_name, y = prop, fill = value)) +
ggplot2::geom_col(position = "stack", color = "black") +
ggplot2::geom_label(ggplot2::aes(label = paste0(round(prop), "%")), position = ggplot2::position_stack(vjust = 0.5)) +
ggplot2::scale_fill_identity("\uc9valuation", labels = legend_names, guide = "legend") +
theme_idea() +
ggplot2::coord_flip() +
ggplot2::labs(x = "", y = "Fr\u00e9quence (%)") +
ggplot2::scale_y_continuous(breaks = seq(0, 100, 5))
## Histograms for dimensions
setDT(IDEA_data$dataset)
setDT(reference_list$indic_dim)
## Data for dimensions
dim_data <- unique(IDEA_data$dataset[, .(farm_id, dimension_code, dimension_value = as.numeric(dimension_value))])[, alpha := "b"]
## dataframe with an "alpha" argument
alpha <- dim_data[, .(farm_id, dimension_code, dimension_value = 100 - dimension_value, alpha = "a")]
## Vector of colors for dimensions to use with each dimension plot
vec_colors <- c("A" = "#2e9c15", "B" = "#5077FE", "C" = "#FE962B")
## Full data for the dimension histogram
hist_data <- rbind(dim_data, alpha) |>
transform(label = ifelse(alpha == "a", yes = "", no = paste0(dimension_value, "/100"))) |>
merge(unique(reference_list$indic_dim[, .(dimension, dimension_code)]), by = "dimension_code") |>
subset(select = c(dimension, dimension_value, dimension_code, farm_id, label, alpha)) |>
unique() |>
transform(dimension = vec_colors[dimension_code]) |>
data.table::setorderv(cols = c("dimension_code"), order = -1) |>
transform(dimension = factor(dimension, levels = unique(dimension)))
# Plotting dimensions histogram
dimensions_histogram <- ggplot2::ggplot(hist_data, ggplot2::aes(x = farm_id, y = dimension_value, label = label, fill = dimension, alpha = alpha)) +
ggplot2::scale_alpha_manual(values = c(0.6, 1)) +
ggplot2::guides(alpha = "none") +
ggplot2::geom_col(color = "black") +
ggplot2::geom_text(ggplot2::aes(x = farm_id, y = dimension_value, label = label), position = ggplot2::position_stack(vjust = 0.5)) +
ggplot2::scale_fill_identity("Dimension", labels = c("Economique", "Socio-Territoriale", "Agro\u00e9cologique"), guide = guide_legend(reverse = TRUE)) +
theme_idea() +
ggplot2::ylim(0, 300) +
ggplot2::labs(x = "Exploitations agricoles", y = "Score", fill = "Dimension") +
ggplot2::coord_flip()
# Boxplots ----------------------------------------------------------------
## Dimensions
## Dimension data
boxplot_dim_data <- dim_data |>
merge(unique(reference_list$indic_dim[, .(dimension, dimension_code)]), by = "dimension_code") |>
subset(select = c(farm_id, dimension_code, dimension, dimension_value)) |>
unique() |>
transform(dimension = vec_colors[dimension_code])
## Estimating means to add on the boxplot
means <- boxplot_dim_data[, .(Mean = mean(dimension_value)), by = dimension]
## Plotting dimensions boxplot
dimensions_boxplot <- ggplot2::ggplot(boxplot_dim_data, ggplot2::aes(x = dimension, y = dimension_value)) +
ggplot2::stat_boxplot(geom = "errorbar", width = 0.3) +
ggplot2::geom_boxplot(color = "black", ggplot2::aes(fill = dimension), width = 0.8) +
ggplot2::geom_point(data = means, ggplot2::aes(x = dimension, y = Mean, color = "Moyenne"), size = 4, shape = 18) +
theme_idea() +
ggplot2::scale_fill_identity("Dimension", labels = c("Agro\u00e9cologique", "Socio-Territoriale", "Economique"), guide = "legend") +
ggplot2::scale_color_manual(name = "L\u00e9gende", values = c("darkred")) +
ggplot2::theme(axis.title.x = ggplot2::element_blank()) +
ggplot2::labs(y = "Valeur de la dimension", fill = "Dimension", caption = paste0("(N = ", n_farms, ")")) +
ggplot2::theme(legend.position = "right") +
ggplot2::scale_y_continuous(breaks = seq(0, 100, 10), limits = c(0, 100)) +
ggplot2::scale_x_discrete(labels = c("Agro\u00e9cologique", "Socio-Territoriale", "Economique"))
## Components
## Component data
compo_data <- IDEA_data$dataset |>
merge(unique(reference_list$indic_dim[, .(dimension_code, component_code, component_max, component, dimension)]), by = c("dimension_code", "component_code")) |>
subset(select = c(farm_id, dimension_code, dimension, component_code, component, component_value, component_max)) |>
unique() |>
transform(min_compo = 0) |>
transform(component = sapply(component, FUN = wrapit, width = 60, USE.NAMES = FALSE)) |>
transform(component = factor(component, levels = rev(unique(component)))) |>
transform(dimension = factor(dimension, levels = c("Agro\u00e9cologique", "Socio-Territoriale", "Economique")))
## Estimating means to add on the boxplot
means <- compo_data[, .(Mean = mean(component_value)), by = .(dimension, component, component_code)]
## Plotting components boxplot
components_boxplot <- ggplot2::ggplot(compo_data, ggplot2::aes(x = component, y = component_value)) +
ggplot2::stat_boxplot(geom = "errorbar", width = 0.3) +
ggplot2::geom_boxplot(color = "black", ggplot2::aes(fill = dimension), width = 0.8) +
ggplot2::geom_point(data = means, ggplot2::aes(x = component, y = Mean, color = "Moyenne"), size = 4, shape = 18) +
ggplot2::geom_point(ggplot2::aes(y = component_max), shape = 93, size = 5, color = "red") +
ggplot2::geom_point(ggplot2::aes(y = min_compo), shape = 91, size = 5, color = "red") +
theme_idea() +
ggplot2::scale_fill_manual(values = c("#2e9c15", "#5077FE", "#FE962B")) +
ggplot2::scale_color_manual(values = c("darkred")) +
ggplot2::theme(axis.title.y = ggplot2::element_blank()) +
ggplot2::labs(y = "Valeur de la composante", fill = "Dimension", color = "L\u00e9gende", caption = paste0("(N = ", n_farms, ")")) +
ggplot2::coord_flip() +
ggplot2::guides(fill = "none") +
ggplot2::facet_wrap(~dimension, ncol = 1, scales = "free", drop = TRUE) +
ggplot2::scale_y_continuous(breaks = seq(0, 100, 5))
## Indicators
## Agroecologie
## Subset for dimension A
indic_data <- IDEA_data$dataset[, .(indic_code = indic, scaled_value, dimension_code, component_code, component_value)] |>
merge(reference_list$indic_dim, by = c("indic_code", "dimension_code", "component_code")) |>
subset(dimension_code == "A") |>
transform(full_name = paste0(indic_code, " - ", indic_name)) |>
transform(full_name = sapply(full_name, FUN = wrapit, width = 75, USE.NAMES = FALSE)) |>
transform(component = ifelse(component == "Bouclage de flux \nde mati\u00e8res et d'\u00e9nergie \npar une recherche d'autonomie",
yes = "Bouclage de flux de mati\u00e8res et d'\u00e9nergie \npar une recherche d'autonomie",
no = component
)) |>
transform(indic_number = regmatches(indic_code, regexpr("[[:digit:]]+", indic_code))) |>
transform(indic_number = as.numeric(indic_number)) |>
data.table::setorderv(cols = c("indic_number")) |>
transform(full_name = factor(full_name, levels = rev(unique(full_name)))) |>
transform(component = factor(component, levels = unique(component)))
## Estimating means to add on the boxplot
moys <- indic_data[, .(Mean = mean(scaled_value)), by = .(component, full_name, indic_code)]
## Plotting indicators for dimension A
indic_ae_boxplot <- ggplot2::ggplot(indic_data, ggplot2::aes(x = full_name, y = scaled_value)) +
ggplot2::stat_boxplot(geom = "errorbar", width = 0.3) +
ggplot2::geom_boxplot(color = "black", fill = "#2e9c15", width = 0.8) +
ggplot2::geom_point(ggplot2::aes(y = 0), shape = 91, size = 5, color = "red") +
ggplot2::geom_point(ggplot2::aes(y = max_indic), shape = 93, size = 5, color = "red") +
ggplot2::facet_wrap(~component, ncol = 1, scales = "free") +
ggplot2::coord_flip() +
theme_idea() +
ggplot2::scale_y_continuous(breaks = seq(0, 10, 1)) +
ggplot2::theme(axis.title.y = ggplot2::element_blank()) +
ggplot2::labs(y = "Valeur de l'indicateur", color = "L\u00e9gende", caption = paste0("(N = ", n_farms, ")"))
## Socio-Territorial
## Subset for dimension B
indic_data <- IDEA_data$dataset[, .(indic_code = indic, scaled_value, dimension_code, component_code, component_value)] |>
merge(reference_list$indic_dim, by = c("indic_code", "dimension_code", "component_code")) |>
subset(dimension_code == "B") |>
transform(full_name = paste0(indic_code, " - ", indic_name)) |>
transform(full_name = sapply(full_name, FUN = wrapit, width = 75, USE.NAMES = FALSE)) |>
transform(component = ifelse(component == "D\u00e9veloppement local \net \u00e9conomie circulaire",
yes = "D\u00e9veloppement local et \u00e9conomie circulaire",
no = component
)) |>
transform(indic_number = regmatches(indic_code, regexpr("[[:digit:]]+", indic_code))) |>
transform(indic_number = as.numeric(indic_number)) |>
data.table::setorderv(cols = c("indic_number")) |>
transform(full_name = factor(full_name, levels = rev(unique(full_name)))) |>
transform(component = factor(component, levels = unique(component)))
## Estimating means to add on the boxplot
moys <- indic_data[, .(Mean = mean(scaled_value)), by = .(component, full_name, indic_code)]
## Plotting indicators for dimension B
indic_st_boxplot <- ggplot2::ggplot(indic_data, ggplot2::aes(x = full_name, y = scaled_value)) +
ggplot2::stat_boxplot(geom = "errorbar", width = 0.3) +
ggplot2::geom_boxplot(color = "black", fill = "#5077FE", width = 0.8) +
ggplot2::geom_point(ggplot2::aes(y = 0), shape = 91, size = 5, color = "red") +
ggplot2::geom_point(ggplot2::aes(y = max_indic), shape = 93, size = 5, color = "red") +
ggplot2::facet_wrap(~component, ncol = 1, scales = "free") +
ggplot2::coord_flip() +
theme_idea() +
ggplot2::scale_y_continuous(breaks = seq(0, 10, 1)) +
ggplot2::theme(axis.title.y = ggplot2::element_blank()) +
ggplot2::labs(y = "Valeur de l'indicateur", color = "L\u00e9gende", caption = paste0("(N = ", n_farms, ")"))
## Economique
## Subset for dimension C
indic_data <- IDEA_data$dataset[, .(indic_code = indic, scaled_value, dimension_code, component_code, component_value)] |>
merge(reference_list$indic_dim, by = c("indic_code", "dimension_code", "component_code")) |>
subset(dimension_code == "C") |>
transform(full_name = paste0(indic_code, " - ", indic_name)) |>
transform(full_name = sapply(full_name, FUN = wrapit, width = 75, USE.NAMES = FALSE)) |>
transform(indic_number = regmatches(indic_code, regexpr("[[:digit:]]+", indic_code))) |>
transform(indic_number = as.numeric(indic_number)) |>
data.table::setorderv(cols = c("indic_number")) |>
transform(full_name = factor(full_name, levels = rev(unique(full_name)))) |>
transform(component = factor(component, levels = unique(component)))
## Estimating means to add on the boxplot
moys <- indic_data[, .(Mean = mean(scaled_value)), by = .(component, full_name, indic_code)]
## Plotting indicators for dimension C
indic_ec_boxplot <- ggplot2::ggplot(indic_data, ggplot2::aes(x = full_name, y = scaled_value)) +
ggplot2::stat_boxplot(geom = "errorbar", width = 0.3) +
ggplot2::geom_boxplot(color = "black", fill = "#FE962B", width = 0.8) +
ggplot2::geom_point(ggplot2::aes(y = 0), shape = 91, size = 5, color = "red") +
ggplot2::geom_point(ggplot2::aes(y = max_indic), shape = 93, size = 5, color = "red") +
ggplot2::facet_wrap(~component, ncol = 1, scales = "free") +
ggplot2::coord_flip() +
theme_idea() +
ggplot2::scale_y_continuous(breaks = seq(0, 25, 1)) +
ggplot2::theme(axis.title.y = ggplot2::element_blank()) +
ggplot2::labs(y = "Valeur de l'indicateur", color = "L\u00e9gende", caption = paste0("(N = ", n_farms, ")"))
## Saving plots to plotlist
plotlist$heatmap <- heatmap
plotlist$freq_plot <- freq_plot
plotlist$dimensions_histogram <- dimensions_histogram
plotlist$dimensions_boxplot <- dimensions_boxplot
plotlist$components_boxplot <- components_boxplot
plotlist$indic_ae_boxplot <- indic_ae_boxplot
plotlist$indic_st_boxplot <- indic_st_boxplot
plotlist$indic_ec_boxplot <- indic_ec_boxplot
# Saving original data in the list for future usage in write.
plotlist$data$metadata <- IDEA_data$metadata
plotlist$data$dataset <- tibble::tibble(IDEA_data$dataset)
plotlist$data$nodes <- IDEA_data$nodes
## Assigning the appropriate class
class(plotlist) <- c(class(plotlist), "IDEA_group_plots")
}
return(plotlist)
}
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.