/
LIFIT.R
207 lines (191 loc) · 9.62 KB
/
LIFIT.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
# Author: tim
###############################################################################
# function design based on Computer programs for demographic analysis
# Eduardo Arriaga, Patricia Anderson, Larry Heligman.
# Washington : U.S. Dept. of Commerce, Bureau of the Census, International Statistical Programs
# Center, 1976.
#' Mean absolute difference in survival rates.
#'
#' @description The mean absolute difference between 5-year survival ratios with optional age trimming. Based on LIFIT program from the MPCDA code base.
#'
#' @param lx1 numeric. Vector of the first survival function, any radix size.
#' @param lx2 numeric. Vector of the first survival function, any radix size.
#' @param Age1 integer. A vector of ages of the lower integer bound of the age groups corresponding to \code{lx1}.
#' @param Age2 integer. A vector of ages of the lower integer bound of the age groups corresponding to \code{lx2}.
#' @param ageMin integer. Optional lower age bound for calculations.
#' @param ageMax integer. Optional upper age bound for calculations.
#' @export
#' @details \code{lx1} and \code{lx2} can be of different lengths and grouped differently. For example, either or both input vectors could be in single or five-year age groups for this function. Results are selected internally for 5-year age groups, and vector lengths are matched. \code{ageMax} is an inclusive upper bound, treated as interval. If you want the age-group 70-74 to be included in calculations, then give \code{ageMax = 70}, not 75. The input vectors can also be of different lifetable radices. As with the original Fortran code, the open age group must be included in input vectors, even though it is not included in calcs. If your final age group is not open, then tack an extra element to it to simulate an open element, and just make sure to match ages.
#' @return The mean absolute difference in survival ratios.
#' @references
#' \insertRef{arriaga1976}{DemoTools}
#'
#' @examples
#' lx1 <-c(1, 0.94265, 0.93344, 0.92708, 0.923, 0.92023, 0.91796, 0.91601,
#' 0.91431, 0.9128, 0.91145, 0.91025, 0.90914, 0.90805, 0.90692,
#' 0.90566, 0.90419, 0.90251, 0.90063, 0.89858, 0.89642, 0.89417,
#' 0.8918, 0.88923, 0.88647, 0.88356, 0.88046, 0.87721, 0.87386,
#' 0.87047, 0.86706, 0.8636, 0.86008, 0.85649, 0.85276, 0.84882,
#' 0.84465, 0.84027, 0.8357, 0.83102, 0.8264, 0.82193, 0.8175, 0.81296,
#' 0.80827, 0.80343, 0.79845, 0.79329, 0.78788, 0.78218, 0.77617,
#' 0.76982, 0.76309, 0.75596, 0.74837, 0.74029, 0.73182, 0.72307,
#' 0.71396, 0.70434, 0.69402, 0.68295, 0.67102, 0.6581, 0.64442,
#' 0.63012, 0.61486, 0.59811, 0.57943, 0.55896, 0.53739, 0.51528,
#' 0.49248, 0.46826, 0.44272, 0.41631, 0.38876, 0.36037, 0.33157,
#' 0.30217, 0.27334, 0.24599, 0.21948, 0.19412, 0.17029, 0.14826,
#' 0.12771, 0.10909, 0.09241, 0.07763, 0.0647, 0.05363, 0.04403,
#' 0.03578, 0.02877, 0.02289, 0.018, 0.01399, 0.01075, 0.00815,
#' 0.0061, 0.00451, 0.00329, 0.00236, 0.00168, 0.00117, 0.00081,
#' 0.00055, 0.00036, 0.00024, 0.00015)
#'lx2 <- c(1, 0.99361, 0.99315, 0.99284, 0.99264, 0.99246, 0.9923, 0.99216,
#' 0.99201, 0.99189, 0.99176, 0.99164, 0.99149, 0.99135, 0.99118,
#' 0.99096, 0.99069, 0.99033, 0.98993, 0.98946, 0.98902, 0.98857,
#' 0.98809, 0.98763, 0.98717, 0.98672, 0.98623, 0.98574, 0.98521,
#' 0.98468, 0.9841, 0.98351, 0.98285, 0.98213, 0.98134, 0.9805,
#' 0.97959, 0.9786, 0.97748, 0.97628, 0.97495, 0.97353, 0.97197,
#' 0.97032, 0.96847, 0.96655, 0.96443, 0.96225, 0.95984, 0.95724,
#' 0.95446, 0.95142, 0.94822, 0.94469, 0.94058, 0.93651, 0.93187,
#' 0.92678, 0.92112, 0.91508, 0.90846, 0.90128, 0.89336, 0.88466,
#' 0.87543, 0.86532, 0.85442, 0.84265, 0.82993, 0.81641, 0.80212,
#' 0.78656, 0.77024, 0.75237, 0.73333, 0.71304, 0.69102, 0.66797,
#' 0.64371, 0.61749, 0.58998, 0.55953, 0.52836, 0.49505, 0.46051,
#' 0.42472, 0.38756, 0.34995, 0.31203, 0.27485, 0.23825, 0.20292,
#' 0.16979, 0.13867, 0.11131, 0.08713, 0.06679, 0.04989, 0.03626,
#' 0.02561, 0.01755, 0.01165, 0.00749, 0.00466, 0.00281, 0.00163,
#' 0.00092, 5e-04, 0.00026, 0.00013, 7e-05)
#' ADM(lx1,lx2, 0:110)
#' ADM(lx1,lx2,0:110,ageMax = 80)
ADM <- function(lx1,
lx2,
Age1,
Age2 = Age1,
ageMin = max(c(min(Age1), min(Age2))),
ageMax = min(c(max(Age1), max(Age2)))) {
stopifnot(length(lx1) == length(Age1))
stopifnot(length(lx2) == length(Age2))
# remove open age group
n1 <- length(lx1)
n2 <- length(lx2)
lx1 <- lx1[-n1]
lx2 <- lx2[-n2]
Age1 <- Age1[-n1]
Age2 <- Age2[-n2]
# ages in common only
age5 <- AGEN(
Age1,
Age2,
N = 5,
consecutive = TRUE,
ageMin = ageMin,
ageMax = ageMax
)
# trim lx to needed ages
lx1_5 <- lx1[Age1 %in% age5]
lx2_5 <- lx2[Age2 %in% age5]
# survivor ratios
Sx1 <- ratx(lx1_5)
Sx2 <- ratx(lx2_5)
# absolute differences
AD <- Sx1 - Sx2
# mean absolute difference
mean(abs(AD))
}
#' Mean absolute difference in age-ratios of survival rates.
#'
#' @description Take two survival curves, use them to calculate 5-year survival
#' ratios, then again take the consecutive age-ratios of these. Finally, take the
#' mean absolute difference between ratios, with optional age trimming.
#' Based on LIFIT program from the MPCDA code base.
#'
#' @param lx1 numeric. Vector of the first survival function, any radix size.
#' @param lx2 numeric. Vector of the first survival function, any radix size.
#' @param Age1 integer. A vector of ages of the lower integer bound of the age groups corresponding to \code{lx1}.
#' @param Age2 integer. A vector of ages of the lower integer bound of the age groups corresponding to \code{lx2}.
#' @param ageMin integer. Optional lower age bound for calculations.
#' @param ageMax integer. Optional upper age bound for calculations.
#' @export
#' @details \code{lx1} and \code{lx2} can be of different lengths and grouped differently.
#' For example, either or both input vectors could be in single or five-year age groups
#' for this function. Results are selected internally for 5-year age groups, and vector lengths are matched.
#' If you want the age-group 70-74 to be included in calculations, then give \code{ageMax = 70}, not 75.
#' The input vectors can also be of different lifetable radices. As with the original Fortran code,
#' the open age group must be included in input vectors, even though it is not included in calcs.
#' If your final age group is not open, then tack an extra element to it to simulate an open element,
#' and just make sure to match ages.
#' @return The mean absolute difference in survival ratios.
#' @references
#' \insertRef{arriaga1976}{DemoTools}
#'
#' @examples
#' lx1 <-c(1, 0.94265, 0.93344, 0.92708, 0.923, 0.92023, 0.91796, 0.91601,
#' 0.91431, 0.9128, 0.91145, 0.91025, 0.90914, 0.90805, 0.90692,
#' 0.90566, 0.90419, 0.90251, 0.90063, 0.89858, 0.89642, 0.89417,
#' 0.8918, 0.88923, 0.88647, 0.88356, 0.88046, 0.87721, 0.87386,
#' 0.87047, 0.86706, 0.8636, 0.86008, 0.85649, 0.85276, 0.84882,
#' 0.84465, 0.84027, 0.8357, 0.83102, 0.8264, 0.82193, 0.8175, 0.81296,
#' 0.80827, 0.80343, 0.79845, 0.79329, 0.78788, 0.78218, 0.77617,
#' 0.76982, 0.76309, 0.75596, 0.74837, 0.74029, 0.73182, 0.72307,
#' 0.71396, 0.70434, 0.69402, 0.68295, 0.67102, 0.6581, 0.64442,
#' 0.63012, 0.61486, 0.59811, 0.57943, 0.55896, 0.53739, 0.51528,
#' 0.49248, 0.46826, 0.44272, 0.41631, 0.38876, 0.36037, 0.33157,
#' 0.30217, 0.27334, 0.24599, 0.21948, 0.19412, 0.17029, 0.14826,
#' 0.12771, 0.10909, 0.09241, 0.07763, 0.0647, 0.05363, 0.04403,
#' 0.03578, 0.02877, 0.02289, 0.018, 0.01399, 0.01075, 0.00815,
#' 0.0061, 0.00451, 0.00329, 0.00236, 0.00168, 0.00117, 0.00081,
#' 0.00055, 0.00036, 0.00024, 0.00015)
#'lx2 <- c(1, 0.99361, 0.99315, 0.99284, 0.99264, 0.99246, 0.9923, 0.99216,
#' 0.99201, 0.99189, 0.99176, 0.99164, 0.99149, 0.99135, 0.99118,
#' 0.99096, 0.99069, 0.99033, 0.98993, 0.98946, 0.98902, 0.98857,
#' 0.98809, 0.98763, 0.98717, 0.98672, 0.98623, 0.98574, 0.98521,
#' 0.98468, 0.9841, 0.98351, 0.98285, 0.98213, 0.98134, 0.9805,
#' 0.97959, 0.9786, 0.97748, 0.97628, 0.97495, 0.97353, 0.97197,
#' 0.97032, 0.96847, 0.96655, 0.96443, 0.96225, 0.95984, 0.95724,
#' 0.95446, 0.95142, 0.94822, 0.94469, 0.94058, 0.93651, 0.93187,
#' 0.92678, 0.92112, 0.91508, 0.90846, 0.90128, 0.89336, 0.88466,
#' 0.87543, 0.86532, 0.85442, 0.84265, 0.82993, 0.81641, 0.80212,
#' 0.78656, 0.77024, 0.75237, 0.73333, 0.71304, 0.69102, 0.66797,
#' 0.64371, 0.61749, 0.58998, 0.55953, 0.52836, 0.49505, 0.46051,
#' 0.42472, 0.38756, 0.34995, 0.31203, 0.27485, 0.23825, 0.20292,
#' 0.16979, 0.13867, 0.11131, 0.08713, 0.06679, 0.04989, 0.03626,
#' 0.02561, 0.01755, 0.01165, 0.00749, 0.00466, 0.00281, 0.00163,
#' 0.00092, 5e-04, 0.00026, 0.00013, 7e-05)
#' RDM(lx1, lx2, 0:110)
#' RDM(lx1, lx2, 0:110, ageMax = 80)
RDM <- function(lx1,
lx2,
Age1,
Age2 = Age1,
ageMin = max(c(min(Age1), min(Age2))),
ageMax = min(c(max(Age1), max(Age2)))) {
stopifnot(length(lx1) == length(Age1))
stopifnot(length(lx2) == length(Age2))
# remove open age group
n1 <- length(lx1)
n2 <- length(lx2)
lx1 <- lx1[-n1]
lx2 <- lx2[-n2]
Age1 <- Age1[-n1]
Age2 <- Age2[-n2]
# ages in common only
age5 <- AGEN(
Age1,
Age2,
N = 5,
consecutive = TRUE,
ageMin = ageMin,
ageMax = ageMax
)
# select only needed lx
lx1_5 <- lx1[Age1 %in% age5]
lx2_5 <- lx2[Age2 %in% age5]
# survivor ratios
Sx1 <- ratx(lx1_5)
Sx2 <- ratx(lx2_5)
# ratios of the ratios
Rx1 <- ratx(Sx1)
Rx2 <- ratx(Sx2)
# differences of ratio ratios
RD <- Rx1 - Rx2
# mean absolute difference
mean(abs(RD))
}