正如有配偶的寿命之间存在很强的相关性，我们可能会问，孩子和孙子的出生是否具有对一个人的剩余生命的影响（或者我们是否可以像这样假设独立性）。

由Kaizong Ye，Sherry Deng撰写

最近我们被客户要求撰写关于死亡率建模的研究报告，包括一些图形和统计输出。昨天上午，我们获得了分娩产妇的平均年龄两个图表，根据孩子的出生顺序排序，区间是1905-1965年：

可下载资源

完整程序、数据和文档（word）

然后是1960-2000年：

Lee-Carter模型的主要思路是将死亡率的变化分解为时间因子t和年龄因子x。如果用表示x岁的人群在第t年的中心死亡率，那么满足以下函数关系式。

(1)

其中，反应x岁年龄组别的对数中心死亡率的平均水平，为人口死亡率随时间变化的速度，为年龄因子对的敏感度，即x岁年龄组别的死亡率随着时间变化的大小，为随机误差项，假设其服从正态分布。为了得到唯一确定的参数估计值，加入约束条件以及。是为了保证参数的平均值的含义，即。

3.1. 模型的求解

Lee-Carter模型参数的估计方法主要包括矩阵奇异值分解法(SVD)、最小二乘(OLS)和加权最小二乘法(WLS)；奇异值分解法和最小二乘法对不同年龄人群的死亡率赋予了相同的权重，但Koissi [2] 证明了，在现实情况下，不同年龄人群对应的人口数和死亡人口数都存在较大的差异，因此这两种方法在死亡率很低的条件下使用效果较差。为此，采用加权最小二乘法来估计Lee-Carter模型。

加权最小二乘法通过以下两个步骤求得，

第一步，将式(1)两边对年龄x 求和，得到。

第二步，Wilmoth [3] 证明的方差近似等于死亡人数的倒数，因此可以将作为残差平方和的权重。最小化经加权处理后的残差平方和，即得到 [4] 。

这些图形令人兴奋，特别是在过去30年中观察到的增长方面，这使我想到了寿命的增长趋势。

我们可以找到其他有趣的数据（在这种情况下为平均出生年龄）。

课程

R语言数据分析挖掘必知必会

从数据获取和清理开始，有目的的进行探索性分析与可视化。让数据从生涩的资料，摇身成为有温度的故事。

立即参加 ➜

 
> age$Age=as.character(age$AGE)
> age$AGE=as.numeric(substr(age$Age,1,2))+
+ as.numeric(substr(age$Age,4,4))/10
> plot(age$ANNEE+.5,age$AGE,
+ type="l",lwd=2,col="blue")

我们在上面的图中发现深蓝色的曲线，

获取祖母的平均年龄，我们进一步分析

 
> tail(age)
      AGE   Age NAIS.MERE NAIS.GRD.MERE age.GRD.MERE
2000  2000 30.3 30,3     1970.2       1942.87        57.63
2001  2001 30.4 30,4     1971.1       1943.80        57.70
2002  2002 30.4 30,4     1972.1       1944.92        57.58
2003  2003 30.5 30,5     1973.0       1945.95        57.55
2004  2004 30.5 30,5     1974.0       1947.05        57.45
2005  2005 30.6 30,6     1974.9       1948.04        57.46
> plot(age$ANNEE+.5,age$age.GRD.MERE,
+ type="l",lwd=2,col="red")

再一次，我们可以形象地看到外婆的出生年龄

我们可以通过使用Lee-Carter模型对年死亡率进行建模，并推断到当前世纪，我们可以推断出剩余期望寿命。

> Deces <- read.table("Dec.txt",header=TRUE)
> Expo  <- read.table("Expo.txt",header=TRUE,skip=2)
> Deces$Age <- as.nu
> Expo$Age <- as.numeric(as.character(Expo$Age))
> Expo$Age[is.n
Deces$Female/Expo$Female,nL,nC)
>  POPF <- matrix(Expo$Female,nL,nC)
>  BASEF <- demogdata(data=MUF, pop=POPF,ages=AGE,
+ years=YEAR, t
> K1 <- LCF$kt
nction(xentier,T){
+ return(ext) }
> EVIE = function(x,T){
+ x1 <- trunc(x)
> tail(age)
     AGE   Age NAIS.MERE NAIS.GRD.MERE age.GRD.MERE       EV
2000 30.3 30,3     1970.2       1942.87        57.63 29.13876
2001 30.4 30,4     1971.1       1943.80        57.70 29.17047
2002 30.4 30,4     1972.1       1944.92        57.58 29.39027
2003 30.5 30,5     1973.0       1945.95        57.55 29.52041
2004 30.5 30,5     1974.0       1947.05        57.45 29.72511
2005 30.6 30,6     1974.9       1948.04        57.46 29.80398