---
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())
```