Population

Column

Population Change by Census Division (2011 to 2016)

Column

Absolute Population per Province (2011 and 2016)

Percentage Change in Population (2011 to 2016)

Dwellings

Column

Change in Private Dwellings by Census Devision (2011 to 2016)

Column

Total Private Dwellings per Province (2011 and 2016)

Percentage Change in Private Dwellings (2011 to 2016)

---
title: "Canadian Census 2016"
output: 
  flexdashboard::flex_dashboard:
    navbar:
      - { title: "Blog", href: "http://cluoma.com/", align: left }
    orientation: columns
    vertical_layout: fill
    social: menu
    source_code: embed
    favicon: favicon.png
---

```{r setup, include=FALSE}
# Graph Canadian 2016 census population and private dwelling summary statistics
#
# by Colin Luoma (http://cluoma.com/)


library(flexdashboard)
library(dplyr)
library(reshape2)
library(ggplot2)
library(highcharter)
library(readr)
library(rgdal)
library(crosstalk)
library(leaflet)
library(rmapshaper)

# Load geographic population statistics by census division
# http://www12.statcan.gc.ca/census-recensement/2016/dp-pd/hlt-fst/pd-pl/comprehensive.cfm
geo_population <- read_csv("geo_divisions.CSV", locale = locale(encoding = "ISO-8859-3"))

# Load map data
# Census devision boundry file
# http://www12.statcan.gc.ca/census-recensement/2011/geo/bound-limit/bound-limit-2016-eng.cfm
map_data <- readOGR(
  dsn = "lcd_000b16g_e.gml",
  layer = "lcd_000b16g_e",
  encoding =  "UTF-8"
)

# Transform map data into proper lat-lon coords
map_data <- spTransform(map_data, CRS("+init=epsg:4326"))

# Merge stats and map data
map_data <- map_data %>%
  merge(geo_population, by.x=c("CDUID"), by.y=c("Geographic code"))
names(map_data) <- gsub("[.]","",make.names(names(map_data), unique=TRUE))

# Dataframe for province summary stuff
prov_summary <- map_data %>%
  data.frame() %>%
  group_by(Provinceterritoryenglish) %>%
  summarize(total_pop_2011 = sum(Population2011),
            total_pop_2016 = sum(Population2016),
            total_dwellings_2011 = sum(Totalprivatedwellings2011),
            total_dwellings_2016 = sum(Totalprivatedwellings2016))

# Simplify shape polygons, to reduce size of html
map_data <- rmapshaper::ms_simplify(map_data, keep = 0.01)
```

Population
=====================================

Column {data-width=550}
-------------------------------------
    
### Population Change by Census Division (2011 to 2016)
    
```{r}
pal <- colorNumeric(
  palette = colorRamp(c("#b2182b","#f7f7f7","#0571b0"), bias = 2, interpolate = "linear"),
  domain = c(-7, max(map_data$Populationchange))
)
labels <- sprintf(
  "%s
2011: %s
2016: %s
%g%% change ", map_data$Geographicnameenglish, map_data$Population2011, map_data$Population2016, map_data$Populationchange ) %>% lapply(htmltools::HTML) leaflet(map_data) %>% addTiles() %>% addPolygons( weight = 1, color = ~pal(Populationchange), fillOpacity = 0.8, highlightOptions = highlightOptions( color = "black", weight = 2, bringToFront = TRUE ), label = labels, labelOptions = labelOptions( style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto" ) ) %>% addLegend(title = "% Change", pal = pal, values = ~Populationchange, opacity = 0.8) ``` Column {data-width=450} ------------------------------------- ### Absolute Population per Province (2011 and 2016) ```{r} ll <- prov_summary %>% select(Provinceterritoryenglish, `2011`=total_pop_2011, `2016`=total_pop_2016) %>% melt(id.vars = "Provinceterritoryenglish") %>% ungroup() %>% arrange(desc(value)) %>% mutate(Provinceterritoryenglish = factor(Provinceterritoryenglish, level = unique(Provinceterritoryenglish), ordered = TRUE)) hchart(ll, "column", hcaes(x = Provinceterritoryenglish, y = value, group = variable), minPointLength = 3) %>% hc_yAxis(title = list(text = paste0("Population"))) %>% hc_xAxis(title = NA) %>% hc_add_theme(hc_theme_economist()) ``` ### Percentage Change in Population (2011 to 2016) ```{r} ll <- prov_summary %>% select(Provinceterritoryenglish, total_pop_2011, total_pop_2016) %>% mutate(Change = total_pop_2016/total_pop_2011 - 1) %>% arrange(desc(Change)) %>% mutate(color = ifelse(Change > 0, "#0571b0", "#b2182b"), y = round(Change*100, digits = 2)) %>% mutate(Provinceterritoryenglish = factor(Provinceterritoryenglish, level = unique(Provinceterritoryenglish), ordered = TRUE)) highchart() %>% hc_title(text = NA, style = list(fontSize = "15px")) %>% hc_chart(type = "column") %>% hc_xAxis(categories = ll$Provinceterritoryenglish) %>% hc_yAxis(title = list(text = paste0("Percentage Change in Population"))) %>% hc_add_series(ll, name = "Population Change", showInLegend = FALSE) %>% hc_tooltip(valueSuffix = "%") %>% hc_add_theme(hc_theme_economist()) ``` Dwellings ===================================== Column {data-width=550} ------------------------------------- ### Change in Private Dwellings by Census Devision (2011 to 2016) ```{r} pal <- colorNumeric( palette = colorRamp(c("#b2182b","#f7f7f7","#0571b0"), bias = 2, interpolate = "linear"), domain = c(-7.5, max(map_data$Totalprivatedwellingschange)) ) labels <- sprintf( "%s
2011: %s
2016: %s
%g%% change ", map_data$Geographicnameenglish, map_data$Totalprivatedwellings2011, map_data$Totalprivatedwellings2016, map_data$Totalprivatedwellingschange ) %>% lapply(htmltools::HTML) leaflet(map_data) %>% addTiles() %>% addPolygons( weight = 1, color = ~pal(Totalprivatedwellingschange), fillOpacity = 0.8, highlightOptions = highlightOptions( color = "black", weight = 2, bringToFront = TRUE ), label = labels, labelOptions = labelOptions( style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto" ) ) %>% addLegend(title = "% Change", pal = pal, values = ~Totalprivatedwellingschange, opacity = 0.8) ``` Column {data-width=450} ------------------------------------- ### Total Private Dwellings per Province (2011 and 2016) ```{r} ll <- prov_summary %>% select(Provinceterritoryenglish, `2011`=total_dwellings_2011, `2016`=total_dwellings_2016) %>% melt(id.vars = "Provinceterritoryenglish") %>% ungroup() %>% arrange(desc(value)) %>% mutate(Provinceterritoryenglish = factor(Provinceterritoryenglish, level = unique(Provinceterritoryenglish), ordered = TRUE)) hchart(ll, "column", hcaes(x = Provinceterritoryenglish, y = value, group = variable), minPointLength = 3) %>% hc_yAxis(title = list(text = paste0("Total Private Dwellings"))) %>% hc_xAxis(title = NA) %>% hc_add_theme(hc_theme_economist()) ``` ### Percentage Change in Private Dwellings (2011 to 2016) ```{r} ll <- prov_summary %>% select(Provinceterritoryenglish, total_dwellings_2011, total_dwellings_2016) %>% mutate(Change = total_dwellings_2016/total_dwellings_2011 - 1) %>% arrange(desc(Change)) %>% mutate(color = ifelse(Change > 0, "#0571b0", "#b2182b"), y = round(Change*100, digits = 2)) %>% mutate(Provinceterritoryenglish = factor(Provinceterritoryenglish, level = unique(Provinceterritoryenglish), ordered = TRUE)) highchart() %>% hc_title(text = NA, style = list(fontSize = "15px")) %>% hc_chart(type = "column") %>% hc_xAxis(categories = ll$Provinceterritoryenglish) %>% hc_yAxis(title = list(text = paste0("Percentage Change in Private Dwellings"))) %>% hc_add_series(ll, name = "Population Change", showInLegend = FALSE) %>% hc_tooltip(valueSuffix = "%") %>% hc_add_theme(hc_theme_economist()) ```