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