assign7.R

Nathan — Apr 7, 2014, 12:24 PM

cat("\014")

graphics.off()
rm(list=ls())

#### VARIABLES ####
x=40
m=4
n=10
i = 0.05
A = 0.00022
B = 2.5e-05
c = 1.1
w = 120
l20 = 100000

#### FUNCTIONS ####
formatVector <- function(nums, k) {
  for (j in 1:length(nums)) {
    num = as.numeric(nums[j])
    nums[j] = format(round(num,k), nsmall=k)
  }
  return(as.numeric(nums))
}

formatDataFrame <- function(table, numDecimals) {
  for (j in (1:length(table))) {
    numEntries = w-x

    currentcol = table[0:numEntries,][j][0:numEntries,]
    currentcol = formatVector(currentcol, numDecimals)
    currentcol = data.frame(currentcol)
    table[0:numEntries,][j] = currentcol
  }
  return(table)
}

v <- function(i, n, moment=1) {
  delta = log(1+i)*moment
  return(exp(-delta*n))
}

d <- function(i,m=1) {
  if(m==1)
    return(i/(1+i))
  else
    return((1-(1-d(i))^(1/m))*m)
}

iupperm <- function(i,m) {
  return(m*((1+i)^(1/m) - 1))
}

tpx <- function(t,age=x) {
  if( (age+t)>= w) return(0)
  return(exp(-(A*t + B/log(c)*(c^age)*(c^t -1))))
}

tpselectx <- function(t,age=x) {
  if( (age+t)>= w) return(0)
  if (0<= t & t<=2) {
    return(exp(0.9^(2-t)* ((A*(1 - 0.9^t)/log(0.9)) + (B*c^age*(c^t - 0.9^t)/log(0.9/c)))))
  } else {
    #return(tpx(t,age))
    return(tpselectx(2,age)*tpx(t-2,age+2))
  }
}

tpselectxplus1 <- function(t,age=x) {
  if( (age+t)>= w) return(0)
  if(0<=t & t<=1) {
    return(exp(0.9^(1-t)*( (A/log(0.9)*(1-0.9^t)) + (B*c^(age+1)/log(0.9/c)*(c^t - 0.9^t)))))
  } else {
    #return(tpx(t,age))
    return(tpselectxplus1(1,age)*tpx(t-1,age+1))
  }
}

kdeferredtqx <- function(k,t=1,age=x) {
  return(tpx(k,age) - tpx(k+t,age))
}

kdeferredtselectqx <- function(k,t=1,age=x) {
  return(tpselectx(k,age) - tpselectx(k+t,age))
}

kdeferredtselectqxplus1 <- function(k,t=1,age=x) {
  return(tpselectxplus1(k,age)-tpselectxplus1(k+t,age))
}

Ax <- function(age=x,m=1, moment=1) {
  return(Axterm(age,w-age,m,moment))
}

Aselectx <- function(age=x,m=1,moment=1) {
  return(v(i,1,moment)*(1-tpselectx(1,age)) + v(i,2,moment)*(1-tpselectxplus1(1,age))*tpselectx(1,age) + 
           v(i,2,moment)*tpselectx(2,age)*(Ax(age+2,m,moment)))
}

Aselectxplus1 <- function(age=x,m=1,moment=1) {
  return(Aselectxplus1term(age,w-age,m,moment))
}

Axterm <- function(age=x, n, m=1, moment=1) {
  # mthly case. assume UDD
  if (m>1) {
    return(Axterm(age, n, m=1,moment)*i/iupperm(i,m))
  }

  # annual case (m=1)
  total = 0
  for (k in (0:(n-1))) {
    total = total + v(i,k+1,moment)*kdeferredtqx(k,1,age)
  }
  return(total)
}

Aselectxterm <- function(age=x,n,m=1,moment=1) {
  j=i
  if(moment==2) j=exp(2*log(1+i))-1
  return(nEselectx(n,age,moment)+(Aselectx(age,1,moment)-
                                    nEselectx(n,age,moment)*Ax(age+n,1,moment))*(j/iupperm(j,m)))
}

Aselectxplus1term <- function(age=x, n, m=1, moment=1) {
  # mthly case. assume UDD
  if (m>1) {
    return(Aselectxplus1term(age, n, m=1,moment)*i/iupperm(i,m))
  }

  # annual case (m=1)
  total = 0
  for (k in (0:(n-1))) {
    total = total + v(i,k+1,moment)*kdeferredtselectqxplus1(k,1,age)
  }
  return(total)
}

Axcolumn <- function(age=x,w,i,moment=1) {
  axcol <- numeric(0); temp=0

  for (k in 0:(w-age)) { 
    if(k==0) temp = v(i,1,moment)
    else temp = axcol[k]*tpx(1,(w-k))*v(i,1,moment) + v(i,1,moment)*(1-tpx(1,(w-k)))
    axcol = c(axcol, temp)
  }

  return(rev(axcol))
}

Aselectxcolumn <- function(age=x,w,i,moment=1) {
  aselectxcol <- numeric(0); temp = 0
  axplus2col = Axcolumn(age+2, w+2, i, moment)

  for (k in 0:(w-age)) {
    temp = (v(i,1,moment)*(1-tpselectx(1,age+k)) + v(i, 2, moment)*(1-tpselectxplus1(1,age+k))*tpselectx(1,age+k) 
            + v(i,2,moment)*tpselectx(2,age+k)*axplus2col[k+1])
    aselectxcol = c(aselectxcol, temp)
  }
  return(aselectxcol)
}

Aselectxplus1column <- function(age=x,w,i,moment=1) {
  aselectxplus1col <- numeric(0); temp = 0
  for(k in age:w) {
    aselectxplus1col = c(aselectxplus1col, Aselectxplus1(k,1,moment))
  }
  return(aselectxplus1col)
}

aduexcolumn <- function(age=x,w,i,moment=1) {
  aduexcol <- numeric(0); temp=0
  axcol = Axcolumn(age,w,i,moment)

  for (k in 0:(w-age)) {
    aduexcol = c(aduexcol, (1-axcol[k])/d(i))
  }
  aduexcol = c(aduexcol,0)
  return(aduexcol)
}

adueselectxcolumn <- function(age=x,w,i,moment=1) {
  aduexcol <- numeric(0); temp=0
  aselectxcol = Aselectxcolumn(age,w,i,moment)

  for (k in 0:(w-age)) {
    aduexcol = c(aduexcol, (1-aselectxcol[k])/d(i))
  }
  aduexcol = c(aduexcol,0)
  return(aduexcol)
}

adueselectxplus1column <- function(age=x, w, i, moment=1) {
  aduexcol <- numeric(0); temp=0
  aselectxplus1col = Aselectxplus1column(age,w,i,moment)

  for (k in 0:(w-age)) {
    aduexcol = c(aduexcol, (1-aselectxplus1col[k])/d(i))
  }
  aduexcol = c(aduexcol,0)
  return(aduexcol)
}

nEx <- function(n,age=x,moment=1) {
  return(v(i,n,moment)*tpx(n,age))
}

nEselectx <- function(n,age=x,moment=1) {
  return(v(i,n,moment)*tpselectx(n,age))
}

TableD.1 <- function(x, w) {
  age <- numeric(0)
  lselectx <- numeric(0)
  lselectxplus1 <- numeric(0)
  lxplus2 <- numeric(0)
  ageplus2 <- numeric(0)

  for (j in (x-2) : (w-2) ) {
    lxplus2 = c(lxplus2, l20*tpx( j-(x-2), x) )
    ageplus2 = c(ageplus2, j+2)

    if(j<x) { 
      age=c(age, 0)
      lselectx=c(lselectx, 0)
      lselectxplus1 = c(lselectxplus1, 0)
    } else {
      age = c(age,j)
      lselectx = c(lselectx, lxplus2[j-(x-3)]/tpselectx(2,j) )
      lselectxplus1 = c(lselectxplus1, lxplus2[j-(x-3)]/tpselectxplus1(1,j))
    }
  }

  table <- data.frame(age, lselectx, lselectxplus1, lxplus2, ageplus2)
  table = formatDataFrame(table, 2)
  names(table) = c("x", "l[x]", "l[x]+1", "lx+2", "x+2")
  return(table[0:(truncateAt+1-x),])
}

TableD.2 <- function(x,w) {  
  age <- numeric(0)
  aselectxcol = Aselectxcolumn(x,w,i,1)
  aselectx2col = Aselectxcolumn(x,w,i,2)
  adueselectxcol = adueselectxcolumn(x,w,i,1)
  adueselectxplus1col = adueselectxplus1column(x,w,i,1)
  Eselectx5 <- numeric(0)
  Eselectx10 <- numeric(0)
  Eselectx20 <- numeric(0)

  for (j in (x:w)) {
    age = c(age,j)
    Eselectx5 = c(Eselectx5, nEselectx(5,j))
    Eselectx10 = c(Eselectx10, nEselectx(10,j))
    Eselectx20 = c(Eselectx20, nEselectx(20,j))    
  }

  table <- data.frame(age, adueselectxcol, adueselectxplus1col, aselectxcol, aselectx2col, 
                      Eselectx5, Eselectx10, Eselectx20,age)
  table = formatDataFrame(table, 5)
  names(table) = c("x", '\"a[x]', '\"a[x]+1', "A[x]", "2A[x]", "5E[x]", "10E[x]", "20E[x]","x")
  return(table[0:(truncateAt+1-x),])
}

TableD.3 <- function(x,w) {
  age <- numeric(0)
  aduexcol = aduexcolumn(x,w,i,1)
  axcol = Axcolumn(x,w,i,1)
  ax2col = Axcolumn(x,w,i,2)
  Ex5 <- numeric(0)
  Ex10 <- numeric(0)
  Ex20 <- numeric(0)

  for (j in (x:w)) {
    age = c(age,j)
    Ex5 = c(Ex5, nEx(5,j))
    Ex10 = c(Ex10, nEx(10,j))
    Ex20 = c(Ex20, nEx(20,j))
  }

  table <- data.frame(age, aduexcol, axcol, ax2col, Ex5, Ex10, Ex20,age)
  table = formatDataFrame(table,5)
  names(table) = c("x", '\"ax' ,"Ax", "2Ax", "5Ex", "10Ex", "20Ex","x")
  return(table[0:(truncateAt+1-x),])

}

#### QUESTION 1 ####
truncateAt=119; temp<<-x; x<<-20
tableD.1 = TableD.1(x,w)
tableD.2 = TableD.2(x,w)
tableD.3 = TableD.3(x,w)
x<<-temp;
rm(truncateAt,formatDataFrame,formatVector,Aselectxcolumn,Axcolumn,
   Aselectxplus1column, adueselectxplus1column,
   adueselectxcolumn,aduexcolumn,temp, Aselectxplus1, Aselectxplus1term)

#### QUESTION 2 ####
insurance1epv <- function(age=x,n,m=1) {
  return((1-Aselectxterm(age,n,m))/d(i,m))                    
}

insurance1var <- function(age=x,n,m=1) {
  return( (Aselectxterm(age,n,m,moment=2) - Aselectxterm(age,n,m)^2)/(d(i,m)^2))
}

insurance2epv <- function(age=x,n,m=1) {
  return (nEselectx(n,age)*(1-(Ax(age+n)*i/iupperm(i,m)))/d(i,m))
}

insurance2var <- function(age=x,n,m=1) {
  j=exp(2*log(1+i))-1
  return(tpselectx(n,age)*v(i,n,moment=2)* 
           ((((1-Ax(age+n)*i/iupperm(i,m))/d(i,m))^2*(1-tpselectx(n,age)))
            + (( Ax(age+n,moment=2)*j/iupperm(j,m) - (Ax(age+n)*i/iupperm(i,m))^2)/d(i,m)^2)))
}

getPercentile <- function(EPV,SD,percentile,size=numberContracts) {
  zvalue = qnorm(percentile)
  return (zvalue*sqrt(size)*SD + size*EPV)
}

EPV = c(insurance1epv(x,n,m),insurance2epv(x,n,m))
SD = c(sqrt(insurance1var(x,n,m)), sqrt(insurance2var(x,n,m)))

numberContracts = 100
  p70 = c(getPercentile(EPV[1],SD[1],0.70),getPercentile(EPV[2],SD[2],0.70))
  p95 = c(getPercentile(EPV[1],SD[1],0.95),getPercentile(EPV[2],SD[2],0.95))
  results <- data.frame(EPV, SD, p70,p95)
  cat(paste("NUMBER OF CONTRACTS = ", numberContracts))

NUMBER OF CONTRACTS =  100

    cat("\n");print(results)

    EPV     SD   p70   p95
1 7.900 0.5257 792.8 798.7
2 9.284 2.4608 941.3 968.9

numberContracts = 10000
  p70 = c(getPercentile(EPV[1],SD[1],0.70),getPercentile(EPV[2],SD[2],0.70))
  p95 = c(getPercentile(EPV[1],SD[1],0.95),getPercentile(EPV[2],SD[2],0.95))
  results <- data.frame(EPV, SD, p70,p95)
  cat(paste("\nNUMBER OF CONTRACTS = ", numberContracts))

NUMBER OF CONTRACTS =  10000

    cat("\n");print(results)

    EPV     SD   p70   p95
1 7.900 0.5257 79030 79089
2 9.284 2.4608 92967 93243