---
title: "Canberra SA2 — School Aged Estimate Residential Population (5-14) Changes"
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 demonstrate the estimated change in school aged population from 2001 to 2024. The few key things worth noting are that in 2001 there were a lot of young familes in south Canberra. In 2004, there are still a large number however, there has been a considerable decline. Instead, many more families have moved to the newer Canberra suburbs such as greater Gungahlin and Coombs/Wright area. Finally, overall there has been an increase of school aged children since 2001.
## 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 <br>", 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()) +
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(
"<b>Year:</b> %{x}<br>",
"<b>Population:</b> %{y:,}<br>",
"<extra></extra>"
),
showlegend = FALSE
) |>
layout(
title = list(
text = "ACT School-Age Population Trend<br><sub>Total population aged 5-14 years</sub>",
font = list(size = 14)
),
xaxis = list(title = "Year"),
yaxis = list(title = "Population (5-14 years)", tickformat = ","),
hovermode = "x unified"
)
}
create_population_trend()
```