In Metropolitan-Council/service.allocation.viz: Scrolly-telling viz for comparing scenarios in the bus service allocation study

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = FALSE
)

library(service.allocation.viz)
library(ggplot2)
library(plotly)
library(dplyr)
library(extrafont)
library(ggimage)
library(png)
# devtools::install_github("hrbrmstr/waffle")
# devtools::install_github("hrbrmstr/hrbrthemes")
library(hrbrthemes)  
library(waffle)
library(stringr)

requireNamespace("here", quietly = TRUE)
here::here()

ggplot2::theme_set(service.allocation.viz::app_theme())
source("../R/golem_utils_server.R")

showtext::showtext_auto()
sysfonts::font_paths()
files <- sysfonts::font_files()
sysfonts::font_add("FontAwesome5Free-Solid", "fa-solid-900.ttf")
sysfonts::font_add("Font Awesome 5 Brands Regular", "fa-brands-400.ttf")

se_population_type_sample <- se_population_type_long %>% 
  filter(scenario_short == "Scenario 1")

axis_options = list(
  zeroline = FALSE,
  showline = FALSE,
  showgrid = FALSE,
  visible = FALSE
)

Summary

plot <- ggplot(data = se_population_type_sample %>% 
         filter(item_category %in% c("pop",
                            "emp"
                            # "lo_emp_pct"
                            ))) +
  geom_tile(aes(x = c(1,0,1,0),
                y = 1,
                fill = item_category,
                text = hover_text),
            show.legend = F) +
  facet_wrap(~expand_improve,
             labeller = labeller(expand_improve = c(Expand = "Expand Access",
                                                    Improve = "Improved Transit Service"))) +
  geom_text(aes(x = c(1,0,1,0),
                y = 1,
                label = str_wrap(lab, width = 9)),
           position = position_dodge(width = 0)) +
  scale_fill_manual(labels = c("Jobs",
                                 "People"),
                      values = c("#E2F0D9",
                                  "#DAE3F3")) 
ggplotly(plot, tooltip = "text") %>% 
    layout(
    # margin = list(l = 10, r = 10, b = 10, t = 10, pad = 10), # l = left; r = right; t = top; b = bottom
    xaxis = axis_options,
    yaxis = axis_options,
    showlegend = FALSE,

    title = list(
      text = "Scenario Summary",
      pad = list(
        t = 10,
        r = 10,
        b = 20,
        l = 10
      ),
      font = list(family = font_family_list,
                  size = 30,
                  color = councilR::colors$suppBlack)
    ),
    hovermode = "closest",
    hoverdistance = "20",
    hoverlabel = list( #----
                       font = list(
                         size = 20,
                         family = font_family_list,
                         color = "black"
                       ),
                       bgcolor = "white",
                       bordercolor = "white",
                       padding = list(l = 10, r = 10, b = 10, t = 10)
    )
    ) %>% 
  plotly::config(
    displaylogo = F,
    showSendToCloud = F,
    displayModeBar = F
  ) 

p2 <- ggplot(data = 
         se_by_tma_long %>% 
         filter(scenario_id == "1",
                item == "pop_total",
                service_type %in% c("High frequency",
                                    "Local"))) +
  geom_col(aes(x = market_area,
               y = value,
               # group = service_type,
               text = hover_text,
               fill = service_type),
           width = -1,
           # fill = "#542c40",
           position = position_identity()) +
  scale_fill_manual(values = c(
    "#964f74","#542c40")) +
  labs(x = "Transit market area",
       title = "Scenario 1",
       fill = "Service level") +
  theme(legend.position = "bottom",
        axis.text.x = element_text(size = font_sizes$font_size_axis_text,
                                   family = font_families$font_family_base),
        axis.title = element_text(
          family = font_families$font_family_title,
          size = font_sizes$font_size_axis_title
        ))
p2
ggplotly(p2,tooltip = "text") %>% 
  layout(
        # margin = list(l = 10, r = 10, b = 10, t = 10, pad = 10), # l = left; r = right; t = top; b = bottom
        xaxis = axis_options,
        yaxis = axis_options,
        showlegend = FALSE,
        annotations = list(
          visible = FALSE,

          font = list(
            family = font_family_list,
            size = 30,
            color = councilR::colors$suppBlack
          )
        ),
        hovermode = "closest",
        # hoveron = "fills",
        hoverdistance = "5",
        hoverlabel = list( #----
          font = list(
            size = 20,
            family = font_family_list,
            color = "black"
          ),
          bgcolor = "white",
          bordercolor = "white",
          padding = list(l = 10, r = 10, b = 10, t = 10)
        )
      ) %>%
      plotly::config(
        displaylogo = F,
        showSendToCloud = F,
        displayModeBar = F
      )

New access to all day transit

 ggplot(data = se_population_type_sample %>% 
                 filter(expand_improve == "Expand",
                        type == "People",
                        !item_category %in% c("pop"))) +
  geom_tile(
    aes(x = c(0,0,1,1),
                y = c(0,1,1,0),
        fill = item_unit_factor,
        text = hover_text),
    show.legend = F,
    width = 1,
    color = "white",
    lwd =10) +
  geom_text(aes(x = c(0,0,1,1),
                y = c(0,1,1,0),
                label = str_wrap(lab, width = 9)),
            position = position_dodge(width = 0)) 
  # facet_wrap(~item_category, nrow = 2,
  #            ncol = 2) 
# scale_fill_manual(labels = c("Jobs",
#                                "People"),
#                     values = c("#E2F0D9",
#                                 "#DAE3F3")) 

ggplot(data = se_population_type_sample %>% 
                 filter(expand_improve == "Expand",
                        type == "Jobs",
                        !item_category %in% c("emp"))) +
  geom_tile(
    aes(x = c(1,0),
        y = c(0,0),
        fill = item_unit_factor,
        text = hover_text),
    show.legend = F,
    width = 1,
    color = "white",
    lwd =10) +
  geom_text(aes(x = c(1,0),
                y = c(0,0),
                label = str_wrap(lab, width = 9)),
            position = position_dodge(width = 0)) 

Metropolitan-Council/service.allocation.viz documentation built on July 29, 2023, 6:56 a.m.