Spatial Demography - Homewk 1 - Exploratory Analysis

# Download ACS data for the year 2015 for Los Angeles County, California census tracts in R using the tidycensus library

LA_county <- get_acs(geography = 'tract',variables = c(totPop15 = "B01001_001", 
                                                   hispanic ="B03003_003", 
                                                   afrAm = "B02001_003"), 
                    year = 2015, state = 'CA', county="Los Angeles", geometry = TRUE) %>% 
            dplyr::select(GEOID, NAME, variable, estimate) %>% 
            spread(variable, estimate) %>% 
            mutate(hispPr15  = hispanic/totPop15, 
                   nhblackpr15 = afrAm/totPop15, racer=round((afrAm/hispanic)*100),1) %>%
            dplyr::select(GEOID,totPop15,hispPr15,nhblackpr15,racer)

## Getting data from the 2011-2015 5-year ACS

## Downloading feature geometry from the Census website.  To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.

# Load County Boundary for California
lacounty<- counties(year=2015, state = "CA", refresh=T, cb = T, progress_bar=FALSE)

# ASsign same CSR for both the boundary and Race ratio shape files, then intersect it
LA_Boundary<- st_transform(lacounty, 4326)
LA_censustract <- st_transform(LA_county, 4326)
LAcounty <- st_intersection(LA_censustract,LA_Boundary)

# Filter out tracts without race ratios
LAcounty<-LAcounty%>%
  filter(complete.cases(racer))


Hispanic <- LAcounty%>%
  mutate(hispPr15=cut(hispPr15,
                  breaks = quantile(LAcounty$hispPr15,
                                    p=c(0, .25, .5, .75, 1)),
                  include.lowest = T))%>%
  ggplot()+
  geom_sf(aes(fill=hispPr15, color=hispPr15))+theme_void()+
  scale_fill_brewer(palette = "Blues")+
  scale_color_brewer(palette = "Blues")+
  ggtitle("Los Angeles Hispanic Race Proportion")+labs(fill="Hispanic Proportion", color="Hispanic Proportion")+
  theme(plot.title = element_text(size=10, hjust = 0.2)) +
  theme(
        legend.key.width = unit(0.25, "in"),
        legend.key.height = unit(0.2, "in"),
        legend.text = element_text(size=8))


Black <- LAcounty%>%
  mutate(nhblackpr15=cut(nhblackpr15,
                  breaks = quantile(LAcounty$nhblackpr15,
                                    p=c(0, .25, .5, .75, 1)),
                  include.lowest = T))%>%
  ggplot()+
  geom_sf(aes(fill=nhblackpr15, color=nhblackpr15))+theme_void()+
  scale_fill_brewer(palette = "Blues")+
  scale_color_brewer(palette = "Blues")+
  ggtitle("Los Angeles Non-Hispanic Black Race Proportion")+labs(fill="Non-HBlack Proportion", color="Non-HBlack Proportion")+
  theme(plot.title = element_text(size=10, hjust = 0.2)) +
  theme(
        legend.key.width = unit(0.25, "in"),
        legend.key.height = unit(0.2, "in"),
        legend.text = element_text(size=8))


BHRR <- LAcounty%>%
  mutate(racer=cut(racer,
                  breaks = quantile(LAcounty$racer,
                                    p=c(0, .25, .5, .75, 1)),
                  include.lowest = T))%>%
  ggplot()+
  geom_sf(aes(fill=racer, color=racer))+
  scale_fill_brewer(palette = "Blues")+
  scale_color_brewer(palette = "Blues")+theme_void()+
  ggtitle("Los Angeles Non-HBlack To Hispanic Race Ratio")+labs(fill="Black-Hispanic Race Ratio", color="Black-Hispanic Race Ratio")+
  theme(plot.title = element_text(size=10, hjust = 0.0)) +
  theme(
        legend.key.width = unit(0.25, "in"),
        legend.key.height = unit(0.2, "in"),
        legend.text = element_text(size=8))

grid.arrange(Hispanic, Black,BHRR, nrow = 2)

Queen-based contiquity

Lanb<-poly2nb(LAcounty, queen=T)
summary(Lanb)

## Neighbour list object:
## Number of regions: 2323 
## Number of nonzero links: 14728 
## Percentage nonzero weights: 0.2729263 
## Average number of links: 6.340077 
## Link number distribution:
## 
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  19  25 
##   4  10  51 201 469 610 484 274 132  51  23   5   1   2   1   2   2   1 
## 4 least connected regions:
## 145 264 1328 1329 with 1 link
## 1 most connected region:
## 1013 with 25 links

Lalw<-nb2listw(Lanb, style="W")

# Map Plots for the Neighbors 
plot(as(LAcounty, "Spatial"),
     main="Queen-based Neighbors")
plot(Lalw,
     coords=coordinates(as(LAcounty, "Spatial")),
     add=T,
     col=2)

k-nearest neighbor adjacency

knn<-knearneigh(x = coordinates(as(LAcounty, "Spatial")), k = 4)
knn3<-knn2nb(knn = knn)
Lalwk<-nb2listw(knn3, style="W")

# Map Plots for the Neighbors
plot(as(LAcounty, "Spatial"),
     main="k=4 Neighbors")
plot(knn3,
     coords=coordinates(as(LAcounty, "Spatial")),
     add=T,
     col=2)

Queen-based Moran I

#Moran test for the Hispanic population
moran.test(LAcounty$hispPr15, 
           listw=Lalw)

## 
##  Moran I test under randomisation
## 
## data:  LAcounty$hispPr15  
## weights: Lalw    
## 
## Moran I statistic standard deviate = 68.86, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic       Expectation          Variance 
##      0.8191397397     -0.0004306632      0.0001416582

moran.mc(LAcounty$hispPr15,
         listw=Lalw,
         nsim=999)

## 
##  Monte-Carlo simulation of Moran I
## 
## data:  LAcounty$hispPr15 
## weights: Lalw  
## number of simulations + 1: 1000 
## 
## statistic = 0.81914, observed rank = 1000, p-value = 0.001
## alternative hypothesis: greater

#Moran Scatter plot Hispanic population
moran.plot(as.numeric(scale(LAcounty$hispPr15)),
           listw=Lalw)

# Moran test for the black population
moran.test(LAcounty$nhblackpr15, 
           listw=Lalw)

## 
##  Moran I test under randomisation
## 
## data:  LAcounty$nhblackpr15  
## weights: Lalw    
## 
## Moran I statistic standard deviate = 66.349, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic       Expectation          Variance 
##      0.7871447555     -0.0004306632      0.0001408999

moran.mc(LAcounty$nhblackpr15,
         listw=Lalw,
         nsim=999)

## 
##  Monte-Carlo simulation of Moran I
## 
## data:  LAcounty$nhblackpr15 
## weights: Lalw  
## number of simulations + 1: 1000 
## 
## statistic = 0.78714, observed rank = 1000, p-value = 0.001
## alternative hypothesis: greater

#Moran Scatter plot for the black population
moran.plot(as.numeric(scale(LAcounty$nhblackpr15)),
           listw=Lalw)

Using the queen rule to define tracts that are neighbors, the global Moran I statistics is 0.83 . This shows that there is a significant strong positive association between the proportion of Hispanic population in tracts and their spatially lagged values(p-value=2.2e-16). We see the same relationship for the Non-Hispanic Black variable with a global Moran I statistics of 0.78 and a p-value of 2.2e-16

k-nearest Moran I

#Moran test for the Hispanic population
moran.test(LAcounty$hispPr15, 
           listw=Lalwk)

## 
##  Moran I test under randomisation
## 
## data:  LAcounty$hispPr15  
## weights: Lalwk    
## 
## Moran I statistic standard deviate = 60.405, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic       Expectation          Variance 
##      0.8349493475     -0.0004306632      0.0001912561

moran.mc(LAcounty$hispPr15,
         listw=Lalwk,
         nsim=999)

## 
##  Monte-Carlo simulation of Moran I
## 
## data:  LAcounty$hispPr15 
## weights: Lalwk  
## number of simulations + 1: 1000 
## 
## statistic = 0.83495, observed rank = 1000, p-value = 0.001
## alternative hypothesis: greater

#Moran Scatter plot for the Hispanic population
moran.plot(as.numeric(scale(LAcounty$hispPr15)),
           listw=Lalwk)

#Moran test for the Black population
moran.test(LAcounty$nhblackpr15, 
           listw=Lalwk)

## 
##  Moran I test under randomisation
## 
## data:  LAcounty$nhblackpr15  
## weights: Lalwk    
## 
## Moran I statistic standard deviate = 56.331, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic       Expectation          Variance 
##      0.7765172349     -0.0004306632      0.0001902322

moran.mc(LAcounty$nhblackpr15,
         listw=Lalwk,
         nsim=999)

## 
##  Monte-Carlo simulation of Moran I
## 
## data:  LAcounty$nhblackpr15 
## weights: Lalwk  
## number of simulations + 1: 1000 
## 
## statistic = 0.77652, observed rank = 1000, p-value = 0.001
## alternative hypothesis: greater

#Moran Scatter plot for the Black population
moran.plot(as.numeric(scale(LAcounty$nhblackpr15)),
           listw=Lalwk)

Using the k-nearest(k=4) rule to define tracts that are neighbors, the global Moran I statistics is 0.83 . This shows that there is a significant strong positive association between the proportion of Hispanic population in tracts and their spatially lagged values(p-value=2.2e-16). We see the same relationship for the Non-Hispanic Black variable with a global Moran I statistics of 0.78 and a p-value of 2.2e-16. There is no difference between the Moran I statistics of the two methods of defining neighbor tracts (Queen-based and k-nearest)

k-nearest Cluster Moran I

locali<-localmoran(LAcounty$hispPr15, 
           listw=Lalwk, p.adjust.method="fdr")
LAcounty$localr<-locali[,1]
LAcounty$locall<-locali[,5]

LAcounty$srr<-scale(LAcounty$hispPr15)
LAcounty$lag_rr<-lag.listw(var=LAcounty$srr, x = Lalwk)
LAcounty$quad_sig <- NA
LAcounty$quad_sig[(LAcounty$srr >= 0 & LAcounty$lag_rr >= 0) & (LAcounty$locall <= 0.05)] <- "H-H" #high high
LAcounty$quad_sig[(LAcounty$srr <= 0 & LAcounty$lag_rr <= 0) & (LAcounty$locall <= 0.05)] <- "L-L" #low low
LAcounty$quad_sig[(LAcounty$srr >= 0 & LAcounty$lag_rr <= 0) & (LAcounty$locall <= 0.05)] <- "H-L" #high low
LAcounty$quad_sig[(LAcounty$srr <= 0 & LAcounty$lag_rr >= 0) & (LAcounty$locall <= 0.05)] <- "L-H" #low high

#WE ASSIGN A # Set the breaks for the thematic map classes
breaks <- seq(1, 5, 1)

# Set the corresponding labels for the thematic map classes
labels <- c("High-High", "Low-Low", "High-Low", "Low-High", "Not Clustered")

# see ?findInterval - This is necessary for making a map
np <- findInterval(LAcounty$quad_sig, breaks)

# Assign colors to each map class
colors <- c("red", "blue", "lightpink", "skyblue2", "white")

his <- LAcounty%>%
  filter(complete.cases(hispPr15)) %>% 
  ggplot()+
  geom_sf(aes(fill = quad_sig))+
  ggtitle("Moran Cluster Map -\nProportion of Hispanic Population",
          sub=" Los Angeles County, CA")+labs(fill="Proportion of Hispanic", color="Proportion of Hispanic")+
  theme(plot.title = element_text(size=14, hjust = 0.2)) +theme_void()+
  theme(
        legend.key.width = unit(0.5, "in"),
        legend.key.height = unit(0.3, "in"),
        legend.text = element_text(size=8))

locali<-localmoran(LAcounty$nhblackpr15, 
           listw=Lalwk, p.adjust.method="fdr")
LAcounty$localr<-locali[,1]
LAcounty$locall<-locali[,5]

LAcounty$srr<-scale(LAcounty$hispPr15)
LAcounty$lag_rr<-lag.listw(var=LAcounty$srr, x = Lalwk)
LAcounty$quad_sig <- NA
LAcounty$quad_sig[(LAcounty$srr >= 0 & LAcounty$lag_rr >= 0) & (LAcounty$locall <= 0.05)] <- "H-H" #high high
LAcounty$quad_sig[(LAcounty$srr <= 0 & LAcounty$lag_rr <= 0) & (LAcounty$locall <= 0.05)] <- "L-L" #low low
LAcounty$quad_sig[(LAcounty$srr >= 0 & LAcounty$lag_rr <= 0) & (LAcounty$locall <= 0.05)] <- "H-L" #high low
LAcounty$quad_sig[(LAcounty$srr <= 0 & LAcounty$lag_rr >= 0) & (LAcounty$locall <= 0.05)] <- "L-H" #low high

#WE ASSIGN A # Set the breaks for the thematic map classes
breaks <- seq(1, 5, 1)

# Set the corresponding labels for the thematic map classes
labels <- c("High-High", "Low-Low", "High-Low", "Low-High", "Not Clustered")

# find Interval - This is necessary for making a map
np <- findInterval(LAcounty$quad_sig, breaks)

# Assign colors to each map class
colors <- c("red", "blue", "lightpink", "skyblue2", "white")

blk <- LAcounty%>%
  ggplot()+
  geom_sf(aes(fill = quad_sig))+
  ggtitle("Moran Cluster Map -\nProportion of Non-Hispanic Black Population",
          sub=" Los Angeles County, CA")+labs(fill="Non-Hispanic Black", color="Proportion of Non-Hispanic Black")+
  theme(plot.title = element_text(size=14, hjust = 0.2)) +theme_void()+
  theme(
        legend.key.width = unit(0.5, "in"),
        legend.key.height = unit(0.3, "in"),
        legend.text = element_text(size=))
grid.arrange(his, blk, nrow = 1)

Here is a LISA map for clusters of hispanic and Non-Hispanic black in Los Angeles county, CA, which shows areas of concentrated (clustered) low income clustering in red, and concentrated high income in blue.

The red and blue areas are so-called clusters, because they are areas with higher (or lower, for the blues) than average proportion of the races, surrounded by areas that also have higher than average race proportion for the two groups. The red clusters are so called “high-high clusters”, likewise the blue areas are called “low-low clusters”.

These maps suggests that LA county is highly segregated by race.

Likewise, possible values include light blue polygons, these are called low-high outliers, because they have low proportion of the non-hispanic black population, but are in a high proportion of other races spatial neighborhood.