R/obtn_plot_population_pyramid.R

In rfortherestofus/obtn: Oregon by the Numbers

#' Title
#'
#' @param obtn_year
#' @param county_to_plot
#' @param plot_width
#' @param plot_height
#' @param language default to ""
#'
#' @return
#' @export
#'
#' @examples
obtn_plot_population_pyramid <- function(obtn_year,
                                         county_to_plot,
                                         plot_width = 3.6,
                                         plot_height = 4.0752,
                                         language = "English") {
  # title
  if (language == "English") {
    plot_title_age <- "Age"
  } else if (language == "Spanish") {
    plot_title_age <- "Edad"
  }

  # Create data frame for this county
  obtn_population_pyramid_filtered <- obtn_population_pyramid |>
    dplyr::filter(geography == county_to_plot) |>
    dplyr::filter(year == obtn_year)

  # Define labels etc

  largest_group_pct <- max(obtn_population_pyramid_filtered$value)

  if (largest_group_pct < .06) {
    population_pyramid_labels <- c("0%", "2%", "4%", "6%")

    population_pyramid_breaks <- c(0, 0.02, 0.04, 0.06)

    population_pyramid_limit <- .06
    gender_label_offset <- .012

  } else if (largest_group_pct < .08) {
    population_pyramid_labels <- c("0%", "2%", "4%", "6%", "8%")

    population_pyramid_breaks <- c(0, 0.02, 0.04, 0.06, 0.08)

    population_pyramid_limit <- .082
    gender_label_offset <- .015
  } else if (largest_group_pct < .1) {
    population_pyramid_labels <- c("0%", "2%", "4%", "6%", "8%", "10%")

    population_pyramid_breaks <- c(0, 0.02, 0.04, 0.06, 0.08, 0.1)

    population_pyramid_limit <- .1
    gender_label_offset <- .022
  }

  make_population_pyramid <- function(gender_to_filter, language = "English") {
    if (gender_to_filter == "Men") {
      gender_color <- tfff_dark_green
      text_box_text_color <- "#ffffff"
      reverse_value <- 1
      x_limits <- c(0, population_pyramid_limit * reverse_value)
    }

    if (gender_to_filter == "Women") {
      gender_color <- tfff_light_green
      text_box_text_color <- tfff_dark_gray
      reverse_value <- -1
      x_limits <- rev(c(0, population_pyramid_limit * reverse_value))
      population_pyramid_breaks <- rev(population_pyramid_breaks) * reverse_value
      population_pyramid_labels <- rev(population_pyramid_labels)
    }

    # handle Spanish translation
    if (language == "Spanish") {
      names_sp <- c("Men" = "Hombres", "Women" = "Mujeres")

      gender_to_filter_label <- unname(names_sp[gender_to_filter])
    } else if (language == "English") {
      gender_to_filter_label <- gender_to_filter
    }

    obtn_population_pyramid_filtered |>
      dplyr::filter(gender == gender_to_filter) |>
      dplyr::mutate(value = value * reverse_value) |>
      ggplot2::ggplot(ggplot2::aes(x = value, y = age)) +
      ggplot2::geom_col(fill = gender_color, width = 0.7) +
      ggplot2::scale_x_continuous(limits = x_limits,
                                  breaks = population_pyramid_breaks,
                                  labels = population_pyramid_labels) +
      ggplot2::annotate(
        geom = "label",
        x = (population_pyramid_limit - gender_label_offset) * reverse_value,
        y = 17,
        label = gender_to_filter_label,
        color = text_box_text_color,
        family = "ProximaNova-Regular",
        fill = gender_color,
        label.size = 0,
        label.r = ggplot2::unit(0, "lines"),
        label.padding = ggplot2::unit(.3, "lines")
      ) +
      ggplot2::theme_void(base_family = "ProximaNova-Regular", base_size = 10) +
      ggplot2::theme(
        axis.text.x = ggplot2::element_text(
          color = tfff_dark_gray,
          size = 9,
          margin = ggplot2::margin(3, 0, 0, 0, "pt")
        ),
        panel.grid.major.x = ggplot2::element_line(color = tfff_light_gray)
      )
  }

  # make_population_pyramid("Women")


  age_order <- tibble::tibble(
    age = c(
      "0-4",
      "5-9",
      "10-14",
      "15-19",
      "20-24",
      "25-29",
      "30-34",
      "35-39",
      "40-44",
      "45-49",
      "50-54",
      "55-59",
      "60-64",
      "65-69",
      "70-74",
      "75-79",
      "80-84",
      "85+"
    )
  ) |>
    dplyr::mutate(age = forcats::fct_inorder(age))

  age_labels <-
    age_order |>
    ggplot2::ggplot(ggplot2::aes(x = 1, y = age, label = age)) +
    ggplot2::geom_text(family = "ProximaNova-Regular",
                       color = tfff_dark_gray,
                       size = 3.5) +
    ggplot2::theme_void() +
    ggplot2::scale_x_continuous(limits = c(0, 2))

  if (county_to_plot %in% c("Urban", "Rural", "Oregon")) {
    age_labels <-
      age_labels +
      ggplot2::labs(title = plot_title_age) +
      ggplot2::theme(
        plot.title = ggplot2::element_text(
          color = tfff_dark_gray,
          family = "ProximaNova-Regular",
          size = 10,
          hjust = 0.5
        )
      )
  }

  make_population_pyramid("Women", language = language) +
    age_labels +
    make_population_pyramid("Men", language = language) +
    patchwork::plot_layout(widths = c(3.5, 1, 3.5))


  obtn_save_plot(obtn_year,
                 "Population Pyramid",
                 county_to_plot,
                 plot_width,
                 plot_height,
                 language)

  ggplot2::last_plot()

}