R/plot_idea.R

Defines functions plot_idea

Documented in plot_idea

#' 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)
}

Try the IDEATools package in your browser

Any scripts or data that you put into this service are public.

IDEATools documentation built on May 29, 2024, 9:35 a.m.