R/style_scenarios_sheet.R

In gpw13/rapporteur: Reports on triple billion data

#' Styles scenarios sheet
#'
#' @inheritParams write_hpop_timeseries_sheet
#' @inheritParams scenarios_style
#' @inheritParams export_all_countries_summaries_xls
#' @inheritParams export_hep_country_summary_xls
#' @param billion Billion to be used for billion styling when relevant: either
#' "hep", "hpop", or "uhc" when no billion to be applied.
#' @inherit style_header_hpop_summary_sheet
#' @param df_wide wide version of `df` generated by `write_hpop_timeseries_sheet`
#' @param df_wide wide version of `df` generated by `write_uhc_timeseries_sheet`
#' @param this_iso3 character iditenfying the country being styled.
style_scenarios_sheet <- function(df,
                                  wb,
                                  billion = c("hep", "hpop", "uhc"),
                                  sheet_name,
                                  start_row,
                                  start_col,
                                  scenario_col = "scenario",
                                  scenarios_order,
                                  df_wide,
                                  ind_df,
                                  ind_ids,
                                  this_iso3) {
  billion <- rlang::arg_match(billion)

  nice_inds <- ind_df %>%
    dplyr::filter(.data[["ind"]] %in% ind_ids) %>%
    dplyr::select(c("ind", "short_name", "order")) %>%
    tidyr::expand_grid( scenario = scenarios_order)

  openxlsx::addStyle(wb,
                     sheet = sheet_name, style = excel_styles(
                       style_category = "void"
                     ),
                     rows = c(1:130), cols = c(1:20),
                     gridExpand = TRUE
  )

  openxlsx::addStyle(wb,
                     sheet = sheet_name,
                     style = excel_styles(
                       style_category = "title"
                     ),
                     rows = 2, cols = 2,
  )

  mergeCellForced(wb,
                  sheet = sheet_name,
                  cols = start_col, rows = start_row:(start_row + 1)
  )

  mergeCellForced(wb,
                  sheet = sheet_name,
                  cols = start_col + 1, rows = start_row:(start_row + 1)
  )

  mergeCellForced(wb,
                  sheet = sheet_name,
                  cols = (start_col + 2):(ncol(df_wide) + 1), rows = start_row
  )

  openxlsx::addStyle(wb,
                     sheet = sheet_name, style = excel_styles(
                       style_category = "datatable_header",
                       billion = billion,
                       billion_fgFill = "main"
                     ),
                     rows = start_row, cols = c(start_col:(ncol(df_wide) + 1))
  )
  openxlsx::addStyle(wb,
                     sheet = sheet_name, style = excel_styles(
                       style_category = "datatable_header",
                       billion = billion,
                       billion_fgFill = "main"
                     ),
                     rows = start_row:(start_row + 1), cols = start_col:start_col+1
  )
  openxlsx::addStyle(wb,
                     sheet = sheet_name, style = excel_styles(
                       style_category = "sub_datatable_header",
                       billion = billion,
                       billion_fgFill = "light",
                       halign = "right"
                     ),
                     rows = c((start_row + 1)), cols = c((start_col + 2):(ncol(df_wide) + 1)),
                     gridExpand = TRUE
  )
  openxlsx::addStyle(wb,
                     sheet = sheet_name, style = excel_styles(
                       style_category = "data",
                       type_data = "numeric",
                       border = "bottom",
                       borderStyle = "thin",
                       borderColour = "grey"
                     ),
                     rows = c((start_row + 2):(start_row + nrow(df_wide) + 1)), cols = c(start_col:(ncol(df_wide) + 1)),
                     gridExpand = TRUE
  )

  scenarios_style(df = df,
                  wb = wb,
                  sheet_name = sheet_name,
                  start_row = start_row + 2, start_col = start_col,
                  scenario_col = scenario_col,
                  ind_df, scenarios_order = scenarios_order
  )

  default_scenario_rows <- seq(from = start_row + 2, to = start_row + nrow(df_wide) + 1, by = length(scenarios_order))

  purrr::walk(default_scenario_rows, ~ openxlsx::addStyle(wb,
                                                          sheet = sheet_name,
                                                          style = excel_styles(
                                                            style_category = "normal_text",
                                                            textDecoration = "bold"
                                                          ),
                                                          rows = .x,
                                                          cols = c(start_col,start_col + 1),
                                                          gridExpand = TRUE
  ))

  if (billion == "hep") {
    affected_pathos_iso3 <- rapporteur::affected_pathogens %>%
      dplyr::filter(.data[["iso3"]] == !!this_iso3)

    if (rowSums(affected_pathos_iso3 %>% dplyr::select(-.data[["iso3"]])) > 1) {
      pathos_iso3 <- names(affected_pathos_iso3)[affected_pathos_iso3 == FALSE]
      short_name_pathos <- unlist(
        ind_df[stringr::str_detect(ind_df[["ind"]], paste0(pathos_iso3, collapse = "|")), "short_name"]
      )

      fade_rows <- grep(paste0(short_name_pathos, collapse = "|"), df_wide$short_name)
      openxlsx::addStyle(wb,
                         sheet = sheet_name,
                         style = excel_styles(
                           style_category = "normal_text",
                           fontColour = "grey",
                           border = "bottom",
                           borderColour = "grey"
                         ),
                         rows = start_row + fade_rows + 1,
                         cols = c(start_col, start_col + 1),
                         gridExpand = TRUE
      )
    }
  }

  groups_rows <- sort(c(default_scenario_rows+1, default_scenario_rows+2))
  suppressWarnings(openxlsx::groupRows(wb, sheet_name, rows = groups_rows, hidden = FALSE))

  return(wb)
}