全部版块 我的主页
论坛 数据科学与人工智能 数据分析与数据科学 R语言论坛
366 0
2024-03-13
```{r}
## MORTALITY RATES DATA PREPARATION ##
ageLimit <- 90   #截止到90岁
ageGroups <- ageLimit + 1
timePeriods <- 29 #一共有29年的数据
tHor <- 10  #预测年份
mrRaw <- read.csv("D:/大学资料/毕业论文/实践/死亡率/mortality_data_male.csv", header=TRUE)                                                
colnames(mrRaw) <- c("Age",1994:2022 )               
mrMa <- mrRaw[-1]/100               #对数进行变化,模拟效果更好
mrMatrix <- as.matrix(mrMa)                       
colnames(mrMatrix) <- 1994:2022                                                                               
rownames(mrMatrix) <- 0:ageLimit        

mode(mrMatrix) = "numeric"
mrMatrix <- replace(mrMatrix, mrMatrix == 0, 0.000000001) #为了避免无穷的出现,进行转换
```


```{r}
## BASIC LEE-CARTER METHOD ##
## Fitting procedure ##
a_x = rowMeans(log(mrMatrix))                                                                               
M = log(mrMatrix) - a_x                                                                                               
svdM <- svd(M)                                                                                                                        #利用SVD方法进行分解
b_x <- -svdM$u[,1]                                                                                                       
k_t <- -svdM$d[1]*svdM$v[,1]                                                                       
Mhat <- matrix(nrow = ageGroups, ncol = timePeriods)                               
for (i in 1:timePeriods){                                                                                       
        Mhat[,i] <- a_x + b_x*k_t[i]   #利用估计的参数对原数据进行拟合
}
colnames(Mhat) <- 1994:2022                                                                                       
rownames(Mhat) <- 0:ageLimit
a_x
b_x
k_t
```


```{r}
## Forecasting procedure ##
dhat <- (k_t[timePeriods] - k_t[1])/(timePeriods - 1)                                        # Define drift parameter
total = matrix(nrow = timePeriods - 1, ncol = 1)                                       
for (i in 1:timePeriods-1) {                                                                                       
        total[i] <- (k_t[i+1] - k_t[i] - dhat)^2
}
see = sqrt(1/(timePeriods-2)*sum(total))                                                               
kForc_t <- matrix(nrow = tHor, ncol = 1)                                                                # 估计k_t向量

for (i in 1:tHor) {                                                                                                                #
        kForc_t[i] = k_t[timePeriods] + dhat*i + sqrt(i)*rnorm(1,0,see^2)        # Random walk
}
Mtilde <- matrix(nrow = ageGroups, ncol = tHor)                                                        # Initiate M-tilde matrix
for (i in 1:tHor) {                                                                                                                # 估计未来数据
        Mtilde[,i] <- a_x + b_x*kForc_t[i]
}
colnames(Mtilde) <- 2023:2032                                                                               
rownames(Mtilde) <- 0:ageLimit
Mstar <- cbind(Mhat,Mtilde)                                                                                                # 进行合并
```

二维码

扫码加我 拉你入群

请注明:姓名-公司-职位

以便审核进群资格,未注明则拒绝

栏目导航
热门文章
推荐文章

说点什么

分享

扫码加好友,拉您进群
各岗位、行业、专业交流群