Clustered Small Areas Map

---
title: "Mapping Small Areas"
output:
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
---
```{r setup, include=FALSE}
 
#############################################
# Start
#############################################
 
# Load libraries
library(flexdashboard)
library(rgdal)
library(GISTools)
library(leaflet)
library(leaflet.extras)
library(maptools)
library(dplyr)
 
 
# Load shapefiles
county_2016 <- readShapePoly("G:\\Spatial\\01_Data\\01_Census_Data\\02_2016_Census\\02_Data\\Admin_Counties_Generalised_20m__OSi_National_Boundaries.shp")
saps <- readShapePoly("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Shapefiles\\saps.shp")
saps$CNTY_ID <- as.character(saps$CNTY_ID)
 
 
# Subset the SAPS shapefile to get individual shapefiles for each cluster
group_1   <- saps[saps$PAMcluster == 1, ]
group_11  <- saps[saps$PAMcluster == 11, ]
group_13  <- saps[saps$PAMcluster == 13, ]
group_17  <- saps[saps$PAMcluster == 17, ]
 
 
 
# Load university csv (contains latitude/longitude of some universities)
uni <- read.csv("G:\\Spatial\\01_Data\\Csv\\university.csv", stringsAsFactors=FALSE, strip.white = TRUE, header=T, na.strings=c("","NA"))
nuim      <- uni[uni$Name == "NUIM",]
ucd       <- uni[uni$Name == "UCD",]
dcu       <- uni[uni$Name == "DCU",]
tcd       <- uni[uni$Name == "TCD",]
nuig      <- uni[uni$Name == "NUIG",]
ul        <- uni[uni$Name == "UL",]
ucc       <- uni[uni$Name == "UCC",]
dit       <- uni[uni$Name == "DIT",]
wit       <- uni[uni$Name == "Waterford IT",]
gmit      <- uni[uni$Name == "GMIT",]
ait       <- uni[uni$Name == "Athlone IT",]
 
 
 
 
# Create university icons
NUIM_icon <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\nuim.png", iconWidth = 26,
                      iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
UCD_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\ucd.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
DCU_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\dcu.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
TCD_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\tcd.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
NUIG_icon <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\nuig.png", iconWidth = 26,
                      iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
UL_icon   <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\ul.png", iconWidth = 26,
                    iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
UCC_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\ucc.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
DIT_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\dit.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
AIT_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\ait.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
GMIT_icon <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\gmit.png", iconWidth = 26,
                      iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
WIT_icon  <- makeIcon("G:\\Spatial\\02_Projects\\02_ERNIE_2016_Census\\02_Data\\Images\\wit.png", iconWidth = 26,
                     iconHeight =37, iconAnchorX =13 , iconAnchorY = 37)
 
 
 
# Create palettes
pal_county_2016 <- colorNumeric(
  palette = "Blues",
  domain = county_2016$total_pop
)
pal_SA_Pop_1 <- colorNumeric(
  palette = "Blues",
  domain = group_1$TOTAL_POP
)
pal_SA_Pop_11 <- colorNumeric(
  palette = "Blues",
  domain = group_11$TOTAL_POP
)
pal_SA_Pop_17 <- colorNumeric(
  palette = "Blues",
  domain = group_17$TOTAL_POP
)
pal_SA_Pop_13 <- colorNumeric(
  palette = "Blues",
  domain = group_13$TOTAL_POP
)
 
 
 
# Use dplyr to roll up SAPS data to county Level
# (Note: this data is already available at county level from CSO)
library(dplyr)
county_summary <- saps@data %>%
                    group_by(CNTY_ID) %>%
                        summarise(
                            total_pop = sum(TOTAL_POP),
                            male_pop = sum(MALE_POP),
                            female_pop = sum(FEMALE_POP),
                            no_small_areas = n(),
                            group_1 = sum(PAMcluster == 1),
                            group_2 = sum(PAMcluster == 2),
                            group_3 = sum(PAMcluster == 3),
                            group_4 = sum(PAMcluster == 4)
                           
                            )
county_summary <- data.frame(county_summary)
 
 
 
# Merge county_summary with county_2016 shapefile, based on "CNTY_ID"
county_2016 <- merge(county_2016, county_summary, by = "CNTY_ID")
 
 
 
 
```

### Clustered Small Areas Map
```{r echo=FALSE}
 
 
# Create leaflet map
 
map <- leaflet() %>%
 
addProviderTiles("CartoDB.Positron") %>%
 
addBootstrapDependency() %>%
 
addFullscreenControl() %>%
 
addHash() %>%
 
addMiniMap() %>%
 
addEasyButton(easyButton(
  icon="fa-globe", title="Reset View",
  onClick=JS("function(btn, map){map.setView([53.43, -7.78], 7);}"))) %>%
 
addMarkers(data = nuim, icon = NUIM_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = ucd, icon = UCD_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = dcu, icon = DCU_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = tcd, icon = TCD_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = nuig, icon = NUIG_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = ul, icon = UL_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = ucc, icon = UCC_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = dit, icon = DIT_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = wit, icon = WIT_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = gmit, icon = GMIT_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
addMarkers(data = ait, icon = AIT_icon, options = markerOptions(riseOnHover=TRUE, riseOffset = 1000),
             group = "Universities") %>%
 
 
 
# Cluster 1 - Rural Agricultural Families
addPolygons(
    data = group_1,
    color = "#444444",
    weight = 1,
    smoothFactor = 0.5,
    opacity = 1.0,
    fillOpacity = 0.6,
    fillColor = ~pal_SA_Pop_1(TOTAL_POP),
    highlightOptions = highlightOptions(color = "white", weight = 1, bringToFront = TRUE),
    popup = paste0("

Cluster 1 - Agricultural Families


", "County: ", group_1$COUNTYNAME, "
", "Total Population: ", group_1$TOTAL_POP), group = "Cluster 1 - Rural Agricultural Families" ) %>% # Group 11 - Students/Student Accomodation addPolygons( data = group_11, color = "#444444", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.6, fillColor = ~pal_SA_Pop_11(TOTAL_POP), highlightOptions = highlightOptions(color = "white", weight = 1, bringToFront = TRUE), popup = paste0("

Cluster 2 - Students/Student Accomodation


", "County: ", group_11$COUNTYNAME, "
", "Total Population: ", group_11$TOTAL_POP), group = "Cluster 11 - Students/Student Accomodation" ) %>% # Cluster 17 - Young, Affluent Urbanites addPolygons( data = group_17, color = "#444444", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.6, fillColor = ~pal_SA_Pop_17(TOTAL_POP), highlightOptions = highlightOptions(color = "white", weight = 1, bringToFront = TRUE), popup = paste0("

Cluster 17 - Young, Affluent Urbanites


", "County: ", group_17$COUNTYNAME, "
", "Total Population: ", group_17$TOTAL_POP), group = "Cluster 17 - Young, Affluent Urbanites" ) %>% # Cluster 13 - Struggling Households addPolygons( data = group_13, color = "#444444", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.6, fillColor = ~pal_SA_Pop_13(TOTAL_POP), highlightOptions = highlightOptions(color = "white", weight = 1, bringToFront = TRUE), popup = paste0("

Cluster 13 - Struggling Households


", "County: ", group_13$COUNTYNAME, "
", "Total Population: ", group_13$TOTAL_POP), group = "Cluster 13 - Struggling Households" ) %>% # Add county_2016 shapefile addPolygons( data = county_2016, color = "#444444", weight = 1, smoothFactor = 0.5, opacity = 1.0, fillOpacity = 0.6, fillColor = ~pal_county_2016(total_pop), highlightOptions = highlightOptions(color = "white", weight = 1, bringToFront = TRUE), popup = paste0("

", county_2016$ENGLISH, "


", "Total Population: ", format(round(as.numeric(county_2016$total_pop), 0), big.mark=","), "
", "Female Population: ", format(round(as.numeric(county_2016$female_pop), 0), big.mark=","), "
", "Male Population: ", format(round(as.numeric(county_2016$male_pop), 0), big.mark=","), "
", "Number of Small Areas: ", format(round(as.numeric(county_2016$no_small_areas), 0), big.mark=",")), group = "County" ) %>% addLegend("bottomleft", colors = c("#08306b", "#08519c", "#2171b5", "#6baed6", "#9ecae1", "#c6dbef", "#deebf7", "#f7fbff"), labels= c("High", "","","","","","", "Low"), title= "Total Population", opacity = 0.6) %>% addLayersControl( overlayGroups = c("Universities"), baseGroups = c("Cluster 1 - Rural Agricultural Families", "Cluster 11 - Students/Student Accomodation", "Cluster 17 - Young, Affluent Urbanites", "Cluster 13 - Struggling Households", "County"), options = layersControlOptions(collapsed = FALSE) ) map %>% hideGroup(c("Universities")) ############################################# # End ############################################# ```