---
Title: "Models of Neighborhood Change in San Diego"
author: "Gregorio Salcedo"
date: "`r Sys.Date()`"
output:
flexdashboard::flex_dashboard:
theme: bootstrap
source: embed
smart: false
runtime: static
---
```{r global, echo=FALSE}
library(flexdashboard)
library(shiny)
library(dplyr)
library(DT)
library(pander)
library(knitr)
library(geojsonio)
library(sp)
library(sf)
library(tmap)
library(mclust)
library(cartogram)
library(tidycensus)
library(stargazer)
library(ggmap)
library(leaflet)
library(viridis)
library(pals)
library(rgdal)
library(ggplot2)
```
```{r, include=FALSE}
# DATA STEPS
# load dorling cartogram for San Diego
url <- "https://www.dropbox.com/scl/fi/b4sm1xbvhvqhj1zk6ephd/sd_dorling.geojson?rlkey=n2bv4ncl49888r8jtzn9ny73r&dl=1"
sdd <- geojson_read(x = url, what = "sp")
# reproject the map
sdd2 <- spTransform(sdd, CRS("+init=epsg:3395"))
# convert to sf for use in ggplot/leaflet
sd.sf <- st_as_sf(sdd2)
# extract data frame of features for plotting
d <- as.data.frame(sd.sf)
```
```{r}
```
Community Demographics
=====================================
Inputs {.sidebar}
-------------------------------------
```{r}
# Census variables for selection
vars <- c("pnhwht12", "pnhblk12", "phisp12", "pntv12", "pfb12", "polang12",
"phs12", "pcol12", "punemp12", "pflabf12", "pprof12", "pmanuf12",
"pvet12", "psemp12", "hinc12", "incpc12", "ppov12", "pown12",
"pvac12", "pmulti12", "mrent12", "mhmval12", "p30old12",
"p10yrs12", "p18und12", "p60up12", "p75up12", "pmar12",
"pwds12", "pfhh12")
radioButtons(inputId = "demographics",
label = h3("Select Demographic Variable"),
choiceValues = vars,
choiceNames = vars,
selected = "pnhwht12")
# Adding interpretable variable names
# from the data dictionary:
# add a name attribute for each variable
#
# value <- c(1,2,3)
# dd.name <- c("one","two","three")
#
# x <- dd.name
# names(x) <- value
#
# dd names and values linked
# names( x[2] )
#
# can now get the label using the value
# using the name attributes
# x[ "two" ]
#
# to add labels to the maps
# use the radio button value
# to get the data dictionary label:
#
# x[ input$demographics ]
```
Row {.tabset}
-------------------------------------
### Choropleth Map
```{r}
renderPlot({
# Dynamically compute deciles for selected demographic variable
var_name <- input$demographics
var_values <- as.numeric(sd.sf[[var_name]])
df <- sd.sf %>% mutate(decile = ntile(var_values, 10))
# Use variable name for titles
ggplot(df) +
geom_sf(aes(fill = decile), color = NA) +
coord_sf(datum = NA) +
labs(
title = paste0("Choropleth of ", var_name),
subtitle = paste0("Deciles of ", var_name),
caption = "Source: ACS & DS4PS",
fill = "Decile"
)
})
```
```{r}
renderPlot({
var <- sd.sf[[input$demographics]]
decile <- ntile(var, 10)
ggplot(sd.sf) +
geom_sf(aes(fill = decile), color = NA) +
coord_sf(datum = NA) +
labs(
title = paste0("Choropleth of ", input$demographics),
fill = "Decile",
caption = "Source: ACS & DS4PS"
)
})
```
### Variable Distribution
```{r}
renderPlot({
# Extract selected variable as a vector
get_variable_x <- reactive({ d[[ input$demographics ]] })
x <- get_variable_x() %>% unlist()
# Calculate decile cut points
cut.points <- quantile(x, seq(0, 1, 0.1), na.rm = TRUE)
# Plot histogram with decile lines
hist(x, breaks = 50,
col = "gray", border = "white", yaxt = "n",
main = paste0("Histogram of variable ", toupper(input$demographics)),
xlab = "Red lines represent decile cut points")
abline(v = cut.points, col = "darkred", lty = 3, lwd = 2)
})
```
Neighborhoods
=====================================
### Clusters
```{r}
# Define bounding box dynamically
bb <- st_bbox(sd.sf)
# Add custom labels to the clusters
# Replace "1" and "2" with your actual cluster IDs
sdd2$cluster[sdd2$cluster == "1"] <- "Baby Boomers"
sdd2$cluster[sdd2$cluster == "2"] <- "Hipsters"
# Interactive cluster map
renderTmap({
tmap_mode("view")
tm_basemap("CartoDB.Positron") +
tm_shape(sdd2, bbox = bb) +
tm_polygons(col = "cluster", palette = "Accent",
title = "Community Types")
})
```
NH Change 2000-2010
=====================================
Inputs {.sidebar}
-------------------------------------
```{r}
button.labels <- c("Median Home Value 2000","Median Home Value 2010","Value Change 2000-2010","Growth in Home Value")
button.values <- c("mhv.2000","mhv.2010","mhv.change","mhv.growth")
radioButtons( inputId="home.value",
label = h3("Home Values"),
# choices = these.variables,
choiceNames=button.labels,
choiceValues=button.values,
selected="mhv.2000")
```
Row {.tabset}
-------------------------------------
### Median Home Values
```{r}
renderPlot({
# Spatial distribution of selected home value metric
df <- sd.sf %>% mutate(q = ntile(as.numeric(get(input$home_value)), 10))
ggplot(df) +
geom_sf(aes(fill = q), color = NA) +
coord_sf(datum = NA) +
labs(
title = paste0("Spatial Distribution of Home Values: ", toupper(input$home_value)),
caption = "Source: Harmonized Census Files",
fill = "Home Value Deciles"
) +
scale_fill_gradientn(colours = rev(ocean.balance(10)), guide = "colourbar") +
xlim(-12519146, -12421368) +
ylim(3899074, 3965924)
})
```
### Variable Distribution
```{r}
renderPlot({
# extract vector x from the data frame
get_variable_x <- reactive({ d[[ input$home_value ]] })
x <- get_variable_x() %>% unlist() %>% as.numeric()
# calculate decile cut points
cut.points <- quantile(x, seq(0, 1, 0.1), na.rm = TRUE)
# plot histogram with decile lines
hist(x, breaks = 50,
col = "gray", border = "white", yaxt = "n",
main = paste0("Histogram of ", toupper(input$home_value)),
xlab = "Red lines represent decile cut points")
abline(v = cut.points, col = "darkred", lty = 3, lwd = 2)
})
```
Drivers of Change
=====================================
Inputs {.sidebar}
-------------------------------------
```{r}
button.labels <- c("Median Home Value 2000","Median Home Value 2010","Value Change 2000-2010","Growth in Home Value")
button.values <- c("mhv.2000","mhv.2010","mhv.change","mhv.growth")
radioButtons( inputId="dv",
label = h3("Select Your Dependent Variable"),
choiceNames=button.labels,
choiceValues=button.values,
selected="mhv.change")
covariates <- c("pnhwht12", "pnhblk12", "phisp12", "pntv12", "pfb12", "polang12",
"phs12", "pcol12", "punemp12", "pflabf12", "pprof12", "pmanuf12",
"pvet12", "psemp12", "hinc12", "incpc12", "ppov12", "pown12",
"pvac12", "pmulti12", "mrent12", "mhmval12", "p30old12", "p10yrs12",
"p18und12", "p60up12", "p75up12", "pmar12", "pwds12", "pfhh12")
# covariate.labels <- c( ... )
checkboxGroupInput( inputId="covariates",
label = h3("Select Variables for Your Model"),
choices = covariates,
# choiceNames=covariate.labels,
# choiceValues=covariates,
selected=c("pnhwht12","pprof12","pvac12") )
```
Row {.tabset}
-------------------------------------
### Predicting Change
```{r, results="asis"}
# Generate regression based on user inputs
renderUI({
# Build formula text
formula_text <- paste(
input$dv, "~", paste(input$covariates, collapse = " + ")
)
# Convert to formula and fit model
fit <- lm(as.formula(formula_text), data = d)
# Display results with stargazer
HTML(
paste0(
"<div style='width:60%; margin:0 auto'>",
stargazer(fit, type = "html", omit.stat = c("rsq","f")),
"</div>"
)
)
})
```
### Correlation Plots
```{r}
pairs( iris )
```
<style>
.chart-shim { overflow: auto; }
table{
border-spacing:1px;
margin-top:30px;
margin-bottom:30px;
margin-left: auto;
margin-right: auto;
align:center}
td{ padding: 6px 10px 6px 10px }
th{ text-align: left; }
</style>
