02_run_document.Rmd

---
title: "Regional District Current Conditions Monitor"
date: "`r paste0('updated: ',as.Date(file.info(here::here('processed_data','district_conditions.rds'))$mtime-lubridate::hours(0)))`"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    social: menu
    source_code: https://github.com/bcgov/district_conditions
    css: style.css
runtime: shiny
resource_files:
- processed_data/pca.rds
- processed_data/standardized.rds
- processed_data/district_conditions.rds
- R/functions.R
---

```{r global, include=FALSE}
# Copyright 2022 Province of British Columbia
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.
# libraries----------
library(tidyverse)
library(sf)
# load objects--------
#bc_map <- bcmaps::bc_bound()
bcPalette <- c("#fabc29", "#1f4181")
source(here::here("R", "functions.R"))
district_conditions <- readRDS(here::here("processed_data", "district_conditions.rds"))
pca <- readRDS(here::here("processed_data", "pca.rds"))
standardized <- readRDS(here::here("processed_data", "standardized.rds"))
```

Maps
=====================================  

Inputs {.sidebar}
-------------------------------------

```{r}
plot_vars <- rev(unique(district_conditions$name)[str_detect(unique(district_conditions$name), 
                                                         pattern = "raw data", 
                                                         negate = TRUE)])
shiny::selectInput("what_var",
  label = "Variable to plot:",
  choices = plot_vars,
  selected = plot_vars[1]
)
```

* The overall index is a score (out of 10) based on 6 measures of economic activity.
* Each of the 6 measures are first normalized (either per capita or growth rate) and then put into 10 bins (deciles)
* The overall index is the average of the available deciles for each district. 
* An index based on Principal Components is also provided for comparison. 

Column 
-------------------------------------
    
### `r reactive({input$what_var})`
    
```{r, fig.retina = 3}
renderPlot({
  static_map(input$what_var, district_conditions)
}) %>%
bindCache(input$what_var)  
```


By District
=====================================  

Inputs {.sidebar}
-------------------------------------

```{r}
shiny::selectInput("which_district", 
            label = "Choose a district:",
            choices = unique(standardized$regional_district), 
            selected = unique(standardized$regional_district)[1]) 
```

* This plot allows you to compare a single district with all other districts.
* The height is the percentage of the maximum normalized (per capita or growth) measure of economic activity.
* Note that economic assistance and economic activity inversely related.  
 
    
Column 
-------------------------------------
    
### `r reactive({input$which_district})`
    
```{r}
  plotly::renderPlotly({
  standardized <-  standardized%>%
    mutate(colour=if_else(regional_district==input$which_district, input$which_district, "All other Districts"))
#  standardized<- plotly::highlight_key(standardized, ~District) #(for showing groups on hover) 
  plt <- ggplot(standardized, aes(name, 
                                  prop_of_max, 
                                  colour=colour,
                                  group=regional_district,
                                  text = paste(regional_district,
                                              name,
                                              scales::percent(prop_of_max, accuracy = .1),
                                              "of maximum value", sep=" ")))+
    geom_point(alpha=.5, size=4,
               position = position_jitter(seed = 1,
                                          width = .1, 
                                          height = 0),
               show.legend = FALSE)+
    scale_y_continuous(labels=scales::percent)+
    scale_colour_manual(values=bcPalette)+
    labs(x="",
         y="Percentage of maximum normalized value")+
    theme_minimal()
     
  gg <- plotly::ggplotly(plt, tooltip = "text")
  gg  
 # plotly::highlight(gg, on = "plotly_hover", off = "plotly_deselect", color = "#1f4181") #(for showing groups on hover) 
})%>%
  bindCache(input$which_district)
```

By Region
=====================================  

Inputs {.sidebar}
-------------------------------------

```{r}
shiny::selectInput("which_region", 
            label = "Choose a region:",
            choices = unique(district_conditions$Region), 
            selected = "Mainland/Southwest") 
```

* This table allows you to compare districts within a region across all measures of economic activity. 
    
Column 
-------------------------------------
    
### `r reactive({input$which_region})`
    
```{r}
DT::renderDataTable(server=FALSE, {
  temp <- district_conditions%>%
    filter(Region==input$which_region)%>%
    as_tibble()%>%
    select(-Region, -geometry)%>%
    distinct(regional_district, name, .keep_all = TRUE) %>%
    mutate(value=scales::comma(value, accuracy=.0001))%>%
    pivot_wider(id_cols = regional_district, names_from = name, values_from = value)%>%
    select(regional_district,
           contains("Overall"),
           contains("decile"),
           contains("per capita"),
           contains("growth"),
           everything())%>%
    DT::datatable(extensions = "Buttons",
              rownames = FALSE,     
              options = list(columnDefs = list(list(className = 'dt-center', targets = "_all")),
                             paging = TRUE,
                             scrollX=TRUE,
                             scrollY=TRUE,
                             searching = TRUE,
                             ordering = TRUE,
                             dom = 'Btip',
                             buttons = list(
                                list(extend = 'csv', filename =  input$which_region),
                                list(extend = 'excel', filename = input$which_region)
                             ),
                             pageLength=10, 
                             lengthMenu=c(3,5)))
})
```


By Variable
=====================================  

Inputs {.sidebar}
-------------------------------------

```{r}
shiny::selectInput("which_thing", 
            label = "Choose a variable:",
            choices = unique(district_conditions$thing), 
            selected = "Building Permits") 
```

* This table allows you to compare a variable across all districts.
    
Column 
-------------------------------------
    
### `r reactive({input$which_thing})`
    
```{r}
DT::renderDataTable(server=FALSE,{
  district_conditions%>%
    filter(thing==input$which_thing)%>%
    as_tibble()%>%
    select(-Region, -thing, -type, -geometry)%>%
    distinct(regional_district, name, .keep_all = TRUE) %>%
    mutate(value=scales::comma(value, accuracy=.0001))%>%
    pivot_wider(id_cols = regional_district, names_from = name, values_from = value)%>%
    select(regional_district, contains("decile"), contains("per capita"), contains("growth"),everything())%>%
    DT::datatable(extensions = "Buttons",
              rownames = FALSE,     
              options = list(columnDefs = list(list(className = 'dt-center', targets = "_all")),
                             paging = TRUE,
                             scrollX=TRUE,
                             scrollY=TRUE,
                             searching = TRUE,
                             ordering = TRUE,
                             dom = 'Btip',
                             buttons = list(
                                list(extend = 'csv', filename =  input$which_region),
                                list(extend = 'excel', filename = input$which_region)
                             ),
                             pageLength=10, 
                             lengthMenu=c(3,5)))
})
```

By Type
=====================================  

Inputs {.sidebar}
-------------------------------------

```{r}
shiny::selectInput("which_type", 
            label = "Choose a type:",
            choices = unique(district_conditions$type), 
            selected = "index") 
```

* This table allows you to compare a type of measure (raw data, normalized, index) across all districts.
    
Column 
-------------------------------------
    
### `r reactive({input$which_type})`
    
```{r}
DT::renderDataTable(server=FALSE,{
  district_conditions%>%
    filter(type==input$which_type)%>%
    as_tibble()%>%
    select(-Region, -thing, -type, -geometry)%>%
    distinct(regional_district, name, .keep_all = TRUE) %>%
    mutate(value=scales::comma(value, accuracy=.0001))%>%
    pivot_wider(id_cols = regional_district, names_from = name, values_from = value)%>%
    DT::datatable(extensions = "Buttons",
              rownames = FALSE,     
              options = list(columnDefs = list(list(className = 'dt-center', targets = "_all")),
                             paging = TRUE,
                             scrollX=TRUE,
                             scrollY=TRUE,
                             searching = TRUE,
                             ordering = TRUE,
                             dom = 'Btip',
                             buttons = list(
                                list(extend = 'csv', filename =  input$which_region),
                                list(extend = 'excel', filename = input$which_region)
                             ),
                             pageLength=10, 
                             lengthMenu=c(3,5)))
})
```


Index based on PCA
=====================================  

Inputs {.sidebar}
-------------------------------------

```{r}
shiny::selectInput("which_plot",
            label = "Choose a plot:",
            choices = c("Biplot", "Comparison"),
            selected = "Biplot")
```

* Principal component analysis is an alternative way to collapse data spanning multiple dimensions into a single measure (index).
* The first principal component (the x axis on the biplot) is the dimension that contains the greatest amount of information regarding the 6 measures of economic activity.
* The comparison plot compares the overall index (based on deciles) with the first principal component.
  
    
Column 
-------------------------------------
    
### 
    
```{r}
renderPlot({
  if(input$which_plot=="Biplot"){
  ggbiplot::ggbiplot(pca, 
                     alpha=.5, 
                     labels.size = 4,
                     varname.size = 4)+
  ggrepel::geom_text_repel(aes(label= str_to_title(str_replace_all(rownames(pca$scores),"_", " "))), alpha=.5)+
  theme_minimal()+
      xlim(-.18,.18)
  }else{
    district_conditions%>%
      filter(name=="Overall: index" | name=="PCA: index")%>%
      as_tibble()%>%
      select(regional_district, name, value)%>%
      distinct(regional_district, name, .keep_all = TRUE) %>%
      pivot_wider(id_cols = c(regional_district), names_from = name, values_from = value)%>%
      ggplot(aes(`PCA: index`,`Overall: index`, label=regional_district))+
      geom_smooth(method="lm", se = FALSE, colour="grey")+
      geom_point()+
      ggrepel::geom_label_repel()
    
  }
})
```