R/CreateGraphicsTable2.R

In irisweyermenkhoff/toyota-idv-functions: Risk Reporting and Toolbox Calculation Functions

CreateGraphicsTable2 <- function(df, countries, pie_vars, bar_vars) {



  # Color codes per country for pie plot ------------------------------
  # For colouring only one section in blue, the grey colour is sequentially
  # replaced by the blue color

  col <- countries %>%
    set_names(countries) %>%
    map(~ unname(
      replace(rep(ci_palette[2], 8), match(.x, countries), c(ci_palette[1]))
    ))


  # vectors for country and variables  ---------------------------------------
  # Iteration over country and variable argument is processed simultaneously and
  # in parallel. Therefore, replicate elements of the vectors x times , to obtain
  # vector pairs with the same length

  # replicate each element in the vector x times (x = number of countries)
  vars <- list(c(pie_vars), c(bar_vars)) %>%
    purrr::map(~
    rep(.x, each = length(countries))) %>%
    set_names(c("pie", "bar"))

  # replicate the countries x times (number of variables)
  countries_pie <- rep(countries, length(vars$pie) / 8)
  countries_bar <- rep(countries, length(vars$bar) / 8)
  names(countries_pie) <- countries_pie
  names(countries_bar) <- countries_bar


  # pie images -----------------------------------------------------------------
  # Create dataframe consisting of the base64 encoded pie plots for each country
  # and the respective value displayed as percentage
  options(warn = -1)
  pie_images <- purrr::map2_df(
    vars$pie, countries_pie,
    ~ data.frame(
      key_figures = paste0(.x,"_img"),
      country = .y,
      img = paste(
        Img64Encoding(
          PlotPieTable(df,
            df[[.x]],
            df$country,
            color = col[[.y]]
          ),
          fromfile = FALSE
        ),
        percent(df %>%
          filter(country == .y) %>%
          pull(!!sym(paste0(.x, "_per"))),
          digits=0),
        sep = "<br/>"
      ),
      stringsAsFactors = FALSE)
  ) %>%
    spread(., key_figures, img)


  # Create dataframe consisitng of the base64 encoded bar plots for each country
  # and the respective value displayes as difference from the mean
  # (value is in column with "_diff" suffix as the bar_variables are differences
  # from the mean)
  bar_images <- purrr::map2_df(
    vars$bar, countries_bar, ~
  data.frame(
    key_figures = paste0(.x, "_img"),
    country = .y,
    img =
      paste(
        Img64Encoding(
          df %>%
            filter(country == paste(.y)) %>%
            PlotBar(.,
              x = "",
              .[[ paste0(.x, "_diff")]],
              limits_y = c(
                ifelse(min(df[[ paste0(.x, "_diff")]]) > 0, 0,
                  min(df[[ paste0(.x, "_diff")]])
                ),
                ifelse(max(df[[ paste0(.x, "_diff")]]) < 0, 0,
                  max(df[[ paste0(.x, "_diff")]])
                )
              ),
              color = ifelse(.[[ paste0(.x, "_diff")]] > 0, ci_palette["red"],
                ci_palette["green"]
              )
            ) + geom_hline(yintercept = 0, size = 5),
          fromfile = FALSE
        ),
        round(df %>%
          filter(country == .y) %>%
          pull(!!sym(paste0(.x, "_diff"))), digits = 1),
        sep = "<br/>"
      ),
    stringsAsFactors = FALSE)
  ) %>%
    spread(., key_figures, img)
  options(warn = 0)


  df_images <- pie_images %>%
    left_join(., bar_images, by="country") %>%
    mutate(country = factor(country, levels = c(order_countries,"Group")))

  return(df_images)
}