`R/utilsAge.R`

`rescaleAgeGroups.Rd`

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 )

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 |

recursive | logical. Shall we repeat the split/regroup/rescale process until stable? See details. Default |

tol | numeric. Default |

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.

# 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.46917pop1resc / 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.19898329perturb#> [1] 1.090143 1.057171 1.065524 1.097105 1.170096 1.084399 1.081950 1.181565 #> [9] 1.198983if (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")) }