rescale counts in age groups to match counts in different age groups

This method rescales a vector of counts in arbitrary (integer) age groups to approximate a vector of counts in a potentially different age grouping. Common use cases will be to scale single ages (whose age pattern we wish to roughly maintain) to sum to abridged or 5-year age groups from another source. The counts to be rescaled could potentially be in any grouping (see example).

rescaleAgeGroups(
  Value1,
  AgeInt1,
  Value2,
  AgeInt2,
  splitfun = graduate_uniform,
  recursive = FALSE,
  tol = 0.001
)

Arguments

Value1	numeric vector. A vector of demographic counts for population 1.
AgeInt1	integer vector. Age interval widths for population 1.
Value2	numeric vector. A vector of demographic counts for population 2.
AgeInt2	integer vector. Age interval widths for population 2.
splitfun	function to use for splitting Value1. Reasonable (and tested) choices are either graduate_uniform or graduate_mono.
recursive	logical. Shall we repeat the split/regroup/rescale process until stable? See details. Default FALSE.
tol	numeric. Default 1e-3. The numerical tolerance for the residual. Used to detect stability if recursive = TRUE.

Details

If the final age group is open, define its age interval as 1.

Presently the intermediate splitting function can either be graduate_uniform() or graduate_mono().

The method is an original contribution. It works by first splitting the counts of Value1 to single ages using the assumptions of splitfun(). Value1 is then rescaled such that were it re-grouped to match the age classes of Value2 they would be identical. If recursive = FALSE, the single-age rescaled Value1 data are returned regrouped to their original ages. If recursive = TRUE, the process is repeated until Value1 is rescaled such that it could be split and regrouped to Value2 using the same process a single time with no need for further rescaling. If age groups in Value1 are very irregular, recursive = TRUE can induce noise (see example). If the age groups of Value1 nest cleanly within the age groups of Value2 then recursion is unnecessary. This is the case, for example, whenever Value1 is in single ages and Value2 is in grouped ages, which is likely the most common usage scenario.

Examples

# just to make a point about arbitrary integer age widths in both pop1 and pop2
# note if pop1 is in single ages and pop2 is in groups things work much cleaner.
set.seed(3)
#set.seed(3)
#AgeIntRandom <- sample(1:5, size = 15,replace = TRUE)
AgeIntRandom <- c(1L, 5L, 2L, 2L, 4L, 4L, 1L, 2L, 3L, 4L, 3L, 3L, 3L, 3L, 5L)
AgeInt5      <- rep(5, 9)
original     <- runif(45, min = 0, max = 100)
pop1         <- groupAges(original, 0:45, AgeN = int2ageN(AgeIntRandom, FALSE))
pop2         <- groupAges(original, 0:45, AgeN = int2ageN(AgeInt5, FALSE))
# inflate (in this case) pop2
perturb      <- runif(length(pop2), min = 1.05, max = 1.2)

pop2         <- pop2 * perturb

# a recursively constrained solution
(pop1resc <- rescaleAgeGroups(Value1 = pop1,
          AgeInt1 = AgeIntRandom,
          Value2 = pop2,
          AgeInt2 = AgeInt5,
          splitfun = graduate_uniform,
                 recursive = TRUE))
#>          0          1          6          8         10         14         18 
#>  17.741783 289.921985  45.842444 132.156825 248.211782 275.656666  95.951513 
#>         19         21         24         28         31         34         37 
#>  13.832498   1.456921 295.438424 255.996179  39.989714 154.558517 158.631882 
#>         40 
#> 267.469173 
# a single pass adjustment (no recursion)
(pop1resc1 <- rescaleAgeGroups(Value1 = pop1,
          AgeInt1 = AgeIntRandom,
          Value2 = pop2,
          AgeInt2 = AgeInt5,
          splitfun = graduate_uniform,
          recursive = FALSE))
#>         0         1         6         8        10        14        18        19 
#>  17.85845 291.03915  45.52468 131.24076 244.32688 264.98546  91.52467  44.44425 
#>        21        24        28        31        34        37        40 
#>  17.35667 292.44121 194.72123  85.71307 173.42440 130.78627 267.46917 
pop1resc / pop1
#>          0          1          6          8         10         14         18 
#> 1.05579752 1.06327532 1.09348011 1.09348011 1.17729396 1.09702495 1.06911161 
#>         19         21         24         28         31         34         37 
#> 0.27232841 0.06129412 1.16410049 1.51003360 0.40114915 1.04131493 1.60434464 
#>         40 
#> 1.19898329 
perturb
#> [1] 1.090143 1.057171 1.065524 1.097105 1.170096 1.084399 1.081950 1.181565
#> [9] 1.198983

if (FALSE) {

# show before / after
  plot(NULL,xlim=c(0,45),ylim=c(0,2),main = "Different (but integer) intervals",
      xlab = "Age", ylab = "", axes = FALSE)
  x1 <- c(0,cumsum(AgeIntRandom))
  rect(x1[-length(x1)],1,x1[-1],2,col = gray(.8), border = "white")
  x2 <- c(0,cumsum(AgeInt5))
  rect(x2[-length(x2)],0,x2[-1],1,col = "palegreen1", border = "white")
  text(23,1.5,"Original (arbitrary grouping)",font = 2, cex=1.5)
  text(23,.5,"Standard to rescale to (arbitrary grouping)",font = 2, cex=1.5)
  axis(1)

# adjustment factors:
  plot(int2age(AgeInt5), perturb, ylim = c(0, 2))
  points(int2age(AgeIntRandom), pop1resc / pop1, pch = 16)
# non-recursive is less disruptive for uniform
  points(int2age(AgeIntRandom), pop1resc1 / pop1, pch = 16, col = "blue")

# show before / after under uniform (in pop1) assumption.
  plot(NULL, xlim = c(0, 45), ylim = c(0, 150), main = "Uniform constraint")
  lines(0:44, graduate_uniform(pop1, AgeInt = AgeIntRandom, OAG = FALSE), col = "red")
  lines(0:44, graduate_uniform(pop2, AgeInt = AgeInt5, OAG = FALSE), col = "blue")
  lines(0:44, graduate_uniform(pop1resc, AgeInt = AgeIntRandom, OAG = FALSE),
col = "orange", lty = 2, lwd = 2)
  lines(0:44, graduate_uniform(pop1resc1, AgeInt = AgeIntRandom, OAG = FALSE),
col = "magenta", lty = 2, lwd = 2)
  legend("topright",
        lty = c(1, 1, 2, 2),
        col = c("red", "blue", "orange", "magenta"),
        lwd = c(1, 1, 2, 2),
       legend = c("Original N1", "Prior N2",
                    "Rescaled N1 recursive", "Rescaled N1 1 pass"))

}