inst/doc/casestudy1.R

In clmplus: Tool-Box of Chain Ladder Plus Models

## ----check-apc, echo=FALSE----------------------------------------------------
has_apc <- requireNamespace("apc", quietly = TRUE)
if (!has_apc) {
  knitr::opts_chunk$set(eval = FALSE)
  knitr::knit_exit()
}

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----tailor made functions, include=FALSE-------------------------------------
t2c <- function(x){
  "
  Function to transform an upper run-off triangle into a half-square.
    
  This function takes an upper run-off triangle as input.
  
  It returns a half square.
  "
  I= dim(x)[1]
  J= dim(x)[2]
  
  mx=matrix(NA,nrow=I,ncol=J)
  for(i in 1:(I)){
    for(j in 1:(J)){
      if(i+j<=J+1){
        mx[j,(i+j-1)]=x[i,j]
      }
    }
  }
  return(mx)
}


c2t <- function(x){
  "
  Function to transform a square into an upper run-off triangle.
  
  This function takes a half square as input.
  
  It returns an upper run-off triangle. 
  "
  I= dim(x)[1]
  J= dim(x)[2]
  
  mx=matrix(NA,nrow=I,ncol=J)
  for(i in 1:(I)){
    for(j in 1:(J)){
      if(i+j<=J+1){
        mx[i,j]=x[j,(i+j-1)]
      }
    }
  }
  return(mx)
}



## ----input data cl package, include= FALSE------------------------------------
library(ChainLadder)

data("AutoBI")
dataset=AutoBI$AutoBIPaid 


input_data <- incr2cum(dataset)


## ----pp_data data, include=FALSE----------------------------------------------
library(clmplus)


pp_data <- AggregateDataPP(cumulative.payments.triangle = input_data)


## ----amodel, message=FALSE, warning=FALSE-------------------------------------
a.model.fit=clmplus(AggregateDataPP =  pp_data, 
             hazard.model = "a")


## ----amodeloutput1, message=FALSE---------------------------------------------

a.model.fit$fitted_development_factors


## ----amodeloutput2, message=FALSE---------------------------------------------

a.model.fit$fitted_effects


## ----amodelpredict, message=FALSE---------------------------------------------

a.model <- predict(a.model.fit)


## ----dfpredicted, message=FALSE-----------------------------------------------

a.model$development_factors_predicted


## ----ltpredicted, message=FALSE-----------------------------------------------

a.model$lower_triangle


## ----ftpredicted, message=FALSE-----------------------------------------------

a.model$full_triangle


## ----predictionsoneyear, message=FALSE----------------------------------------

a.model.2 <- predict(a.model.fit,
                     forecasting_horizon=1)


## ----mack, message=FALSE, warning=FALSE---------------------------------------
mck.chl <- MackChainLadder(input_data)
ultimate.chl=mck.chl$FullTriangle[,dim(mck.chl$FullTriangle)[2]]
diagonal=rev(t2c(mck.chl$FullTriangle)[,dim(mck.chl$FullTriangle)[2]])

## ----clm replicated-----------------------------------------------------------
data.frame(ultimate.cost.mack=ultimate.chl,
           ultimate.cost.clmplus=a.model$ultimate_cost,
           reserve.mack=ultimate.chl-diagonal,
           reserve.clmplus=a.model$reserve
           )

cat('\n Total reserve:',
    sum(a.model$reserve))


## ----apc clm------------------------------------------------------------------
library(apc)

ds.apc = apc.data.list(cum2incr(dataset),
                       data.format = "CL")

ac.model.apc = apc.fit.model(ds.apc,
                         model.family = "od.poisson.response",
                         model.design = "AC")


## ----show comparison----------------------------------------------------------

ac.model.apc$coefficients.canonical[,'Estimate']

ac.fcst.apc = apc.forecast.ac(ac.model.apc)

data.frame(reserve.mack=ultimate.chl-diagonal,
           reserve.apc=c(0,ac.fcst.apc$response.forecast.coh[,'forecast']),
           reserve.clmplus=a.model$reserve
           
           )


## ----fitted ax amodel---------------------------------------------------------
a.model.fit$fitted_effects


## ----plot effects ax, message=FALSE, warning=FALSE, fig.alt="Fitted effect by development period, age-model."----
plot(a.model)

## ----amodel residuals, fig.alt="Scaled deviance residuals, age-model."--------
#make it triangular
plot(a.model.fit)

## ----ac residuals, message=FALSE, warning=FALSE, fig.alt="Scaled deviance residuals, age-cohort model."----
ac.model.fit <- clmplus(pp_data, 
                    hazard.model="ac")

ac.model <- predict(ac.model.fit,
                    gk.fc.model='a')
plot(ac.model.fit)

## ----ac effects, message=FALSE, warning=FALSE, fig.alt="Fitted effects, age-cohort model."----

plot(ac.model)


## ----apapc models, message=FALSE, warning=FALSE-------------------------------
ap.model.fit = clmplus(pp_data,
                   hazard.model = "ap")

ap.model<-predict(ap.model.fit, 
                   ckj.fc.model='a',
                   ckj.order = c(0,1,0))

apc.model.fit = clmplus(pp_data,hazard.model = "apc")

apc.model<-predict(apc.model.fit, 
                   gk.fc.model='a', 
                   ckj.fc.model='a',
                   gk.order = c(1,1,0),
                   ckj.order = c(0,1,0))

## ----residuals apmodel, fig.alt="Scaled deviance residuals, age-period model."----
plot(ap.model.fit)

## ----residuals apcmodel, fig.alt="Scaled deviance residuals, age-period-cohort model."----
plot(apc.model.fit)

## ----apc effects, message=FALSE, warning=FALSE, fig.alt="Fitted effects, age-period-cohort model."----
plot(apc.model)