assign4.R

rm(list=ls()); cat("\f"); graphics.off(); options(warn=-1)



global = list(A=0.00022, B=2.7e-06, c=1.124, d=2, x=20, w=120, radix=1e+05, i=0.05) # d is the select period

uxs <- function(s, x=global$x, d=global$d, A=global$A, B=global$B, c=global$c) { # hazard function
  0.9^(pmax(d-s,0))*(A+B*c^(x+s))
}

tpx <- function(t, x=global$x, s=0, d=global$d, w=global$w) { # tp[x] where s is remaining select periods
  unlist(ifelse((x+t)>=w, 0, 
                lapply(t, function(t) exp(-integrate(function(t) uxs(t,ifelse(s!=d, x+s, x),s), 0, min(t,d))$value
                                          -integrate(function(t) uxs(t,ifelse(s!=d, x+s+d, x+d),0), 0, max(0, t-d))$value))))
}

createLifeTable <- function(x=global$x, w=global$w, radix=global$radix, d=global$d) {
  lt = data.frame(c(rep(NA,d),x:(w-d-1)), lapply(0:(d-1), function(y) c(rep(NA,d), 
            tail(tpx(0:(w-x-1),x)*radix,-d)/unlist(lapply(x:(w-x-1), function(x) tpx(d-y,x,d-y))))),
            tpx(0:(w-x-1),x)*radix, x:(w-1))
  names(lt) = c("x", unlist(lapply(0:(d-1), function(x) paste("l[x]+",x,sep=""))), paste("lx+",d,sep=""),"x+2")
  lt
}

lt = createLifeTable(global$x)