Canberra School Aged Estimate Residential Population (5-14) by SA2

The below graphs show the estimated change in school aged population from 2001 to 2024 in the ACT. In 2001 there were a lot of young families in south Canberra. By 2024 the proportion of children in the south of Canberra had declined significantly. Instead, many more families have moved to the newer Canberra suburbs such as greater Gungahlin and the Coombs/Wright area. Following a small reduction in the school aged population in 2008, there has been a significant increase of school aged children since.

Population Map

2001

2024

Change Analysis

Absolute Change (2001-2024)

Population Trend (2001-2024)

--- title: "Canberra School Aged Estimate Residential Population (5-14) by SA2" execute: echo: false message: false warning: false --- ```{r} #| echo: false #| message: false #| warning: false # Load libraries and data library(sf) library(leaflet) library(dplyr) library(crosstalk) library(htmltools) library(plotly) erp <- st_read(paste0(here::here(), "/data/erp_sa2.gpkg"), quiet = T) # Aggregate 5-9 and 10-14 age groups to create 5-14 school age population erp <- erp |> filter(age %in% c("5-9", "10-14")) |> group_by(sa2_code, sa2_name, year, geom) |> summarise(erp = sum(erp, na.rm = TRUE), .groups = "drop") |> st_as_sf() # Rename erp column to value for consistency with mapping code erp <- erp |> mutate(value = erp, metric = "Population 5-14") ``` The below graphs show the estimated change in school aged population from 2001 to 2024 in the ACT. In 2001 there were a lot of young families in south Canberra. By 2024 the proportion of children in the south of Canberra had declined significantly. Instead, many more families have moved to the newer Canberra suburbs such as greater Gungahlin and the Coombs/Wright area. Following a small reduction in the school aged population in 2008, there has been a significant increase of school aged children since. ## Population Map ::: {.columns} ::: {.column width="50%"} ### 2001 ```{r} # Generated by Claude 3.5 Sonnet # Simple approach - create individual leaflet maps for key years #| echo: false create_leaflet_map <- function(year_selected) { data_yr <- erp |> filter(year == year_selected) # Calculate color palette for this year pal <- colorNumeric("viridis", data_yr$value, na.color = "#cccccc") leaflet(data_yr) |> addProviderTiles(providers$CartoDB.Positron) |> addPolygons( fillColor = ~pal(value), fillOpacity = 0.7, color = "#444444", weight = 1, label = ~paste0(sa2_name, ": ", value, " (", year, ")"), labelOptions = labelOptions(sticky = TRUE) ) |> addLegend( pal = pal, values = ~value, title = paste("5-14 ERP ", year_selected, "") ) |> setView(lng = 149.12, lat = -35.30, zoom = 10) } create_leaflet_map(2001) ``` ::: ::: {.column width="50%"} ### 2024 ```{r} #| echo: false create_leaflet_map(2024) ``` ::: ::: # Change Analysis ### Absolute Change (2001-2024) ```{r} #| echo: false create_change_map <- function() { # Get 2001 and 2024 data data_2001 <- erp |> filter(year == 2001) |> select(sa2_code, value_2001 = value) data_2024 <- erp |> filter(year == 2024) |> select(sa2_code, value_2024 = value, sa2_name, geom) # Calculate absolute change change_data <- data_2024 |> left_join(st_drop_geometry(data_2001), by = "sa2_code") |> mutate( change = value_2024 - value_2001, change_label = ifelse(change >= 0, paste0("+", change), as.character(change)), fill_opacity = ifelse(value_2001 == 0 & value_2024 == 0, 0.3, 1.0) ) |> filter(!is.na(change)) # Create diverging palette max_abs_change <- max(abs(change_data$change), na.rm = TRUE) pal <- colorNumeric( palette = c("#B2182B", "#D6604D", "#F4A582", "#FDDBC7", "#D1E5F0", "#92C5DE", "#4393C3", "#2166AC"), domain = c(-max_abs_change, max_abs_change), na.color = "#cccccc" ) leaflet(change_data) |> addProviderTiles(providers$CartoDB.Positron) |> addPolygons( fillColor = ~pal(change), fillOpacity = ~fill_opacity, color = "#444444", weight = 1, label = ~paste0( sa2_name, "\n", "2001: ", value_2001, "\n", "2024: ", value_2024, "\n", "Change: ", change_label ), labelOptions = labelOptions(sticky = TRUE) ) |> addLegend( position = "bottomright", pal = pal, values = ~change, title = "5-14 ERP Change\n2001-2024" ) |> setView(lng = 149.12, lat = -35.30, zoom = 10) } create_change_map() ``` ### Population Trend (2001-2024) ```{r} #| echo: false library(ggplot2) library(plotly) create_population_trend <- function() { # Calculate total ACT population by year for 5-14 age group act_totals <- erp |> st_drop_geometry() |> group_by(year) |> summarise(total_population = sum(value, na.rm = TRUE), .groups = "drop") # Create ggplot p <- ggplot(act_totals, aes(x = year, y = total_population)) + geom_line(color = "#2166AC", linewidth = 1.2) + geom_point(color = "#2166AC", size = 3) + scale_x_continuous(breaks = seq(2001, 2024, 3)) + scale_y_continuous(labels = scales::comma_format(), limits = c(0, NA) ) + labs( title = "ACT School-Age Population Trend", subtitle = "Total population aged 5-14 years", x = "Year", y = "Population (5-14 years)" ) + theme_minimal() + theme( plot.title = element_text(size = 14, face = "bold"), plot.subtitle = element_text(size = 12), axis.text.x = element_text(angle = 45, hjust = 1), panel.grid.minor = element_blank() ) # Convert to plotly with custom hover info ggplotly(p, tooltip = "none") |> add_trace( data = act_totals, x = ~year, y = ~total_population, type = "scatter", mode = "lines+markers", line = list(color = "#2166AC", width = 3), marker = list(color = "#2166AC", size = 8), hovertemplate = paste( "Year: %{x} ", "Population: %{y:,} ", "<extra></extra>" ), showlegend = FALSE ) |> layout( title = list( text = "ACT School-Age Population Trend Total population aged 5-14 years", font = list(size = 14) ), xaxis = list(title = "Year"), yaxis = list(title = "Population (5-14 years)", tickformat = ","), hovermode = "x unified" ) } create_population_trend() ```