{"id":428809,"date":"2018-06-01T11:59:09","date_gmt":"2018-06-01T11:59:09","guid":{"rendered":"https:\/\/essaypaper.org\/data-importing\/"},"modified":"2018-10-24T08:59:30","modified_gmt":"2018-10-24T08:59:30","slug":"data-importing","status":"publish","type":"post","link":"https:\/\/www.benedictsol.com\/blogs\/data-importing\/","title":{"rendered":"Data Importing"},"content":{"rendered":"
\n

Data Importing<\/p>\n

rm(list=ls())
library(dplyr)
library(\u2018tseries\u2019)
library(\u2018forecast\u2019)<\/p>\n

\n#Importing Data
dataUSDeaths = read.table(\u201cC:\/Users\/User\/Documents\/dataUSDeaths.txt\u201d, header=T, dec=\u201d.\u201d)
dataUSExposures = read.table(\u201cC:\/Users\/User\/Documents\/dataUSExposures.txt\u201d, header=T, sep=\u201d\u201d, dec=\u201d.\u201d)
Deaths_data = select(dataUSDeaths, Year, Age, Total)
Exposures_data = select(dataUSExposures, Year, Age, Total)
Deaths_data_1 = Deaths_data
Exposures_data_1 = Exposures_data
Deaths_data_2 = Deaths_data
Exposures_data_2 = Exposures_data<\/p>\n

#Question 1
#Filtering The Age
Deaths_data = filter(Deaths_data, Age!=\u201d110+\u201d, Age!=\u201d109\u2033, Age!=\u201d108\u2033, Age!=\u201d107\u2033, Age!=\u201d106\u2033,Age!=\u201d105\u2033,
Age!=\u201d104\u2033, Age!=\u201d103\u2033, Age!=\u201d102\u2033, Age!=\u201d101\u2033)
Exposures_data = filter(Exposures_data, Age!=\u201d110+\u201d, Age!=\u201d109\u2033, Age!=\u201d108\u2033, Age!=\u201d107\u2033, Age!=\u201d106\u2033,Age!=\u201d105\u2033,
Age!=\u201d104\u2033, Age!=\u201d103\u2033, Age!=\u201d102\u2033, Age!=\u201d101\u2033)
Age_Data = as.numeric(paste(unique(Deaths_data$Age)))
nAge = length(unique(Age_Data))
nAge
Year_Data = unique(Deaths_data$Year)
nYear = length(unique(Year_Data))
nYear<\/p>\n

#Mortality
Mortality_Rates = log(matrix(Deaths_data$Total\/Exposures_data$Total, nYear, nAge, byrow=T))
Mortality_Rates<\/p>\n

#LeeCarter MODEL
#LeeCarter MODEL Parameter Estimation
alpha_hat = colMeans(Mortality_Rates)
Z=matrix(0,nYear, nAge)
for(i in 1:nAge){
Z[,i] = Mortality_Rates[,i]-alpha_hat[i]
}
SVD_Z = svd(Z,1,1)
kapaa_hat = SVD_Z$u*sum(SVD_Z$v)*SVD_Z$d[1]
beta_hat = SVD_Z$v\/sum(SVD_Z$v)
par(mfrow=c(1,3))
plot(Year_Data, kapaa_hat, type=\u2019l\u2019, main=\u201dkapaa\u201d)
plot(Age_Data, alpha_hat, type=\u2019l\u2019, main= \u201calpha\u201d)
plot(Age_Data,beta_hat, type=\u2019l\u2019, main=\u201dbeta\u201d)<\/p>\n

#LeeCarter Residuals
Mortality_RatesHat = rep(1,1,nYear)%*%t(alpha_hat)+kapaa_hat%*%t(beta_hat)
ResidualRates = Mortality_Rates \u2013 Mortality_RatesHat
ResidualRates<\/p>\n

#ARMA MODEL
AIC = c()
LL = c()
BICC = c()<\/p>\n

Model = arima(kapaa_hat, order=c(1,0,1))
Model
AIC[1] = Model$aic
LL[1] = Model$loglik
BICC[1] = BIC(Model)
par(mfrow = c(1,2))
plot(Model$residuals, col = 1)
acf(Model$residuals)
Box.test(Model$residuals, lag = 4, type = c(\u201cLjung-Box\u201d))<\/p>\n

#Forecasting The Mortality Rate for the year 2017
ModelPred = forecast(Model, h = 2)
par(mfrow = c(1,1))
plot(ModelPred, main = \u201cModel\u201d)<\/p>\n

#Poisson MODEL
Yt = Deaths_data$Year
Ax = Deaths_data$Age
Dxt = as.integer(Deaths_data$Total)
Ext = Exposures_data$Total<\/p>\n

Model2=glm(Dxt~Ext + Ax + Yt, offset=log(Ext), poisson(link=log) )
summary(Model2)
Model2.values=log(exp(predict.glm(Model2))\/Ext)
Model2.valuesMatrix=matrix(Model2.values, nYear, nAge,byrow=T)
par(mfrow = c(1,1))
plot(Model2.valuesMatrix[4,], type = \u201cl\u201d, main = \u201cPoissonModel\u201d)<\/p>\n

\n#Question 2
d=(kapaa_hat[nYear]-kapaa_hat[1])\/nYear
Predkapaa_hat=c()
Residualskp=c()
Predkapaa_hat[1]=kapaa_hat[1]
for(i in 2:nYear){
Predkapaa_hat[i]=kapaa_hat[i-1]+d
Residualskp[i-1]=kapaa_hat[i]-Predkapaa_hat[i]
}
N_Sim=10000
N_period=100
Residuals_k = Residualskp
Residuals_y = ResidualRates
par(mfrow = c(1,2))<\/p>\n

#normal simulation
x=20
AA_x=alpha_hat[Age_Data==x]
BB_x=beta_hat[Age_Data==x]
kp_sim=c()
y_sim=c()
kp_sim[1]=kapaa_hat[nYear]
y_sim[1]=Mortality_Rates[nYear, Age_Data==x]
for(i in 2:N_Sim){
kp_sim[i]=kp_sim[i-1]+d+rnorm(1,0,sd(Residuals_k))
y_sim[i]=AA_x+BB_x*kp_sim[i]+rnorm(1,0,sd(Residuals_y))
}<\/p>\n

plot(Year_Data,Mortality_Rates[,Age_Data==x],type=\u2019l\u2019,xlim=c(1935,2035),ylim=c(-9,-3), main = \u201cnormal simulation\u201d)<\/p>\n

#Sample Simulation
x=10
AA_x=alpha_hat[Age_Data==x]
BB_x=beta_hat[Age_Data==x]
kp_sim=c()
y_sim=c()
kp_sim[1]=kapaa_hat[nYear]
y_sim[1]=Mortality_Rates[nYear, Age_Data==x]
for(i in 2:N_Sim){
kp_sim[i]=kp_sim[i-1]+d+sample(Residuals_k,1,replace=F)
y_sim[i]=AA_x+BB_x*kp_sim[i]+sample(Residuals_y,1,replace=F)
}
plot(Year_Data,Mortality_Rates[,Age_Data==x],type=\u2019l\u2019,xlim=c(1935,2035),ylim=c(-8,-5), main = \u201cSample Method\u201d)<\/p>\n

#Question 3
#Pensioners aged 65 and above
Deaths_data$Age=as.numeric(as.character(Deaths_data$Age))
Deaths_data.3 = Deaths_data
Deaths_data.3$Age[Deaths_data.3$Age < 65] = NA
Deaths_data.3=na.omit(Deaths_data.3)
Exposures_data$Age=as.numeric(as.character(Exposures_data$Age))
Exposures_data.3 = Exposures_data
Exposures_data.3$Age[Exposures_data.3$Age < 50] = NA
Exposures_data.3=na.omit(Exposures_data.3)<\/p>\n

#Ages in >65 dataset
Age_Data1 = as.numeric(paste(unique(Exposures_data.3$Age)))
nAge1 = length(unique(Age_Data1))
#Years in >65 dataset
Year_Data1 = unique(Exposures_data.3$Year)
nYear1 = length(unique(Year_Data1))<\/p>\n

#Mortality
Mortality_Rates1 = log(matrix(Deaths_data.3$Total\/Exposures_data.3$Total, nYear1, nAge1,byrow=T))
Mortality_Rates1<\/p>\n

#Using the LeeCarter Model
alpha_hat1 = colMeans(Mortality_Rates1)
Zn=matrix(0,nYear1, nAge1)
for(i in 1:nAge1){
Zn[,i] = Mortality_Rates1[,i]-alpha_hat1[i]
}
SVD_Z1 = svd(Zn,1,1)<\/p>\n

kapaa_hat1 = SVD_Z1$u*sum(SVD_Z1$v)*SVD_Z1$d[1]
beta_hat1 = SVD_Z1$v\/sum(SVD_Z1$v)
par(mfrow=c(1,3))
plot(Year_Data1, kapaa_hat1, type=\u2019l\u2019, main=\u201dkappa1\u2033)
plot(Age_Data1, alpha_hat1, type=\u2019l\u2019, main= \u201calpha1\u2033)
plot(Age_Data1,beta_hat1, type=\u2019l\u2019, main=\u201dbeta1\u201d)<\/p>\n

\n#Question 4
Deaths_data_1$Year[Deaths_data_1$Year > 1990] = NA
Deaths_data.Train = na.omit(Deaths_data_1)
Exposures_data_1$Year[Exposures_data_1$Year > 1990] = NA
Exposures_data.Train = na.omit(Exposures_data_1)<\/p>\n

#Ages in the train data
AgeTrain = as.numeric(paste(unique(Exposures_data.Train$Age)))
nAgeTrain = length(unique(AgeTrain))
nAgeTrain
#Years in the train data
YearTrain = unique(Exposures_data.Train$Year)
nYearTrain = length(unique(YearTrain))
nYearTrain<\/p>\n

#Fitting ARMA model
Yt1 = Deaths_data.Train$Year
Ax1= Deaths_data.Train$Age
Dxt1 = as.integer(Deaths_data.Train$Total)
Ext1 = Exposures_data.Train$Total<\/p>\n

Model2Train = glm(Dxt1~Ext1 + Ax1 + Yt1, offset=log(Ext1), poisson(link=log) )
summary(Model2Train)
Model2.values1 = log(exp(predict.glm(Model2Train))\/Ext1)
Model2.valuesMatrix1 = matrix(Model2.values1, nYearTrain, nAgeTrain,byrow=T)<\/p>\n

Deaths_data_2$Year[Deaths_data_1$Year < 1991] = NA
Deaths_data.Test = na.omit(Deaths_data_2)
Exposures_data_2$Year[Exposures_data_2$Year < 1991] = NA
Exposures_data.Test = na.omit(Exposures_data_2)<\/p>\n

#Ages in Test data
AgeTest = as.numeric(paste(unique(Exposures_data.Test$Age)))
nAgeTest = length(unique(AgeTest))
nAgeTest
#Years in Test data
YearTest = unique(Exposures_data.Test$Year)
nYearTest = length(unique(YearTest))
nYearTest<\/p>\n

Yt2 = Deaths_data.Test$Year
Ax2= Deaths_data.Test$Age
Dxt2= as.integer(Deaths_data.Test$Total)
Ext2 = Exposures_data.Test$Total
data_Test = matrix(c(Dxt2,Ext2,Ax2,Yt2), ncol = 4, byrow = T)
colnames(data_Test) = c(\u201cDxt2\u2033,\u201dExt2\u2033,\u201dAx2\u2033,\u201dYt2\u201d)
data_Test<\/p>\n

Modelp = predict(Model2Train, data = data_Test)
Modelp = log(exp(Modelp)\/Ext2)
par(mfrow=c(1,2))
Mortality_RatesTrain = log(matrix(Deaths_data.Test$Total\/Exposures_data.Test$Total, nYearTest, nAgeTest,byrow=T))
plot(Mortality_RatesTrain[4,], type = \u201cl\u201d, main = \u201cTest Data\u201d)
Model2.valuesMatrix2 = matrix(Modelp, nYearTest, nAgeTest,byrow=T)
plot(Model2.valuesMatrix2[4,], type = \u201cl\u201d, main = \u201cModelled Data\u201d)<\/p>\n

\n
\n

Related Assignment Samples<\/h3>\n