internal_data <- get_cansim("17-10-0045") %>%
mutate(Date=Date %m+% months(1) %m+% days(14))
pd <- internal_data$`Geography, province of destination` %>% levels
po <- internal_data$GEO %>% unique %>% gsub(", province of origin","",.)
provinces <- c("Alberta","British Columbia","Ontario","Saskatchewan","Manitoba","Quebec","Other provinces")
external_data <- get_cansim("17-10-0040") %>%
mutate(Date=Date %m+% months(1) %m+% days(14)) #%>%
#filter(GEO==prov) %>%
#mutate(value=case_when(`Components of population growth`=="Emigrants" ~ -val_norm, TRUE ~ val_norm))
natural_data <- get_cansim("17-10-0059") %>%
mutate(Date=Date %m+% months(1) %m+% days(14)) |>
filter(Estimates %in% c("Births","Deaths"))
internal_migration_data_for <- function(internal_data,
province,
province_count=5,
level_date=as.Date("2010-01-01")){
internal <- internal_data %>%
mutate(Origin=factor(gsub(", province of origin","",GEO),levels=po)) %>%
mutate(Destination=fct_recode(`Geography, province of destination`,
!!!setNames(pd,po))) %>%
filter(Origin==province|Destination==province) %>%
mutate(Name=case_when(Origin==province ~ Destination, TRUE ~ Origin))
province_levels <- internal %>%
filter(Date>=level_date) %>%
group_by(Name) %>%
summarise(Value=sum(val_norm),.groups="drop") %>%
slice_max(order_by = Value,n=province_count,with_ties = FALSE) %>%
arrange(-Value) %>%
pull(Name) %>%
as.character() %>%
c("Other provinces")
internal %>%
mutate(Name=case_when(Name %in% province_levels ~ as.character(Name),
TRUE ~ "Other provinces")) %>%
mutate(Name=factor(Name,levels=province_levels)) %>%
mutate(Migration=ifelse(Origin==province,"Out-migration","In-migration")) %>%
mutate(value=ifelse(Migration=="Out-migration",-val_norm,val_norm)) %>%
group_by(Date,Name,Migration) %>%
summarise(value=sum(value),.groups="drop") %>%
bind_rows(group_by(.,Date) %>% summarize(value=sum(value)) %>% mutate(Migration="Net migration")) %>%
mutate(Province=province)
}
migration_graph <- function(internal,
migration_colours=setNames(RColorBrewer::brewer.pal(8,"Dark2"),
c("Ontario", "Quebec", "British Columbia", "Saskatchewan", "Manitoba",
"Alberta", "Nova Scotia", "Other provinces"))){
missing_colours <- setdiff(internal$Name %>% levels,names(migration_colours))
if (length(missing_colours)>0) {
migration_colours <- c(migration_colours,
setNames(MetBrewer::met.brewer("Juarez",length(missing_colours)),missing_colours))
}
migration_colours <- migration_colours[levels(internal$Name)]
ggplot(internal,aes(x=Date,y=value,fill=fct_rev(Name))) +
geom_bar(stat="identity",data=~filter(.,Migration!="Net migration")) +
geom_hline(yintercept = 0) +
geom_line(data=~filter(.,Migration=="Net migration") ,
aes(x=Date,y=value,colour=Province),inherit.aes = FALSE) +
scale_y_continuous(labels=scales::comma) +
scale_colour_manual(values="brown",labels="Net Migration") +
scale_x_date(breaks="2 year",date_labels = "%Y") +
scale_fill_manual(values=migration_colours) +
labs(title=paste0("Gross interprovincial migration flows for ",unique(internal$Province)),
fill=NULL,x=NULL,y="Quarterly gross migration flows",colour=NULL,
caption="MountainMath, Data: StatCan table 17-10-0045")
}
all_migration_data_for <- function(internal_data,external_data,
province,
province_count=5,
level_date=as.Date("2010-01-01")){
internal <- internal_data %>%
mutate(Origin=factor(gsub(", province of origin","",GEO),levels=po)) %>%
mutate(Destination=fct_recode(`Geography, province of destination`,
!!!setNames(pd,po))) %>%
filter(Origin==province|Destination==province) %>%
mutate(Name=case_when(Origin==province ~ Destination, TRUE ~ Origin))
province_levels <- internal %>%
filter(Date>=level_date) %>%
group_by(Name) %>%
summarise(Value=sum(val_norm),.groups="drop") %>%
slice_max(order_by = Value,n=province_count,with_ties = FALSE) %>%
arrange(-Value) %>%
pull(Name) %>%
as.character() %>%
c("Other provinces")
external <- external_data |>
filter(GEO==province) |>
filter(!(`Components of population growth` %in% c("Non-permanent residents, inflows", "Non-permanent residents, outflows","Net emigration"))) |>
mutate(Name=`Components of population growth`,
Origin="External") |>
select(Date,Name,Origin,val_norm) |>
filter(!is.na(val_norm))
internal %>%
mutate(Name=case_when(Name %in% province_levels ~ as.character(Name),
TRUE ~ "Other provinces")) %>%
mutate(Name=factor(Name,levels=province_levels)) %>%
bind_rows(external) |>
filter(Date>=pmax(min(internal$Date),min(external$Date))) |>
mutate(Migration=ifelse(Origin==province | Name=="Emigrants","Out-migration","In-migration")) %>%
mutate(value=ifelse(Migration=="Out-migration",-val_norm,val_norm)) %>%
group_by(Date,Name,Migration) %>%
summarise(value=sum(value),.groups="drop") %>%
bind_rows(group_by(.,Date) %>% summarize(value=sum(value)) %>% mutate(Migration="Net migration")) %>%
mutate(Province=province)
}
all_migration_graph <- function(migration,
internal_colours=setNames(RColorBrewer::brewer.pal(8,"Dark2"),
c("Ontario", "Quebec", "British Columbia", "Saskatchewan", "Manitoba",
"Alberta", "Nova Scotia", "Other provinces")),
external_colours = setNames(RColorBrewer::brewer.pal(5,"Pastel1"),
c("Immigrants", "Emigrants", "Returning emigrants",
"Net temporary emigrants", "Net non-permanent residents"))) {
missing_colours <- setdiff(migration$Name %>% levels,names(c(internal_colours,external_colours)))
if (length(missing_colours)>0) {
internal_colours <- c(internal_colours,
setNames(MetBrewer::met.brewer("Juarez",length(missing_colours)),missing_colours))
}
internal_colours <- internal_colours[setdiff(levels(migration$Name),names(external_colours))]
ggplot(migration,aes(x=Date,y=value,fill=fct_rev(Name))) +
geom_bar(stat="identity",data=~filter(.,Migration!="Net migration")) +
geom_hline(yintercept = 0) +
geom_line(data=~filter(.,Migration=="Net migration") ,
aes(x=Date,y=value,colour=Province),inherit.aes = FALSE) +
scale_y_continuous(labels=scales::comma) +
scale_x_date(breaks="2 year",date_labels = "%Y") +
scale_colour_manual(values="brown",labels="Net Migration") +
scale_fill_manual(values=c(internal_colours,external_colours)) +
labs(title=paste0("Gross migration flows for ",unique(migration$Province)),
fill=NULL,x=NULL,y="Quarterly gross migration flows",colour=NULL,
caption="MountainMath, Data: StatCan table 17-10-0045 17-10-0040")
}
bc_annual_flows <- internal_migration_data_for(internal_data,"British Columbia") |>
filter(Date>=as.Date("2001-01-01")) |>
mutate(Year=as.numeric(format(Date,"%Y"))) |>
summarize(value=sum(value),.by=c(Year,Migration))
bc_2023_flows <- bc_annual_flows |> filter(Year==2023)
bc_annual_external_flows_detail <- external_data |>
filter(GeoUID=="59") |>
mutate(Year=as.integer(strftime(Date,"%Y"))) |>
filter(Year>=2022) |>
rename(Components=`Components of population growth`) |>
filter(Components%in% c("Immigrants","Emigrants","Returning emigrants",
"Net temporary emigration","Non-permanent residents, inflows",
"Non-permanent residents, outflows")) |>
mutate(value=ifelse(Components %in% c("Emigrants","Non-permanent residents, outflows"),
-val_norm,val_norm)) |>
summarize(value=sum(value,na.rm=TRUE),.by=c(Year,Components))
bc_annual_external_flows <- bc_annual_external_flows_detail |>
mutate(Migration=case_when(Components %in% c("Emigrants","Non-permanent residents, outflows") ~ "Out-migration",
TRUE ~ "In-migration")) |>
summarize(value=sum(value,na.rm=TRUE),.by=c(Year,Migration)) %>%
bind_rows(summarize(.,value=sum(value),.by=Year) |> mutate(Migration="Net migration"))
bc_2023_external_flows <- bc_annual_external_flows |> filter(Year==2023)
bc_annual_all_flows <- all_migration_data_for(internal_data,external_data,"British Columbia") |>
filter(Date>=as.Date("2001-01-01")) |>
mutate(Year=as.numeric(format(Date,"%Y"))) |>
summarize(value=sum(value),.by=c(Year,Migration))
bc_2023_all_flows <- bc_annual_all_flows |> filter(Year==2023)
bc_2023_all_flows_detail <- bc_annual_external_flows_detail |> filter(Year==2023)