inst/doc/ChainLadder.R

## ----options, echo=FALSE------------------------------------------------------
library(knitr)
library(lattice)
options(prompt = "R> ", digits = 4, show.signif.stars = TRUE)
options(continue="   ")
opts_chunk$set(
  comment = NA,
  message = FALSE,
  warning = FALSE,
  fig.asp = 0.8,
  fig.width = 6,
  out.width = "60%",
  fig.align = "center"
)
suppressPackageStartupMessages(library(ChainLadder))

## ---- echo=FALSE--------------------------------------------------------------
print(citation("ChainLadder"), bibtex=FALSE)

## ----eval=FALSE---------------------------------------------------------------
#  demo(package="ChainLadder")

## ----eval=FALSE---------------------------------------------------------------
#  install.packages('ChainLadder')

## ----eval=FALSE---------------------------------------------------------------
#  library(ChainLadder)
#  data(package="ChainLadder")

## ----RAAdata------------------------------------------------------------------
RAA

## ----RAAplot, fig.cap = "Claims development chart of the RAA triangle, with one line per origin period."----
plot(RAA/1000,  main = "Claims development by origin year")

## ----RAAplot2, fig.cap = "Claims development chart of the RAA triangle, with individual panels for each origin period"----
plot(RAA/1000, lattice=TRUE, main = "Claims development by origin year")

## -----------------------------------------------------------------------------
raa.inc <- cum2incr(RAA)
## Show first origin period and its incremental development
raa.inc[1,]
raa.cum <- incr2cum(raa.inc)
## Show first origin period and its cumulative development
raa.cum[1,]

## ----ExcelTriangle, echo=FALSE, fig.cap="Screen shot of a triangle in a spreadsheet software."----
knitr::include_graphics("SpreadsheetTriangle.png")

## ----eval=FALSE---------------------------------------------------------------
#  myCSVfile <- "path/to/folder/with/triangle.csv"
#  ## Use the R command:
#  # myCSVfile <- file.choose() to select the file interactively
#  tri <- read.csv(file=myCSVfile, header = FALSE)
#  ## Use read.csv2 if semicolons are used as a separator likely
#  ## to be the case if you are in continental Europe
#  library(ChainLadder)
#  ## Convert to triangle
#  tri <- as.triangle(as.matrix(tri))
#  # Job done.

## ----eval=FALSE---------------------------------------------------------------
#  tri <- read.table(file="clipboard", sep="\t", na.strings="")

## ----eval=FALSE---------------------------------------------------------------
#  demo(DatabaseExamples)

## -----------------------------------------------------------------------------
filename <-  file.path(system.file("Database",
                                   package="ChainLadder"),
                       "TestData.csv")
myData <- read.csv(filename)
head(myData)
summary(myData)

## -----------------------------------------------------------------------------
raa <- subset(myData, lob %in% "RAA")
head(raa)

## -----------------------------------------------------------------------------
raa.tri <- as.triangle(raa,
                       origin="origin",
                       dev="dev",
                       value="value")
raa.tri

## -----------------------------------------------------------------------------
raa.df <- as.data.frame(raa.tri, na.rm=TRUE)
head(raa.df)

## ----database, fig.cap="Flow chart of data between R and data bases", echo=FALSE----
knitr::include_graphics("RandDatabases.png")

## -----------------------------------------------------------------------------
as.triangle(matrix(c(100, 150, 175, 180, 200,
                     110, 168, 192, 205, NA,
                     115, 169, 202, NA,  NA,
                     125, 185, NA,  NA,  NA,
                     150, NA,  NA,  NA,  NA),
                   nrow = 5, byrow = TRUE))

## -----------------------------------------------------------------------------
triangle(c(100, 150, 175, 180, 200),
         c(110, 168, 192, 205),
         c(115, 169, 202),
         c(125, 185),
         150)

## -----------------------------------------------------------------------------
# Calculate age-to-age factors for RAA triangle
n <- 10
f <- sapply(1:(n-1),
            function(i){
              sum(RAA[c(1:(n-i)),i+1])/sum(RAA[c(1:(n-i)),i])
            }
)
f

## ----fig=TRUE-----------------------------------------------------------------
dev.period <- 1:(n-1)
plot(log(f-1) ~ dev.period, 
     main="Log-linear extrapolation of age-to-age factors")
tail.model <- lm(log(f-1) ~ dev.period)
abline(tail.model)
co <- coef(tail.model)
## extrapolate another 100 dev. period
tail <- exp(co[1] + c(n:(n + 100)) * co[2]) + 1
f.tail <- prod(tail)
f.tail

## ----fig=TRUE-----------------------------------------------------------------
plot(100*(rev(1/cumprod(rev(c(f, tail[tail>1.0001]))))), t="b",
     main="Expected claims development pattern",
     xlab="Dev. period", ylab="Development % of ultimate loss")

## -----------------------------------------------------------------------------
f <- c(f, f.tail)
fullRAA <- cbind(RAA, Ult = rep(0, 10))
for(k in 1:n){
  fullRAA[(n-k+1):n, k+1] <- fullRAA[(n-k+1):n,k]*f[k]
}
round(fullRAA)

## -----------------------------------------------------------------------------
sum(fullRAA[ ,11] - getLatestCumulative(RAA))

## -----------------------------------------------------------------------------
linkratios <- c(attr(ata(RAA), "vwtd"), tail = 1.05)
round(linkratios, 3) # display to only three decimal places
LDF <- rev(cumprod(rev(linkratios)))
names(LDF) <- colnames(RAA) # so the display matches the triangle
round(LDF, 3)
currentEval <- getLatestCumulative(RAA)
# Reverse the LDFs so the first, least mature factor [1]
#	is applied to the last origin year (1990)
EstdUlt <- currentEval * rev(LDF) #
# Start with the body of the exhibit
Exhibit <- data.frame(currentEval, LDF = round(rev(LDF), 3), EstdUlt)
# Tack on a Total row
Exhibit <- rbind(Exhibit,
data.frame(currentEval=sum(currentEval), LDF=NA, EstdUlt=sum(EstdUlt),
           row.names = "Total"))
Exhibit

## -----------------------------------------------------------------------------
lmCL <- function(i, Triangle){
  lm(y~x+0, weights=1/Triangle[,i],
     data=data.frame(x=Triangle[,i], y=Triangle[,i+1]))
}
sapply(lapply(c(1:(n-1)), lmCL, RAA), coef)

## -----------------------------------------------------------------------------
mack <- MackChainLadder(RAA, est.sigma="Mack")
mack # same as summary(mack) 

## -----------------------------------------------------------------------------
mack$f
mack$FullTriangle

## -----------------------------------------------------------------------------
mack_smmry <- summary(mack) # See also ?summary.MackChainLadder
mack_smmry$ByOrigin
mack_smmry$Totals

## ----fig=TRUE, label=MackPlot1, fig.asp=1.5, fig.cap="Some residual show clear trends, indicating that the Mack assumptions are not well met"----
plot(mack)

## ----fig=TRUE, label=MackPlot2, fig.asp=1.1-----------------------------------
plot(mack, lattice=TRUE)

## -----------------------------------------------------------------------------
calPeriods <- (row(RAA) + col(RAA) - 1)
(weights <- ifelse(calPeriods <= 5, 0, ifelse(calPeriods > 10, NA, 1)))
MackChainLadder(RAA, weights=weights, est.sigma = "Mack")

## ----fig=TRUE, fig.width = 6.5------------------------------------------------
MCLpaid
MCLincurred
par(mfrow=c(1,2))
plot(MCLpaid)
plot(MCLincurred)
par(mfrow=c(1,1))

## -----------------------------------------------------------------------------
# Following the example in Quarg's (2004) paper:
MCL <- MunichChainLadder(MCLpaid, MCLincurred, est.sigmaP=0.1, est.sigmaI=0.1)
MCL

## ----fig=TRUE, fig.asp=1.5----------------------------------------------------
plot(MCL)

## -----------------------------------------------------------------------------
## See also the example in section 8 of England & Verrall (2002)
## on page 55.
B <- BootChainLadder(RAA, R=999, process.distr="gamma")
B

## ----fig=TRUE, fig.asp=1.5----------------------------------------------------
plot(B)

## -----------------------------------------------------------------------------
quantile(B, c(0.75,0.95,0.99, 0.995))

## ----fig=TRUE-----------------------------------------------------------------
## fit a distribution to the IBNR
library(MASS)
plot(ecdf(B$IBNR.Totals))
## fit a log-normal distribution
fit <- fitdistr(B$IBNR.Totals[B$IBNR.Totals>0], "lognormal")
fit
curve(plnorm(x,fit$estimate["meanlog"], fit$estimate["sdlog"]),
      col="red", add=TRUE)

## -----------------------------------------------------------------------------
str(liab)

## -----------------------------------------------------------------------------
liab2 <- as(liab, "triangles")
class(liab2)

## ----eval = FALSE-------------------------------------------------------------
#  showMethods(classes = "triangles")

## -----------------------------------------------------------------------------
# use drop = TRUE to remove rows that are all NA's
liab2[, 12:14, drop = TRUE]

## -----------------------------------------------------------------------------
cbind2(liab2[1:3, 12])

## -----------------------------------------------------------------------------
fit1 <- MultiChainLadder(liab, fit.method = "OLS")
lapply(summary(fit1)$report.summary, "[", 15, )

## -----------------------------------------------------------------------------
fit <- lapply(liab, MackChainLadder, est.sigma = "Mack")
# the same as the first triangle above
lapply(fit, function(x) t(summary(x)$Totals))

## -----------------------------------------------------------------------------
(B1 <- MultiChainLadder(list(GenIns), fit.method = "OLS",
    mse.method = "Independence"))

## -----------------------------------------------------------------------------
fit2 <- MultiChainLadder(liab, fit.method = "SUR")
lapply(summary(fit2)$report.summary, "[", 15, )

## -----------------------------------------------------------------------------
round(unlist(residCor(fit2)), 3)

## -----------------------------------------------------------------------------
do.call("rbind", coef(fit2))

## ----multi, fig = TRUE, echo = FALSE, fig.asp = 1.5, fig.cap="Summary and diagnostic plots from a `MultiChainLadder` object"----
parold <- par(mfrow = c(4, 2), mar = c(4, 4, 2, 1),
    mgp = c(1.3, 0.3, 0), tck = -0.02)
plot(fit2, which.triangle = 1:2, which.plot = 1:4)
par(parold)

## -----------------------------------------------------------------------------
require(systemfit)
W1 <- MultiChainLadder2(liab, mse.method = "Independence",
      	control = systemfit.control(methodResidCov = "Theil"))
lapply(summary(W1)$report.summary, "[", 15, )

## -----------------------------------------------------------------------------
for (i in 1:5){
  W2 <- MultiChainLadder2(liab, mse.method = "Independence",
      control = systemfit.control(methodResidCov = "Theil", maxiter = i))
  print(format(summary(W2)@report.summary[[3]][15, 4:5],
          digits = 6, big.mark = ","))
}
lapply(summary(W2)$report.summary, "[", 15, )

## -----------------------------------------------------------------------------
str(auto)

## -----------------------------------------------------------------------------
f0 <- MultiChainLadder2(auto, type = "MCL")
# show correlation- the last three columns have zero correlation
# because separate chain-ladders are used
print(do.call(cbind, residCor(f0)), digits = 3)

## -----------------------------------------------------------------------------
f1 <- MultiChainLadder2(auto, type = "MCL+int")

## ----fig = TRUE, fig.cap="Residual plots for the MCL model (first row) and the GMCL (MCL+int) model (second row) for the auto data", echo = FALSE, fig.asp = 1.2, eval = FALSE----
#  parold <- par(mfrow = c(2, 3), mar = c(3, 3, 2, 1))
#  mt <- list(c("Personal Paid", "Personal Incured", "Commercial Paid"))
#  plot(f0, which.plot = 3, main = mt)
#  plot(f1, which.plot = 3, main = mt)
#  par(parold)

## ----eval = FALSE-------------------------------------------------------------
#  lapply(summary(f1, portfolio = "1+3")@report.summary, "[", 11, )

## ----eval = FALSE-------------------------------------------------------------
#  ult <- summary(f1)$Ultimate
#  print(ult[, 1] /ult[, 2], 3)

## ----eval = FALSE-------------------------------------------------------------
#  da <- auto[1:2]
#  # MCL with diagonal development
#  M0 <- MultiChainLadder(da)
#  # non-diagonal development matrix with no intercepts
#  M1 <- MultiChainLadder2(da, type = "GMCL-int")
#  # Munich chain-ladder
#  M2 <- MunichChainLadder(da[[1]], da[[2]])
#  # compile results and compare projected paid to incured ratios
#  r1 <- lapply(list(M0, M1), function(x){
#            ult <- summary(x)@Ultimate
#            ult[, 1] / ult[, 2]
#        })
#  names(r1) <- c("MCL", "GMCL")
#  r2 <- summary(M2)[[1]][, 6]
#  r2 <- c(r2, summary(M2)[[2]][2, 3])
#  print(do.call(cbind, c(r1, list(MuCl = r2))) * 100, digits = 4)

## -----------------------------------------------------------------------------
ClarkLDF(RAA)

## -----------------------------------------------------------------------------
ClarkLDF(RAA, maxage = 20)

## -----------------------------------------------------------------------------
ClarkLDF(RAA, G="weibull")

## ----fig = TRUE, label = LDFweibull, fig.asp=1.4------------------------------
plot(ClarkLDF(RAA, G="weibull"))

## -----------------------------------------------------------------------------
ClarkCapeCod(RAA, Premium = 40000, G = "weibull")

## ----fig=TRUE, label=CapeCod, fig.asp=1.4-------------------------------------
plot(ClarkCapeCod(RAA, Premium = 40000, G = "weibull"))

## -----------------------------------------------------------------------------
# load data
data(GenIns)
GenIns <- GenIns / 1000
# fit Poisson GLM
(fit1 <- glmReserve(GenIns))

## -----------------------------------------------------------------------------
summary(fit1, type = "model")

## -----------------------------------------------------------------------------
# Gamma GLM
(fit2 <- glmReserve(GenIns, var.power = 2))
# compound Poisson GLM (variance function estimated from the data):
# (fit3 <- glmReserve(GenIns, var.power = NULL))

## -----------------------------------------------------------------------------
set.seed(11)
(fit5 <- glmReserve(GenIns, mse.method = "boot"))

## -----------------------------------------------------------------------------
names(fit5)

## -----------------------------------------------------------------------------
pr <- as.data.frame(fit5$sims.reserve.pred)
qv <- c(0.025, 0.25, 0.5, 0.75, 0.975)
res.q <- t(apply(pr, 2, quantile, qv))
print(format(round(res.q), big.mark = ","), quote = FALSE)

## ----eval=FALSE---------------------------------------------------------------
#  library(ggplot2)
#  prm <- reshape(pr, varying=list(names(pr)), v.names = "reserve",
#                 timevar = "year", direction="long")
#  gg <- ggplot(prm, aes(reserve))
#  gg <- gg + geom_density(aes(fill = year), alpha = 0.3) +
#          facet_wrap(~year, nrow = 2, scales = "free")  +
#           theme(legend.position = "none")
#  print(gg)

## ----fig.cap="The predictive distribution of loss reserves for each year based on bootstrapping", echo=FALSE----
knitr::include_graphics("glmReservePlot.png")

## -----------------------------------------------------------------------------
PIC <- PaidIncurredChain(USAApaid, USAAincurred)
PIC

## -----------------------------------------------------------------------------
PIC$Res.Origin

## -----------------------------------------------------------------------------
PIC$Res.Tot

## -----------------------------------------------------------------------------
M <- MackChainLadder(MW2014, est.sigma="Mack")
cdrM <- CDR(M)
round(cdrM, 1)

## -----------------------------------------------------------------------------
cdrAll <- CDR(M,dev="all")
round(cdrAll, 1)

## ----tweedieReserve, eval=FALSE-----------------------------------------------
#   p_profile <- tweedieReserve(MW2008, p.optim=TRUE,
#     p.check=c(0,1.1,1.2,1.3,1.4,1.5,2,3),
#     design.type=c(0,1,1),
#     rereserving=FALSE,
#     bootstrap=0,
#     progressBar=FALSE)
#  # 0 1.1 1.2 1.3 1.4 1.5 2 3
#  # ........Done.
#  # MLE of p is between 0 and 1, which is impossible.
#  # Instead, the MLE of p has been set to NA .
#  # Please check your data and the call to tweedie.profile().
#  # Error in if ((xi.max == xi.vec[1]) | (xi.max == xi.vec[length(xi.vec)])) { :
#  # missing value where TRUE/FALSE needed

## ----echo=FALSE---------------------------------------------------------------
knitr::include_graphics("tweedieReserve.png")

Try the ChainLadder package in your browser

Any scripts or data that you put into this service are public.

ChainLadder documentation built on July 9, 2023, 5:12 p.m.