dashboard.Rmd

---
title: "WRK Group Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    theme: 
      version: 4
      primary: "#0c8ccd" #blue
      warning: "#ffc934" #yellow
      navbar-bg: "#00a454" #green
    navbar:
      - {icon: "fa-github", href: "https://github.com/de-data-lab/WRK", target: "_blank"}
    logo: "inst/www/logo_40.png"
runtime: shiny
---


```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(readxl)
library(here)
library(shiny)
library(plotly)
library(patchwork)
library(lubridate)

source(here("utils/utils.R"))
source(here("utils/plot_achievement.R"))
source(here("utils/print_pct.R"))
source(here("utils/plotly_utils.R"))
source(here("utils/wrk_pal.R"))
source(here("R/plotly_add_annotation.R"))
source(here("R/plotly_dumbbell.R"))
source(here("R/str_wrap_hovertemplate.R"))
source(here("R/add_title.R"))
# Education
source(here("R/render_kinder_readiness.R"))
source(here("R/get_summary_education_kinder.R"))
source(here("R/render_dumbbell_achievements.R"))
source(here("R/get_achievement_texts.R"))
source(here("R/render_dumbbell_grad_gap.R"))
source(here("R/plotly_caption_source.R"))
# Workforce Development
source(here("R/render_employment.R"))
source(here("R/plotly_add_employed_line.R"))
# Safety
source(here("R/plot_categorical.R"))
source(here("R/render_safety_valbox.R"))


## Load HUD Data 
hud_de <- read_rds(here("data/processed/hud_DE_combined.rds"))

# Target Census Tracts
target_tracts <- c("CT 30.02 (Riverside)" = "10003003002",
                   "CT 6.01" = "10003000601",
                   "CT 6.02" = "10003000602")

# Set ggplot global theme
theme_set(theme_minimal())
```

# Home {data-orientation=rows}
```{r, ref.label=c("housing-setup", "education-setup", "literacy-setup", "math-setup", "graduation-setup", "workforce-setup", "safety-setup", "events-setup")}
# Run the code chunks ahead to render the home component
```

```{r child="components/home.Rmd"}
# Render the Home tab
```


# Housing {data-orientation=columns}
```{r, housing-setup}
# New available units for rent
# Calculate the Riverside metrics
riverside_total_units <- hud_de %>%
  filter(code == "10003003002") %>%
  select(year, total_units) %>%
  mutate(total_units_lag = lag(total_units)) %>%
  # Calculate the percent change
  mutate(pct_change = ((total_units/lag(total_units) - 1)) * 100)

# Mean percent change across years
riverside_total_units_pct_change_mean <- riverside_total_units %>%
  summarise(mean = mean(pct_change, na.rm = TRUE))

# Get the average number of units changed
riverside_total_units_lm <- riverside_total_units %>%
  lm(data = ., total_units ~ year)
riverside_total_units_coef <- coef(riverside_total_units_lm)[["year"]]

## Proportions of units occupied 
# Calculate the Riverside metrics
riverside_pct_occupied <- hud_de %>%
  filter(code == "10003003002") %>%
  transmute(year, pct_occupied, total_units) %>%
  mutate(location = "Riverside")

# Calcualate the Delaware average
DE_pct_occupied <- hud_de %>%
  group_by(year) %>%
  summarise(pct_occupied = mean(pct_occupied, na.rm = TRUE),
            total_units = sum(number_reported, na.rm = TRUE)) %>%
  mutate(location = "Delaware")

# Join the tables 
pct_occupied_joined <- riverside_pct_occupied %>%
  bind_rows(DE_pct_occupied)

# Calculate the average year-to-year change in pct_occupied
pct_occupied_joined_lm <- riverside_pct_occupied %>%
  lm(data = ., pct_occupied ~ year)

# Get the coefficient 
pct_occupied_riverside_change <- coef(pct_occupied_joined_lm)[["year"]]


# Average months since moved in
riverside_tenure <- hud_de %>%
  filter(code == "10003003002") %>%
  select(year, months_from_movein, pct_occupied, total_units) %>%
  mutate(location = "riverside")

DE_tenure <- hud_de %>%
  group_by(year) %>%
  summarise(months_from_movein = mean(months_from_movein, na.rm = TRUE),
            pct_occupied = mean(pct_occupied, na.rm = TRUE),
            total_units = mean(total_units, na.rm = TRUE)) %>%
  mutate(location = "DE")

```


Column 1: Available Rental Units
-----------------------------------------------------------------------

```{r child="components/housing_units_count_change_valbox.Rmd"}
# Change in available units for rent
```


### Available rental units
```{r, housing-total-units-plot}
# Get the maximum and minimum years for plotting
min_year <- riverside_total_units %>%
  pull(year) %>% min
max_year <- riverside_total_units %>%
  pull(year) %>% max

# Create a plot for available rental units
plot_units_count <- riverside_total_units %>%
  plot_ly(x = ~year,
          y = ~total_units,
          color = I(WRK_primary_colors[["green"]])) %>% 
  # Add barplot and seth the hover text 
  add_bars(hovertemplate = "In %{x}, Riverside had %{y} public housing units <extra></extra>") %>%
  # Remove axis title
  plotly_remove_axis_titles()

# Create a plot for percent changes in available units
plot_units_change <- riverside_total_units %>%
  drop_na(pct_change) %>%
  plot_ly(x = ~year,
          y = ~pct_change,
          color = I(WRK_primary_colors[["green"]])) %>%
  add_trace(
    type = "scatter",
    mode = "markers+lines",
    hovertemplate = "In %{x}, the number of available units changed %{y:+.1}% from the previous year <extra></extra>"
  ) %>%
  # Remove axis titles
  plotly_remove_axis_titles() %>%
  # Get the min max for the year
  summarise(min = min(year), max = max(year)) %>%
  # Format the ticks
  layout(xaxis = list(tickvals = ~seq(min, max))) %>%
  # Gray out the axis line 
  layout(yaxis = list(zerolinecolor = "#b8b8b8")) %>% 
  # Format the y axis as percentages
  layout(yaxis = list(ticksuffix = "%")) %>%
  # Disable zoom
  plotly_disable_zoom()


# Combine the count plot and percent-change plot
subplot(plot_units_count,
        plot_units_change,
        nrows = 2, shareX = TRUE, margin = 0.04) %>% 
  # Add plot titles to the subplots 
  plotly_add_subplot_title(text = "Rental units available in Riverside") %>% 
  plotly_add_subplot_title(text = "Percent changes in available units",
                           y = 0.45) %>% 
  # Add back the year labels for the count plot
  layout(annotations = list(
    x = min_year:max_year,
    y = -12,
    yanchor = "paper",
    text = min_year:max_year,
    showarrow = FALSE
  )) %>% 
  # Disable zoom & hide the mode bar
  plotly_disable_zoom() %>%
  plotly_hide_modebar() %>% 
  # Hide legends
  hide_legend() %>%
  # Add caption
  plotly_caption_hud()

```


Column 2: Occupied units
-----------------------------------------------------------------------

```{r child='components/housing_occupied_valbox.Rmd'}
# Average change in proportion of occupied units
```

### Occupied Units

```{r}
# Generate a hovertext for plotting  
pct_occupied_joined <- pct_occupied_joined %>%
  mutate(hovertext = str_glue("{round(pct_occupied, 1)}% of units in {location} were occupied in {year} \n (Out of {total_units} units)"))

# Create a plotly plot
pct_occupied_plot <- pct_occupied_joined %>%
  plot_ly(x = ~year, y = ~pct_occupied, text = ~location) %>%
  add_trace(type = "scatter", 
            mode = "markers+lines",
            color = ~location,
            hoveron = "points",
            hovertext = ~hovertext,
            hoverinfo = "text",
            colors = c(Delaware = "gray", Riverside = get_wrk_color("green"))) %>%
  # Add annotations for Riverside vs. Wilmington
  add_annotations(x = 2018, y = 97,
                  text = "Riverside",
                  font = list(color = get_wrk_color("green"),
                              size = 14),
                  showarrow = FALSE) %>% 
  add_annotations(x = 2020, y = 91,
                  text = "Delaware",
                  font = list(color = "gray",
                              size = 14),
                  showarrow = FALSE) %>% 
  # Add caption 
  plotly_caption_hud() %>% 
  # Remove axis labels since they are obvious
  plotly_remove_axis_titles() %>%
  # Add "%" suffix to the y-axis
  layout(yaxis = list(ticksuffix = "%")) %>%
  # Add title to the plot
  layout(title = list(text = "Rental units occupied (%)",
                      xanchor = "left", x = 0)) %>% 
  # Remove the x-grid
  layout(xaxis = list(showgrid = FALSE)) %>%
  hide_legend() %>% 
  plotly_hide_modebar() %>%
  plotly_disable_zoom() 

# Render Plot
renderPlotly({pct_occupied_plot })
```


Column 3: Months since move-in
-----------------------------------------------------------------------


```{r child='components/housing_tenure_valbox.Rmd'}

```


### Average months since moved in

```{r}
# Prepare labels for the plot
tenure_stacked <- tenure_stacked %>% 
  mutate(location_label = recode(location,
                                 "riverside" = "Riverside",
                                 "DE" = "Delaware"))

# Create a Plotly plot for the tenure (average months since move in)
plot_ly(x = ~year,
        y = ~months_from_movein,
        text = ~location_label,
        hovertemplate = "In %{x} in %{text}, an average family participating in public housing \n had stayed at the same place for %{y:.1f} months <extra></extra>")  %>%
  # Add trace for Riverside
  add_trace(
    data = tenure_stacked %>% filter(location == "riverside"),
    type = "scatter",
    mode = "markers+lines",
    color = I(WRK_primary_colors[["green"]])
  )  %>% 
  # Add trace for Delaware
  add_trace(
    data = tenure_stacked %>% filter(location == "DE"),
    type = "scatter",
    mode = "markers+lines",
    color = I("gray")
  )  %>% 
  # Add annotation labels for the Riverside and Delaware
  layout(annotations = list(
    x = 2018, 
    y = 110, 
    text = "Riverside",
    font = list(size = 16, color = get_wrk_color("green")),
    showarrow = FALSE
  )) %>%
  layout(annotations = list(
    x = 2020, 
    y = 105, 
    text = "Delaware",
    font = list(size = 16, color = "gray"),
    showarrow = FALSE
  )) %>%
  # Remove axes
  plotly_remove_axis_titles() %>%
  # Add suffix to the ticks (months)
  layout(yaxis = list(ticksuffix = " mo.")) %>% 
  hide_legend() %>%
  # Add title
  layout(title = list(text = "Average months since moved in",
                      xanchor = "left", x = 0)) %>%
  # Disable zoom
  plotly_disable_zoom() %>%
  # Hide the mode bar
  plotly_hide_modebar() %>%
  # Add caption 
  plotly_caption_hud() %>% 
  # Remove the horizontal grid lines
  layout(xaxis = list(showgrid = FALSE))

```



# Education {data-orientation=columns}
```{r, education-setup}
# Get the kinder summary table
all_kinder <- get_summary_education_kinder()

# Calculate the readiness average over years
kinder_WRK_DE_comparison <- all_kinder %>%
  group_by(location) %>%
  summarise(mean = mean(kinder_ready_prop))

# Create a text vector for printing out
kinder_txt <- kinder_WRK_DE_comparison %>%
  mutate(mean = sprintf("%.1f%%", mean * 100)) %>%
  deframe() %>% as.list()

# Calculate percentage increase between two perccentages
kinder_WRK_DE_comparison_list <- kinder_WRK_DE_comparison %>%
  deframe() %>% as.list()
kinder_pct_diff <- (kinder_WRK_DE_comparison_list$WRK - kinder_WRK_DE_comparison_list$Delaware) /
  kinder_WRK_DE_comparison_list$Delaware

# Data heights
edu_valbox_height = 50
edu_plot_height = 500
edu_notes_height = 80
```


```{r, graduation-setup}
# Load Graduation Data
graduation <- read_rds(here("data/processed/education_graduation.rds"))
graduation_gaps <- read_rds(here("data/processed/education_graduation_summary.rds"))

# Calculate statics for graduation
# Graduation: Assume linear trend and calculate an average change
graduation_gaps_lm <- lm(data = graduation_gaps,
                         formula  = gap ~ schoolyear)

gap_yearly_change <- graduation_gaps_lm$coefficients["schoolyear"] %>%
  sprintf("%.2f%%", .)
start_year <- graduation_gaps_lm$model$schoolyear %>% min()
end_year <-  graduation_gaps_lm$model$schoolyear %>% max()

# From 2016 and onwards
graduation_gaps_lm_2016 <- graduation_gaps %>% 
  filter(schoolyear >= 2016) %>%
  lm(data = .,
     formula  = gap ~ schoolyear)
gap_yearly_change_2016 <- graduation_gaps_lm_2016$coefficients["schoolyear"]

gap_yearly_change_2016_txt <- gap_yearly_change_2016 %>%
  sprintf("%.2f%%", .)

```


Column 1: Kindergarten Readiness
-----------------------------------------------------------------------

```{r child='components/education_kinder_valbox.Rmd'}
# More kindergarten-ready than Delaware average
```


### Kindergarten Readiness {data-height=`r edu_plot_height`}

```{r}
# Render the kindergarten readiness plot
all_kinder %>% 
  render_kinder_readiness()
```


### Notes {data-height=`r edu_notes_height`}

- On average, `r kinder_txt["WRK"]` of children in WRK group were kindergarten ready (2019-2021), compared to `r kinder_txt["Delaware"]` of children in Delaware (2016-2019). 

- The rate of kindergarden readiness in WRK group is `r print_pct(kinder_pct_diff)` more than that of Delaware.


Column 2: Literacy
-----------------------------------------------------------------------

```{r, literacy-setup}
# Load Data
# Data are aggregates of 3rd to 8th graders
ELA <- read_rds(here("data/processed/education_achievement_wide_ELA.rds"))

# Get the eastside
eastside_ELA <- ELA %>%
  select(schoolyear, east_side, delaware) %>%
  mutate(gap = east_side - delaware) %>% 
  # Set colors depending on the direction of the gap (+/-)
  mutate(gap_color = case_when(gap < 0 ~ get_wrk_color("yellow", palette = "secondary"),
                               gap >= 0 ~ get_wrk_color("green")))

# Linear changes over years (2015-2021)
eastside_ELA_lm <- eastside_ELA %>%
  lm(data = ., formula = gap ~ schoolyear)
# get the year-to-year change
eastside_ELA_gap_coeff <- eastside_ELA_lm$coefficients[["schoolyear"]]

```

```{r child='components/education_literacy_valbox.Rmd'}
### Improvement in literacy achievement gap to Delaware
```


### Literacy Achievement  {data-height=`r edu_plot_height`}

```{r}
# Render a plot for the literacy achievement
eastside_ELA %>%
  render_dumbbell_achievements(area = "ELA")
```

### Notes {data-height=`r edu_notes_height`}

```{r}
# Create values for plotting
# Get the latest year
ELA_latest <- eastside_ELA %>% 
  filter(schoolyear == max(schoolyear)) %>% 
  mutate(across(where(is.numeric), round, 1))
# Get the text indicating the direction
ELA_direction_text <- 
  case_when(eastside_ELA_gap_coeff > 0 ~ "improving",
            eastside_ELA_gap_coeff == 0 ~ "staying the same",
            eastside_ELA_gap_coeff < 0 ~ "worsening")
```


- In `r ELA_latest$schoolyear`, `r ELA_latest$east_side`% of the 3rd-8th graders at East Side Charter in Riverside achieved the literacy proficiency. 

- The gap to the Delaware average (`r ELA_latest$delaware`%) was `r ELA_latest$gap`%. The gap has been `r ELA_direction_text` by `r eastside_ELA_gap_coeff %>% round(1)`% a year.

Column 3: Math
-----------------------------------------------------------------------


```{r, math-setup}
# Load Data
math <- read_rds(here("data/processed/education_achievement_wide_math.rds"))
# Get the eastside & calculate the gap
eastside_math <- math %>%
  select(schoolyear, east_side, delaware) %>%
  mutate(gap = east_side - delaware)
# Linear changes over years (2015-2021)
eastside_math_lm <- eastside_math %>%
  lm(data = ., formula = gap ~ schoolyear)
# get the year-to-year change
eastside_math_gap_coeff <- eastside_math_lm$coefficients[["schoolyear"]]

```

```{r child='components/education_math_valbox.Rmd'}
# Improvement in math achievement gap to Delaware 
```

### Math Achievement  {data-height=`r edu_plot_height`}

```{r}
# Create a plot for math achievement gap
eastside_math %>% 
  render_dumbbell_achievements(area = "math")
```

### Notes {data-height=`r edu_notes_height`}

```{r}
# Get the needed info for rendering the text
eastside_math_texts <- get_achievement_texts(eastside_math, eastside_math_gap_coeff)
```


- In `r eastside_math_texts$df$schoolyear`, `r eastside_math_texts$df$east_side`% of the 3rd-8th graders at East Side Charter in Riverside achieved the math proficiency. 

- The gap to the Delaware average (`r eastside_math_texts$df$delaware`%) was `r eastside_math_texts$df$gap`%. The gap has been `r eastside_math_texts$direction_text` by `r eastside_math_texts$coeff %>% round(1)`% a year.


Column 4: Graduation Rate
-----------------------------------------------------------------------


```{r child='components/education_graduation_valbox.Rmd'}
# Improvement in high school graduation gap to Delaware, since 2016 
```


### Graduation Gap  {data-height=`r edu_plot_height`}

```{r}
# Plot the gap with the state average
graduation_gaps %>% 
  render_dumbbell_grad_gap()
```


### Notes {data-height=`r edu_notes_height`}

- On average, the gaps in the graduation rate with the 
state average worsened by `r gap_yearly_change` per year from `r start_year` to `r end_year`.  

- However, if we focus on 2016 onwards, the gap may be improving. On average, the gap
improved by `r gap_yearly_change_2016_txt` per year from 2016 to 2020.


# Workforce Development {data-orientation=columns}

Column 1: Employment
-----------------------------------------------------------------------
```{r, workforce-setup}
# Load Data
unemployment <- read_rds(here("data/processed/workforce_unemployment.rds"))
unemployment_summary_long <- read_rds(here("data/processed/workforce_unemployment_sum_long.rds"))
# Create the plot for unemployment gap against Wilmington
employed_wide <- unemployment_summary_long %>% 
  mutate(employed_prop = 1 - unemployed_prop) %>%
  select(-unemployed_prop) %>%
  pivot_wider(names_from = label, values_from = employed_prop) %>% 
  # Calculate gaps to the parent geographies
  mutate(across(c(WRK, Riverside, Eastlake, Northeast), function(x) x - Delaware, .names = "{.col}_gap_to_Delaware")) %>%
  mutate(across(c(WRK, Riverside, Eastlake, Northeast), function(x) x - Wilmington, .names = "{.col}_gap_to_Wilmington"))

# Unemployment 
employed_WRK_gap_to_wilmingon_lm <- lm(data = employed_wide,
                                       formula = WRK_gap_to_Wilmington ~ year)
employed_gaps_yearly_change <- sprintf(fmt = "%.1f%%", employed_WRK_gap_to_wilmingon_lm$coefficients["year"] * 100)
employed_start_year <- employed_WRK_gap_to_wilmingon_lm$model$year %>% min()
employed_end_year <-  employed_WRK_gap_to_wilmingon_lm$model$year %>% max()
employed_gaps_lm_2017 <- employed_wide %>%
  filter(year >= 2017) %>%
  lm(data = ., formula = WRK_gap_to_Wilmington ~ year)
employed_gaps_yearly_change_2017 <- employed_gaps_lm_2017$coefficients["year"] * 100
```


```{r child='components/workforce_unemployment_valbox.Rmd'}
# Employment gaps to Wilmington, since 2017
```



### Employment rate

```{r}
# Get the list of target employments
employment_plot_targets <- c("WRK", "Riverside", "Eastlake", "Northeast")
employment_plots <- employment_plot_targets %>% 
  map(render_employment,
      .data = employed_wide, compare_to = "Wilmington")
names(employment_plots) <- employment_plot_targets


# Render to the page
tab_margin <- c(class = "m-4")
tabsetPanel(
  tabPanel("WRK Group Tracts",
           renderPlotly({ employment_plots$WRK }), 
           !!!tab_margin),
  tabPanel("Riverside (30.02)",
           renderPlotly({ employment_plots$Riverside }),
           !!!tab_margin),
  tabPanel("Eastlake (6.01)",
           renderPlotly({ employment_plots$Eastlake }),
           !!!tab_margin),
  tabPanel("Northeast (6.02)",
           renderPlotly({{ employment_plots$Northeast }}),
           !!!tab_margin)
)

```



### Notes {data-height=100}

- In the 3 census tracts served by the WRK group, the gap in employment rate to the Wilmington's employment rate have been improving on average
by `r employed_gaps_yearly_change` per year from `r employed_start_year` to `r employed_end_year`

- However, the gaps are worsening since 2017 by `r employed_gaps_yearly_change_2017 %>% round(1) %>% paste0("%")` per year.

Column 2
-----------------------------------------------------------------------


### Comparisons

```{r}
# Create a long data frame for plotting
employed_long <- employed_wide %>%
  select(-contains("_gap_to_")) %>%
  pivot_longer(cols = -year, names_to = "level", values_to = "prop_employed") %>% 
  mutate(level = recode(level, "WRK" = "WRK Group Tracts"))

# Add color column for plotting
employed_long <- employed_long %>%
  mutate(plot_color = recode(level, 
                             "WRK Group Tracts" = get_wrk_color("green"),
                             "Delaware" = "grey",
                             "Wilmington" = "grey",
                             .default = get_wrk_color("green")))

# Create a plot comparing three census tracts
plot_ly(x = ~year, y = ~prop_employed) %>%
  # Line for Wilmington
  plotly_add_employed_ine(employed_long, 
                          level = "Wilmington",
                          dash = "dot") %>%
  plotly_add_employed_ine(employed_long, 
                          level = "Riverside",
                          color = get_wrk_color("green"),
                          force_annotation_position = "top") %>%
  plotly_add_employed_ine(employed_long, 
                          level = "Eastlake",
                          color = get_wrk_color("blue_green", "secondary")) %>%
  plotly_add_employed_ine(employed_long, 
                          level = "Northeast",
                          color = get_wrk_color("dark_green", "secondary")) %>% 
  # Add title
  add_title(text = "Employment rate across 3 census tracts served by the WRK Group") %>%
  # Add source
  plotly_caption_source("Census 5-year ACS",
                        href = "https://www.census.gov/",
                        y = -0.05) %>% 
  # Format y-axis for percentages
  layout(yaxis = list(tickformat = ",.0%")) %>%
  # Hide axis labels
  plotly_remove_axis_titles() %>%
  plotly_hide_modebar() %>% 
  hide_legend() %>%
  # Hide vertical grid lines 
  layout(xaxis = list(showgrid = FALSE)) %>% 
  # Disable zoom
  plotly_disable_zoom()
```

# Safety {data-orientation=columns}
```{r, safety-setup}
# Load the survey data
safety_survey <- read_rds(here("data/processed/safety_WRK_survey_2021.rds"))
# Get categoricals and unnest
categoricals <- safety_survey$categoricals %>% 
  unnest(cols = c(summary_df))
# Get proportions within question
categoricals_prop <- categoricals %>% 
  group_by(question) %>% 
  drop_na(response) %>%
  mutate(prop = n / sum(n))
# Yes-no questions about points of concerns
yes_questions <- safety_survey$yes_questions
# Get proportions
yes_questions <- yes_questions %>%
  mutate(prop = yes / total_participants)
# Get safety concerns questsions only
safety_concerns <- yes_questions %>%
  filter(str_starts(question, "safety_concerns_"))

# Calculate the cumulative sum to determine the label positions
categoricals_prop <- categoricals_prop %>% 
  mutate(prop_cumsum = cumsum(prop) - (prop)/2)

```

Column 1
-----------------------------------------------------------------------

::::: {.d-flex}

### Day
```{r}

render_safety_valbox(categoricals_prop,
                     color = "primary",
                     icon = "fa-sun-o")
```

### Night

```{r}
render_safety_valbox(categoricals_prop,
                     question = "feel_safe_night",
                     caption = "survey participants reported feeling safe while walking at night",
                     color = "warning",
                     icon = "fa-moon-o")
```

:::::


### Safety rating
```{r}

# Create the community safety subplot
community_safety <- plot_categorical(categoricals_prop, question = "community_safety",
                                     question_label = "",
                                     hovertext_template = "%{x:,.1%} of participants rated the safety of the community as %{meta}")
feel_safe_day_plot <- plot_categorical(categoricals_prop,
                                       question_label = "During the day time",
                                       question = "feel_safe_day",
                                       hovertext_template = "%{x:,.1%} of participants reported feeling %{meta} when walkinig during the day time",
                                       barwidth = 1,
                                       annotation_ypos = 0.8)
feel_safe_night_plot <- plot_categorical(categoricals_prop, question = "feel_safe_night",
                                         question_label = "At night",
                                         hovertext_template = "%{x:,.1%} of participants reported feeling %{meta} when walkinig at night",
                                         include_annotation = FALSE,
                                         barwidth = 0.7)
community_safety %>%
  add_title("How would you rate the safety in the community?") %>%
  # Add caption
  plotly_caption_source("2020 Resident Survey")
```

### Walking
```{r}
subplot(feel_safe_day_plot,
        feel_safe_night_plot,
        nrows = 2, margin = 0) %>%
  add_title("How safe would you say you feel walking in the community?") %>%
  # Add caption
  plotly_caption_source("2020 Resident Survey")
```

Column 2
-----------------------------------------------------------------------

### Safety concerns

What are the top three safety concerns in Northeast Wilmington?

```{r}
# Create a hover text
concerns_template <- "%{x:,.1%} of participants reported %{meta} as one of their top three safety concerns" %>%
  str_wrap_hovertemplate(width = 30) %>%
  paste0("<extra></extra>")

# Lowercase the variable labels
safety_concerns <- safety_concerns %>%
  mutate(var_label_lower = str_to_lower(var_label))

# Plot
safety_concerns %>%
  arrange(prop) %>%
  plot_ly() %>%
  add_bars(x = ~prop,
           y = ~var_label %>% str_wrap(35),
           meta = ~var_label_lower %>% str_wrap(35),
           width = 0.5,
           color = I(get_wrk_color("green")),
           hovertemplate = concerns_template) %>%
  layout(xaxis = list(zerolinecolor = "grey")) %>%
  # Add padding to the labels to the vertical line
  layout(margin = list(pad = 10)) %>%
  # Order bar
  layout(yaxis = list(categoryorder = "mean ascending")) %>%
  # Top 
  # Order bar
  layout(xaxis = list(side = "top")) %>%
  # Ticks to percent
  layout(xaxis = list(tickformat = ",.0%")) %>%
  plotly_hide_modebar() %>%
  plotly_disable_zoom() %>%
  plotly_remove_axis_titles() %>%
  # Add caption
  plotly_caption_source("2020 Resident Survey", y = 0)
```


# Events {data-orientation=columns}
```{r, events-setup}
# Load data for events tab
events_warehouse <- read_rds(here("data/processed/events_warehouse_calendar.rds"))
# Trim the data up to the current date
events_warehouse <- events_warehouse %>%
  filter(EndTimeISO8601 < Sys.Date())

# Total number of hours spent for events
events_total_hours <- events_warehouse %>% 
  group_by(year) %>%
  summarise(hours = sum(duration_hour, na.rm = TRUE))

# Get the average number of hours community output
events_yearly_hours <- events_total_hours %>% 
  summarise(total = mean(hours)) %>% 
  pull(total)

# Get the average number of events per month
events_monthly_count <- events_warehouse %>% 
  count(year, month) %>% 
  summarise(mean_n = mean(n)) %>%
  pull(mean_n)
```


Column 1: Number of events
-----------------------------------------------------------------------

```{r child='components/events_per_month_valbox.Rmd'}
# average events hosted
```

### Number of events

```{r}
# Create a summary table
events_summary <- events_warehouse %>% group_by(year, month, location) %>% count()
# Add Month names
events_summary <- events_summary %>%
  mutate(month_abb = map_chr(month, ~month.abb[.]))
# Calculate the proportions of events within a month
events_summary <- events_summary %>%
  group_by(year, month) %>% 
  mutate(events_per_month = sum(n)) %>%
  mutate(prop_per_month = n / events_per_month)
# Get the text for percentages
events_summary <- events_summary %>%
  mutate(pct_per_month = scales::label_percent()(prop_per_month))
# Create the hovertext text to show for the plot
events_summary <- events_summary %>%
  mutate(hovertext = str_glue(
    "In {month_abb} {year}, {pct_per_month} of events were held at {location} ({n} out of {events_per_month} events)") %>%
      str_wrap_hovertemplate())

# Set colors for the plot
locations <- events_summary$location %>% 
  unique() %>% 
  sort()
n_locations <- locations %>% length()
locations_pal <- c(wrk_pal()(n_locations - 1), "grey")
names(locations_pal) <- locations


# Create a ggplot
event_counts_plot <- events_summary %>%
  # Rename columns to render for ggplotly
  ggplot(aes(x = month, 
             fill = location, 
             y = n,
             text = hovertext)) +
  geom_col() + 
  scale_x_continuous(labels = ~month.abb[.], breaks = 1:12) + 
  facet_wrap(year ~ ., ncol = 1) +
  labs(x = NULL, y = NULL,
       title = "Number of The Warehouse events over time",
       fill = "Top locations",
       caption = "Source: The Warehouse Public Calendar ") +
  scale_fill_manual(values = locations_pal) +
  # discrete_scale("fill", paste0("wrk_", "main"), palette = wrk_pal()) +
  # Remove gridlines
  theme(panel.grid.minor = element_blank(),
        panel.grid.major.x = element_blank())

# Convert the ggplot to Plotly and render it
ggplotly(event_counts_plot, tooltip = "text") %>% 
  plotly_disable_zoom() %>%
  plotly_hide_modebar() %>%
  # Disable the click event for the legend 
  layout(legend = list(itemclick = FALSE, itemdoubleclick = FALSE)) %>%
  # Add caption
  plotly_caption_source("The Warehouse Calendar",
                        "https://thewarehouse.recdesk.com/Community/Calendar",
                        y = -0.06,
                        font_size = 12)
```


Column 2: Duration
-----------------------------------------------------------------------

```{r child='components/events_yearly_hours_valbox.Rmd'}
# service provided to the community
```


### Duration of events

```{r}
# Plot Over time
events_weekly_duration <- events_warehouse %>%
  mutate(week = floor_date(StartTimeISO8601, "weeks")) %>%
  group_by(week) %>%
  summarise(weekly_sum = sum(duration_hour, na.rm = TRUE)) %>%
  mutate(year = year(week))

# Prepare hover text
events_weekly_duration <- events_weekly_duration %>%
  mutate(week_label = format(week, "%b %e, %Y")) %>%
  mutate(hovertext = str_glue("In the week of {week_label}, The Warehouse provided {weekly_sum} hours of events") %>% 
           str_wrap_hovertemplate())

# Sum of serviced weekly hours over time
events_weekly_plot <- events_weekly_duration %>%
  ggplot(aes(x = week, 
             y = weekly_sum, 
             group = 1,
             text = hovertext)) +
  geom_line(color = get_wrk_color("green")) + 
  scale_y_continuous(labels = ~paste0(., " hrs")) +
  scale_x_datetime(labels = scales::label_date("%b %Y")) + 
  labs(y = NULL,
       x = NULL,
       title = "Total event hours per week") + 
  # Remove grid lines
  theme(panel.grid.minor = element_blank(),
        panel.grid.major.x = element_blank())

# Render the plot
ggplotly(events_weekly_plot, tooltip = "text") %>%
  plotly_disable_zoom() %>%
  plotly_hide_modebar() %>%
  # Add caption
  plotly_caption_source("The Warehouse Calendar",
                        "https://thewarehouse.recdesk.com/Community/Calendar",
                        y = -0.15,
                        font_size = 12)
```


### Top events
```{r}
top_events <- events_warehouse %>%
  group_by(year, top_events) %>%
  summarise(sum_hour = sum(duration_hour, na.rm = TRUE))

# Add tooltip texts
top_events <- top_events %>%
  mutate(sum_hour_rounded = round(sum_hour, 1)) %>%
  mutate(hovertext = str_glue("In {year}, The Warehouse spent {sum_hour_rounded} hours for the event, {top_events}") %>%
           str_wrap_hovertemplate())

# Create a plot
top_events_plot <- top_events %>% 
  ggplot(aes(x = year, y = sum_hour, fill = top_events,
             text = hovertext)) + 
  geom_col() +
  scale_y_continuous(labels = ~paste0(., " hrs")) +
  labs(x = NULL,
       y = NULL,
       fill = "Top events",
       title = "Events with most hours") +
  # Use WRK group pallete 
  discrete_scale("fill", paste0("wrk_", "main"), palette = wrk_pal()) +
  # Remove grid lines 
  theme(panel.grid.minor = element_blank(),
        panel.grid.major.x = element_blank())

# Render plot
ggplotly(top_events_plot, tooltip = "text") %>% 
  plotly_disable_zoom() %>%
  plotly_hide_modebar() %>%
  # Disable the click event for the legend 
  layout(legend = list(itemclick = FALSE, itemdoubleclick = FALSE)) %>%
  # Add caption
  plotly_caption_source("The Warehouse Calendar",
                        "https://thewarehouse.recdesk.com/Community/Calendar",
                        y = -0.15,
                        font_size = 12)
```


# Housing {data-navmenu="Details" data-icon="fas fa-house-user"}
```{r}
# Set up a list of variable names for creating an UI 

# Load variable names
hud_vars_df <- read_excel(here("data/raw/hud_vars.xlsx"))
hud_vars <- hud_vars_df$variable
names(hud_vars) <- hud_vars_df$label

# Create a list of variable descriptions
hud_var_def <- hud_vars_df %>%
  select(variable, definition) %>%
  deframe()

```


Inputs {.sidebar}
-----------------------------------------------------------------------
### Outcome
```{r}
selectInput("selectedOutcome", label = NULL, 
            choices = hud_vars)
renderText({
  hud_var_def[[input$selectedOutcome]]
})
```


```{r}
selectInput("summaryMethod", label = h3("Summary Method"),
            choices = c("Sum" = "sum", "Average" = "mean"))
```

#### Potentially-Relevant Outcomes

- % Occupied
- % Moved past year
- Average months since move-in


Row 1
-----------------------------------------------------------------------

### Delaware
```{r}
renderPlot({
  
  selectedOutcome <- sym(input$selectedOutcome)
  
  hud_de %>%
    plot_bar(outcome = input$selectedOutcome,
             method = input$summaryMethod,
             y_lab = names(which(hud_vars == input$selectedOutcome)))
  
})
```


### 3 Tracts Combined

```{r}
renderPlot({
  
  selectedOutcome <- sym(input$selectedOutcome)
  
  hud_de %>%
    filter(code %in% target_tracts) %>%
    plot_bar(outcome = input$selectedOutcome,
             method = input$summaryMethod,
             y_lab = names(which(hud_vars == input$selectedOutcome)))
  
})
```


Row 2
-----------------------------------------------------------------------


### [CT30.02 (Riverside)][CT3002]

```{r}
renderPlot({
  
  selectedOutcome <- sym(input$selectedOutcome)
  
  hud_de %>%
    filter(code == "10003003002") %>%
    ggplot(aes(x = year, y = !!selectedOutcome)) +
    geom_plot_col +
    ylab(names(which(hud_vars == input$selectedOutcome)))
  
})
```


### [CT 6.01 (Eastlake/Eastlawn)][CT601]

```{r}
renderPlot({
  
  selectedOutcome <- sym(input$selectedOutcome)
  
  hud_de %>%
    filter(code == "10003000601") %>%
    ggplot(aes(x = year, y = !!selectedOutcome)) +
    geom_plot_col +
    ylab(names(which(hud_vars == input$selectedOutcome)))
  
})
```


### [CT 6.02 (Northeast)][CT602]

```{r}
renderPlot({
  
  selectedOutcome <- sym(input$selectedOutcome)
  
  hud_de %>%
    filter(code == "10003000602") %>%
    ggplot(aes(x = year, y = !!selectedOutcome)) +
    geom_plot_col +
    ylab(names(which(hud_vars == input$selectedOutcome)))
  
  
})
```

# Education {data-navmenu="Details" data-icon="fa-graduation-cap" data-orientation=rows}

Row 1
-----------------------------------------------------------------------

### Achievement Details

:::: {#achievement-container .d-flex .flex-row}

::: {#achievement-controls .d-flex .flex-column}
```{r}
# Input
default_contentareas <- c("ELA", "MATH")
selectInput(
  inputId = "contentareas",
  label = "Content Areas", 
  choices = contentareas,
  multiple = TRUE,
  selected = default_contentareas
)

# Select groups
default_groups <- c("State of Delaware", "East Side Charter School")
selectInput(
  inputId = "groups",
  label = "Groups", 
  choices = rev(groups),
  multiple = TRUE,
  selected = default_groups
)

# Select grades to plot, defaults to All Students only
selectInput(
  inputId = "ach_grades",
  label = "Grades",
  choices = c("3rd Grade",
              "4th Grade",
              "5th Grade",
              "6th Grade",
              "7th Grade",
              "8th Grade",
              "All Students"),
  multiple = TRUE,
  selected = "All Students"
)

actionButton("educationReset",
             icon = icon("fas fa-sync"),
             label = "Reset",
             class = "btn btn-secondary btn-sm align-self-center")

# Observe event for action button and reset to default 
observeEvent(input$educationReset, {
  updateSelectInput(session, "contentareas", selected = default_contentareas)
  updateSelectInput(session, "groups", selected = default_groups)
  return (NULL)
})
```
:::


```{r}
output$plot <- renderPlotly({
  plot_achievement(selected_contentarea = input$contentareas,
                   selected_orgs = input$groups,
                   selected_grades = input$ach_grades) %>%
    ggplotly(tooltip = c("y", "x", "colour"), dynamicTicks = FALSE)
})

plotlyOutput("plot")
```


:::: 

Row 2
-----------------------------------------------------------------------

### Graduation rate
```{r}
output$graduation <- renderPlotly({
  out_plot <- graduation %>% 
    ggplot(aes(x = schoolyear, y = pctgraduates,
               color = organization, group = organization)) +
    geom_line() +
    geom_point() +
    facet_grid(. ~ ratetype) +
    scale_y_continuous(labels = ~paste0(., "%")) +
    ylab(NULL) +
    xlab(NULL) + 
    labs(color = NULL) + 
    ggtitle("High school graduation rate")
  
  ggplotly(out_plot)
})

plotlyOutput("graduation")
```


```{r}
# Add JavaScript
tags$script(src = "inst/www/script.js")
```


<!-- Markdown Links -->

[CT3002]: https://censusreporter.org/profiles/14000US10003003002-census-tract-3002-new-castle-de/
[CT602]: https://censusreporter.org/profiles/14000US10003000602-census-tract-602-new-castle-de/
[CT601]: https://censusreporter.org/profiles/14000US10003000601-census-tract-601-new-castle-de/