R/obtn_plot_choropleth_map.R

In rfortherestofus/obtn: Oregon by the Numbers

#' Make Choropleth Map
#'
#' @param measure_to_plot
#' @param obtn_year
#' @param plot_width description
#' @param plot_height description
#' @param language description
#' @param export
#' @param is_htmlwidget default to FALSE
#'
#' @return
#' @export
#'
#' @examples
obtn_plot_choropleth_map <- function(obtn_year,
                                     measure_to_plot,
                                     plot_width = 4.3684,
                                     plot_height = 3.25,
                                     language = "English",
                                     export = TRUE,
                                     is_htmlwidget = FALSE) {
  # spanish levels
  if (language == "Spanish") {
    third_levels <- c(
      "Tercio\nsuperior",
      "Tercio\nintermedio",
      "Tercio\ninferior"
    )
    NA_level <- "DI"
  } else if (language == "English") {
    third_levels <- c("Top third", "Middle third", "Bottom third")
    NA_level <- "ID"
  }

  # data cleaning
  obtn_data_by_measure_filtered <- obtn_data_by_measure %>%
    dplyr::filter(year == obtn_year) %>%
    dplyr::filter(measure == measure_to_plot) %>%
    dplyr::filter(geography %in% obtn_oregon_counties) %>%
    dplyr::mutate(tertile_numeric = santoku::chop_equally(rank, 3)) %>%
    dplyr::mutate(tertile_numeric = as.numeric(tertile_numeric)) %>%
    dplyr::mutate(
      tertile_text = dplyr::case_when(
        tertile_numeric == 1 ~ third_levels[1],
        tertile_numeric == 2 ~ third_levels[2],
        tertile_numeric == 3 ~ third_levels[3]
      )
    ) %>%
    dplyr::mutate(tertile_text = tidyr::replace_na(tertile_text, NA_level)) %>%
    dplyr::mutate(tertile_text = factor(tertile_text, levels = c(third_levels, "No college", NA_level)))

  obtn_data_by_measure_geospatial <- dplyr::left_join(obtn_data_by_measure_filtered,
    obtn_boundaries_oregon_counties,
    by = "geography"
  ) %>%
    sf::st_as_sf()

  if (is_htmlwidget) {
    # custom the tooltip according to the measure to plot
    if (tolower(measure_to_plot) == "child poverty") {
      tooltip_description <- "of children live below the poverty line"
    } else {
      tooltip_description <- measure_to_plot
    }

    plot <- ggplot2::ggplot(obtn_data_by_measure_geospatial) +
      ggiraph::geom_sf_interactive(
        ggplot2::aes(
          fill = tertile_text,
          tooltip = stringr::str_glue("
          <div class='tooltip-content'>
            <div class='county-name'>{geography} County</div>
            <div class='value'>{value}%</div>
            <div class='description'>{tooltip_description}</div>
          </div>
          "),
          data_id = geography
        ),
        color = "white",
        size = .5
      ) +
      ggplot2::coord_sf(datum = NA) +
      ggplot2::scale_fill_manual(values = obtn_choropleth_colors) +
      ggplot2::theme_void() +
      ggplot2::theme(
        text = ggplot2::element_text(family = "ProximaNova-Regular", size = 10),
        legend.box.margin = ggplot2::margin(10, 10, 10, 10),
        legend.position = "bottom",
        legend.key.size = ggplot2::unit(0.2, "inches"),
        legend.key.spacing.x = ggplot2::unit(5, "mm")
      ) +
      ggplot2::scale_x_continuous(expand = c(0, 0)) +
      ggplot2::scale_y_continuous(expand = c(0, 0)) +
      ggplot2::labs(fill = NULL)

    interactive_plot <- ggiraph::girafe(
      ggobj = plot, width_svg = plot_width, height_svg = plot_height,
      options = list(
        ggiraph::opts_hover(css = "transition: all 0.3s ease;"),
        ggiraph::opts_hover_inv("opacity:0.5;filter:saturate(30%);"),
        ggiraph::opts_tooltip(css = "
          .tooltip-content {
            font-family: 'ProximaNova', sans-serif;
            font-size: 20px;
            padding: 10px;
            background-color: #ffffff;
            color: #333333;
            border-radius: 8px;
            border: 1px solid #dddddd;
            box-shadow: 0px 4px 8px rgba(0, 0, 0, 0.1);
            line-height: 1;
          }
          .tooltip-content .county-name {
            font-size: 22px;
            font-weight: bold;
            margin-bottom: 10px;
          }
          .tooltip-content .value {
            font-size: 44px;
            font-weight: bold;
            margin-bottom: 4px;
          }
          .tooltip-content .description {
            font-size: 18px;
            font-weight: 300;
          }
        ")
      )
    )


    if (export) {
      measure_to_plot_name <- stringr::str_glue("Choropleth {measure_to_plot}")
      file_name <- stringr::str_glue("{obtn_year}-{measure_to_plot_name}-Oregon-{stringr::str_to_lower(language)}.html")
      file_path <- stringr::str_glue("inst/plots/{obtn_year}/")
      file_path_and_name <- stringr::str_glue("{file_path}{file_name}")
      htmlwidgets::saveWidget(interactive_plot, file = file_path_and_name, selfcontained = TRUE)
    } else {
      return(interactive_plot)
    }
  } else {
    plot <- ggplot2::ggplot(obtn_data_by_measure_geospatial) +
      ggplot2::geom_sf(ggplot2::aes(fill = tertile_text),
        color = "white",
        size = .5
      ) +
      ggplot2::coord_sf(datum = NA) +
      ggplot2::scale_fill_manual(values = obtn_choropleth_colors) +
      ggplot2::theme_void() +
      ggplot2::theme(
        text = ggplot2::element_text(family = "ProximaNova", size = 10),
        legend.box.margin = ggplot2::margin(10, 10, 10, 10),
        legend.position = "bottom",
        legend.key.size = ggplot2::unit(0.4, "inches"),
        legend.key.spacing.x = ggplot2::unit(5, "mm")
      ) +
      ggplot2::scale_x_continuous(expand = c(0, 0)) +
      ggplot2::scale_y_continuous(expand = c(0, 0)) +
      ggplot2::labs(fill = NULL)

    if (export) {
      measure_to_plot_name <- stringr::str_glue("Choropleth {measure_to_plot}")
      obtn_save_plot(
        obtn_year,
        measure_to_plot_name,
        "Oregon",
        plot_width,
        plot_height,
        language,
        is_htmlwidget = is_htmlwidget
      )
    } else {
      last_plot()
    }
  }
}

# obtn_plot_choropleth_map(2022, "Child Poverty")
# obtn_plot_choropleth_map(2024, "Graduation Rate", is_htmlwidget = TRUE)

# temp <-obtn_plot_choropleth_map(2022, "Child Poverty")
# temp %>%
#   count(tertile_text)