R/plot.R

In FPRgroup/fpemreporting: fpemreporting

#' plot country results
#'
#' @param country_results \emph{'Numeric Vector'} A vector of the indicator to be plotted from \code{\link[fpemreporting:fpem_calculate_results]{fpemreporting::fpem_calculate_results}} Note the indicator column names for the results data and the indicator names in the default observed data are not congruent.
#' @param core_data
#' @param is_in_union
#' @param indicators
#'
#' @return
#' @export
#'
#' @examples
fpem_plot_country_results <- function(
  country_results,
  observations = NULL,
  first_year,
  last_year,
  is_in_union = NULL,
  indicators
) {
  if (!is.null(observations)) {
    if (!is.null(is_in_union)) {
      observations <- observations %>% dplyr::filter(is_in_union == !!is_in_union)
    }
  }
  y_label = "Proportion"
  breaks = seq(
    first_year,
    last_year,
    by = 5
  )
  # breaks = NULL
  # if (is.null(breaks)) {
  #   breaks <- ggplot2::waiver()
  # }
  pl <- list()
  for(indicator in indicators) {
    country_results_j <- country_results[[indicator]]
    pl[[indicator]] <- tidyr::spread(country_results_j, key = percentile, value = value) %>%
      ggplot2::ggplot(ggplot2::aes(x = year)) +
      ggplot2::ggtitle(indicator) +
      ggplot2::scale_x_continuous(name = "Year", breaks = breaks) +
      ggplot2::ylab(y_label) +
      ggplot2::theme_bw() +
      ggplot2::theme(
        plot.title = ggplot2::element_text(hjust = 0.5),
        axis.text.x = ggplot2::element_text(angle = 90, hjust = 1)
      ) +
      ggplot2::geom_ribbon(ggplot2::aes(ymin = `2.5%`, ymax = `97.5%`), fill = "plum1") +
      ggplot2::geom_ribbon(ggplot2::aes(ymin = `10%`, ymax = `90%`), fill = "plum") +
      ggplot2::geom_line(ggplot2::aes(y = `50%`), color = "black")
    if(!is.null(observations)) {
    if(nrow(observations) > 0) {
      observations$subpopulation_labels <- fpemreporting:::fpem_get_subpopulation_labels(observations)
      pl[[indicator]] <- pl[[indicator]] + ggplot2::geom_point(
        data = observations,
        ggplot2::aes_string(
          x = "ref_date",
          y = indicator,
          color = "data_series_type",
          shape = "group_type_relative_to_baseline"
        ),
        size = 2) +
        ggplot2::geom_text(
          data = observations,
          ggplot2::aes_string(
            x = "ref_date",
            y = indicator,
            label = "subpopulation_labels"
          ),
          size = 3,
          hjust = -0.3,
          vjust = -0.3
        ) +
        ggplot2::labs(color = "Data series/type", shape = "Group")
    }
    }
  }
  return(list(pl[[1]], pl[[2]], pl[[3]], pl[[4]]))
}



#' Reformat global data to long format
#'
#'
#' @param data: emph{'Data.frame'} Estimates for modern/trad/unmet obtained from posterior of global model in wide format
#' @param code: emph{'Numeric'} A country code to filter on since we only run one country at a time on our end
#' @export
#'
#' @return emph{'Data.frame} A long format data of specific country to be plotted
#'
#' @examples fpemdata:::get_global_estimates_married() %>% filter(par =="unmet") %>% process_global(code)
process_global <- function(data, code) {
  data %>%
    dplyr::filter(division_numeric_code == !! code) %>%
    dplyr::select(division_numeric_code, Percentile,  "1975.5":"2020.5") %>%
    tidyr::gather(year, value, "1975.5":"2020.5") %>%
    dplyr::mutate(year = as.numeric(year)) %>%
    tidyr::spread(Percentile, value)
}