R/graduate.R
graduate_mono_closeout.RdA simple monotonic spline on the cumulative sum of population counts may return more convincing single age count estimates than the Sprague or other splitting methods. This function blends the given single age population estimates starting at pivotAge.
graduate_mono_closeout( Value, Age, pops, pivotAge = 90, splitfun = graduate_sprague, OAG = TRUE, ... )
| Value | numeric vector, presumably counts in grouped ages |
|---|---|
| Age | integer vector, lower bounds of age groups |
| pops | optional numeric vector of single age population counts derived from |
| pivotAge | integer (default 90). Age at which to switch to spline-based estimates. |
| splitfun | optional. The function used to create pops. Default |
| OAG | logical (default |
| ... | arguments to be optionally passed to |
numeric matrix of age by year estimates of single-age counts.
The pivotAge must be at least 10 years below the maximum age detected from
rownames(popmat), but not lower than 75. In the exact pivotAge, we may either take the Sprague estimates or the spline estimates, depending on which is larger, then the single-age estimates for this 5-year age group are rescaled to sum to the original total in Value. Higher ages are taken from the spline-based age splits. The spline results are derive from the "hyman" method of splinefun() on the cumulative sum of the original age grouped data. One could use this function to perform the same closeout to Grabill estimates, if these are given via the pops argument. See examples. Note that the Grabill split method mixed with this closeout will not necessarily preserve the annual totals, and this function performs to rescaling. The open age group is preserved (and must be included in Value).
a5 <- as.integer(rownames(pop5_mat)) popvec <- pop5_mat[,1] closed.out <- graduate_mono_closeout(Value = popvec, Age = a5, OAG = TRUE) sum(closed.out) - sum(popvec)#> [1] 0graduate_mono_closeout(Value = popvec, pivotAge = 85, Age = a5, OAG = TRUE)#> 0 1 2 3 4 5 #> 12172.491200 11380.448000 10717.448000 10171.000000 9728.612800 9377.795200 #> 6 7 8 9 10 11 #> 9106.056000 8900.904000 8749.848000 8640.396800 8573.614400 8550.564800 #> 12 13 14 15 16 17 #> 8490.980800 8355.260800 8171.579200 8008.380800 7852.779200 7694.259200 #> 18 19 20 21 22 23 #> 7534.675200 7373.905600 7210.820800 7046.662400 6881.606400 6715.966400 #> 24 25 26 27 28 29 #> 6550.944000 6386.521600 6221.616000 6065.656000 5922.992000 5789.214400 #> 30 31 32 33 34 35 #> 5656.478400 5527.451200 5393.875200 5251.203200 5103.992000 4958.454400 #> 36 37 38 39 40 41 #> 4809.878400 4676.390400 4566.518400 4469.758400 4372.048000 4282.163200 #> 42 43 44 45 46 47 #> 4161.715200 3992.091200 3793.982400 3600.371200 3397.075200 3237.659200 #> 48 49 50 51 52 53 #> 3149.675200 3104.219200 3052.772800 3014.564800 2923.268800 2744.044800 #> 54 55 56 57 58 59 #> 2513.348800 2294.264000 2064.318400 1897.942400 1835.374400 1836.100800 #> 60 61 62 63 64 65 #> 1826.950400 1831.654400 1779.182400 1629.734400 1422.478400 1231.844800 #> 66 67 68 69 70 71 #> 1037.502400 891.830400 826.646400 813.176000 792.096000 776.793600 #> 72 73 74 75 76 77 #> 745.817600 683.017600 601.275200 529.699200 462.560000 401.280000 #> 78 79 80 81 82 83 #> 349.512000 304.948800 261.433600 219.961600 183.169600 151.681600 #> 84 85 86 87 88 89 #> 124.753600 101.692205 79.932348 61.686246 46.953898 35.735304 #> 90 91 92 93 94 95 #> 27.603433 20.850155 15.048439 10.198284 6.299690 3.438064 #> 96 97 98 99 100 #> 1.955032 1.936000 3.380968 6.289936 0.000000# giving a different single-age split to close out this way: popg <- graduate_grabill(Value = popvec, Age = a5, OAG = TRUE) grabill.closed.out <- graduate_mono_closeout(Value = popvec, Age = a5, pops = popg) # totals not necessarily preserved if mixed w Grabill # I wouldn't recommend a rescale of the total, since the # only part we mess with here is the old age section. Ergo, # one may wish to instead rescale results colSums() of # popg at age pivotAge and higher. sum(grabill.closed.out) - sum(popvec)#> [1] -22.01899# also works on an age-labeled vector of data closed.vec <- graduate_mono_closeout(popvec, Age = a5, OAG = TRUE) # let's compare this one with sprague() simple.vec <- graduate_sprague(popvec, Age = a5, OAG = TRUE) # and with a simple monotonic spline mono.vec <- graduate_mono(popvec, Age = a5, OAG = TRUE) if (FALSE) { plot(85:100,simple.vec[86:101], type = 'l', main = "In this case graduate_sprague() is the smoothest") lines(85:100,closed.vec[86:101], col = "red", lwd = 2) lines(85:100,mono.vec[86:101], col = "blue", lty = 2) legend("topright",lty=c(1,2,2), col = c("black","red","blue"),lwd = c(1,2,1), legend = c("graduate_sprague()","monoCloseout()", "graduate_mono()")) }