thoughtfulbloke · March 11, 2024 08:07
diff --git a/KnKplus.R b/KnKplus.R
 library(dplyr)
 library(tidyr)
 library(lubridate)
 NZstmf <- read.csv("NZL_NPstmfout.csv") |> 
  filter(Sex == "b")
 NZQTR <- read.csv("TotalQuarterlyPopulationAsAt.csv", skip=3,
                  col.names = c("YRQR","Pop")) |> 
  filter(!is.na(Pop)) |> 
  separate(YRQR, into=c("YR", "QR"), sep="Q", convert = TRUE) |> 
  mutate(asDate = ceiling_date(ISOdate(YR,QR*3,25), 
                               unit="quarter") - days(1),
         Week=isoweek(asDate),
         Year=isoyear(asDate)) |> 
  select(Year,Week,Pop)
 ## bluntly apply the quarter as a block rather than
 ## imputing each week, but it should be in the right ballpark

 joint <- NZstmf |> left_join(NZQTR, by = join_by(Year, Week)) |> 
  fill(Pop) |> mutate(CDR1K = 1000*Total/Pop,
                      logPop = log(Pop))

 KnKexpect <- function(x, weekly_data=joint){
  targetRow <- weekly_data[x,]
  sexis <- targetRow$Sex
  weekno <- targetRow$Week
  if (weekno == 53){weekno <- 52}
  regresset <- weekly_data[weekly_data$Year %in% 2015:2019 & 
                             weekly_data$Week==weekno &
                             weekly_data$Sex==sexis,]
  Knkmodel <- lm(Total ~ Year, data=regresset)
  targetRow$KnKexpected <- Knkmodel$coefficients[1] +
    Knkmodel$coefficients[2] * targetRow$Year
  DRmodel <- lm(CDR1K ~ Year, data=regresset)
  targetRow$CDRexpected <- DRmodel$coefficients[1] +
    DRmodel$coefficients[2] * targetRow$Year
  Popmodel <- lm(Total ~ Year + Pop, data=regresset)
  targetRow$Popexpected <- predict(Popmodel,newdata=targetRow)
  Logmodel <- lm(Total ~ Year + logPop, data=regresset)
  targetRow$Logexpected <- predict(Logmodel,newdata=targetRow)
  return(targetRow)
 }

 w.Expected <- lapply(1:nrow(NZstmf), KnKexpect)
 df.Expected <- bind_rows(w.Expected) 

 b2020to2022 <- df.Expected |> 
  filter(Year %in% 2020:2022) |> 
  summarise(Actual = sum(Total), 
            Knk= sum(KnKexpected),
            meanCDR= mean(CDR1K),
            CDRexpected = mean(CDRexpected),
            Pop=sum(Popexpected),
            Log=sum(Logexpected))
  
diff --git a/NZL_NPstmfout.csv b/NZL_NPstmfout.csv
diff --git a/TotalQuarterlyPopulationAsAt.csv b/TotalQuarterlyPopulationAsAt.csv
 "Estimated Resident Population by Age and Sex (1991+) (Qrtly-Mar/Jun/Sep/Dec)",""
 "","As at"
 " ","Total"
 " ","Total All Ages"
 "2008Q3",4269600
 "2008Q4",4280300
 "2009Q1",4293500
 "2009Q2",4302600
 "2009Q3",4317300
 "2009Q4",4332100
 "2010Q1",4345700
 "2010Q2",4350700
 "2010Q3",4362700
 "2010Q4",4373900
 "2011Q1",4382500
 "2011Q2",4384000
 "2011Q3",4392000
 "2011Q4",4399400
 "2012Q1",4406500
 "2012Q2",4408100
 "2012Q3",4415600
 "2012Q4",4425900
 "2013Q1",4436000
 "2013Q2",4442100
 "2013Q3",4457900
 "2013Q4",4477400
 "2014Q1",4501100
 "2014Q2",4516500
 "2014Q3",4540300
 "2014Q4",4564400
 "2015Q1",4591900
 "2015Q2",4609400
 "2015Q3",4636300
 "2015Q4",4663700
 "2016Q1",4695000
 "2016Q2",4714100
 "2016Q3",4741200
 "2016Q4",4767600
 "2017Q1",4796700
 "2017Q2",4813600
 "2017Q3",4836300
 "2017Q4",4859500
 "2018Q1",4886100
 "2018Q2",4900600
 "2018Q3",4921300
 "2018Q4",4941200
 "2019Q1",4965300
 "2019Q2",4979200
 "2019Q3",5006900
 "2019Q4",5040400
 "2020Q1",5082800
 "2020Q2",5090200
 "2020Q3",5098700
 "2020Q4",5103700
 "2021Q1",5107900
 "2021Q2",5111300
 "2021Q3",5115000
 "2021Q4",5116500
 "2022Q1",5114900
 "2022Q2",5117100
 "2022Q3",5131200
 "2022Q4",5160500
 "2023Q1",5203700
 "2023Q2",5239200
 "2023Q3",5279900
 "2023Q4",5305600
 "Table information:"
 "Units:"
 "Number, Magnitude = Units"
 ""
 "Footnotes:"
 "All population estimates at 30 June 2018 and beyond use the 2018-base ERP."
 "Estimates flagged as provisional are subject to revision, mainly to incorporate revisions to external (international) migration estimates."
 "The current population estimates are based on 2018 Census data. The 2023-based estimated resident population will be published following the release of 2023 Census and 2023 Post-enumeration Survey results."
 " "
 "Symbols:"
 ".. figure not available"
 "C: Confidential"
 "E: Early Estimate"
 "P: Provisional"
 "R: Revised"
 "S: Suppressed"
 ""
 "Status flags are not displayed"
 ""
 "Table reference: "
 "DPE054AA"
 ""
 "Last updated:"
 "Total All Ages: 16 February 2024 10:45am"
 ""
 "Source: Statistics New Zealand"
 "Contact: Information Centre"
 "Telephone: 0508 525 525"
 "Email:[email protected]"
 ""
 ""
 ""
	library(dplyr)
	library(tidyr)
	library(lubridate)
	NZstmf <- read.csv("NZL_NPstmfout.csv") \|>
	filter(Sex == "b")
	NZQTR <- read.csv("TotalQuarterlyPopulationAsAt.csv", skip=3,
	col.names = c("YRQR","Pop")) \|>
	filter(!is.na(Pop)) \|>
	separate(YRQR, into=c("YR", "QR"), sep="Q", convert = TRUE) \|>
	mutate(asDate = ceiling_date(ISOdate(YR,QR*3,25),
	unit="quarter") - days(1),
	Week=isoweek(asDate),
	Year=isoyear(asDate)) \|>
	select(Year,Week,Pop)
	## bluntly apply the quarter as a block rather than
	## imputing each week, but it should be in the right ballpark

	joint <- NZstmf \|> left_join(NZQTR, by = join_by(Year, Week)) \|>
	fill(Pop) \|> mutate(CDR1K = 1000*Total/Pop,
	logPop = log(Pop))

	KnKexpect <- function(x, weekly_data=joint){
	targetRow <- weekly_data[x,]
	sexis <- targetRow$Sex
	weekno <- targetRow$Week
	if (weekno == 53){weekno <- 52}
	regresset <- weekly_data[weekly_data$Year %in% 2015:2019 &
	weekly_data$Week==weekno &
	weekly_data$Sex==sexis,]
	Knkmodel <- lm(Total ~ Year, data=regresset)
	targetRow$KnKexpected <- Knkmodel$coefficients[1] +
	Knkmodel$coefficients[2] * targetRow$Year
	DRmodel <- lm(CDR1K ~ Year, data=regresset)
	targetRow$CDRexpected <- DRmodel$coefficients[1] +
	DRmodel$coefficients[2] * targetRow$Year
	Popmodel <- lm(Total ~ Year + Pop, data=regresset)
	targetRow$Popexpected <- predict(Popmodel,newdata=targetRow)
	Logmodel <- lm(Total ~ Year + logPop, data=regresset)
	targetRow$Logexpected <- predict(Logmodel,newdata=targetRow)
	return(targetRow)
	}

	w.Expected <- lapply(1:nrow(NZstmf), KnKexpect)
	df.Expected <- bind_rows(w.Expected)

	b2020to2022 <- df.Expected \|>
	filter(Year %in% 2020:2022) \|>
	summarise(Actual = sum(Total),
	Knk= sum(KnKexpected),
	meanCDR= mean(CDR1K),
	CDRexpected = mean(CDRexpected),
	Pop=sum(Popexpected),
	Log=sum(Logexpected))
	"Estimated Resident Population by Age and Sex (1991+) (Qrtly-Mar/Jun/Sep/Dec)",""
	"","As at"
	" ","Total"
	" ","Total All Ages"
	"2008Q3",4269600
	"2008Q4",4280300
	"2009Q1",4293500
	"2009Q2",4302600
	"2009Q3",4317300
	"2009Q4",4332100
	"2010Q1",4345700
	"2010Q2",4350700
	"2010Q3",4362700
	"2010Q4",4373900
	"2011Q1",4382500
	"2011Q2",4384000
	"2011Q3",4392000
	"2011Q4",4399400
	"2012Q1",4406500
	"2012Q2",4408100
	"2012Q3",4415600
	"2012Q4",4425900
	"2013Q1",4436000
	"2013Q2",4442100
	"2013Q3",4457900
	"2013Q4",4477400
	"2014Q1",4501100
	"2014Q2",4516500
	"2014Q3",4540300
	"2014Q4",4564400
	"2015Q1",4591900
	"2015Q2",4609400
	"2015Q3",4636300
	"2015Q4",4663700
	"2016Q1",4695000
	"2016Q2",4714100
	"2016Q3",4741200
	"2016Q4",4767600
	"2017Q1",4796700
	"2017Q2",4813600
	"2017Q3",4836300
	"2017Q4",4859500
	"2018Q1",4886100
	"2018Q2",4900600
	"2018Q3",4921300
	"2018Q4",4941200
	"2019Q1",4965300
	"2019Q2",4979200
	"2019Q3",5006900
	"2019Q4",5040400
	"2020Q1",5082800
	"2020Q2",5090200
	"2020Q3",5098700
	"2020Q4",5103700
	"2021Q1",5107900
	"2021Q2",5111300
	"2021Q3",5115000
	"2021Q4",5116500
	"2022Q1",5114900
	"2022Q2",5117100
	"2022Q3",5131200
	"2022Q4",5160500
	"2023Q1",5203700
	"2023Q2",5239200
	"2023Q3",5279900
	"2023Q4",5305600
	"Table information:"
	"Units:"
	"Number, Magnitude = Units"
	""
	"Footnotes:"
	"All population estimates at 30 June 2018 and beyond use the 2018-base ERP."
	"Estimates flagged as provisional are subject to revision, mainly to incorporate revisions to external (international) migration estimates."
	"The current population estimates are based on 2018 Census data. The 2023-based estimated resident population will be published following the release of 2023 Census and 2023 Post-enumeration Survey results."
	" "
	"Symbols:"
	".. figure not available"
	"C: Confidential"
	"E: Early Estimate"
	"P: Provisional"
	"R: Revised"
	"S: Suppressed"
	""
	"Status flags are not displayed"
	""
	"Table reference: "
	"DPE054AA"
	""
	"Last updated:"
	"Total All Ages: 16 February 2024 10:45am"
	""
	"Source: Statistics New Zealand"
	"Contact: Information Centre"
	"Telephone: 0508 525 525"
	"Email:[email protected]"
	""
	""
	""