R/tbl_tri.R

In m-montero/LDTr: Loss Development Triangle Data

#' Function
#' 
#' @export
tbl_tri <- function(.data, type){
   require(dplyr)
   
   if(inherits(.data,"tbl_tri")) return(.data)
   
   if(!is.data.frame(.data)) stop("Expecting '.data' to be a data.frame")
   if(missing(type)) stop('argument "type" is missing')
   
   ##-- Tri Type
   possible.types <- .cal_columns()
   if(!type %in% names(possible.types))
      stop(paste0('"type" must be one of: ',paste0(names(possible.types),collapse = ", ")))
   
   ##-- VALUE
   if(!"VALUE" %in% names(.data)){
      names(.data)[names(.data) == last(names(.data))] <- possible.types[type]
   }else{
      names(.data)[names(.data) == "VALUE"] <- possible.types[type]
   }
   
   ##-- Adding Attributes
   attr(.data, "type") <- possible.types[type]
   class(.data) <-  c("tbl_tri", "tbl_df", "tbl", "data.frame")
   
   return(.data)
}

#' Function
#' 
#' @export
transform.tbl_tri <- function(.data, type){

      .c <- summary(.data)
   
   if(type == "Cumulative"){
      
      ##Assumes Incremental
      ans <- .data %>% 
         mutate(.TMP_ARRANGE = 1:nrow(.data)) %>% 
         arrange_(.c$TRI_ROW,.c$TRI_COLUMN) %>% 
         group_by_(.c$TRI_ROW) %>% 
         mutate(TRI_CUM = cumsum(TRI_INC)) %>%
         arrange(.TMP_ARRANGE) %>% 
         select(-starts_with(".TMP_")) %>%
         ungroup() %>%
         select_(.c$TRI_ROW,.c$TRI_COLUMN,"TRI_CUM","TRI_INC")
      
      ##-- Adding Attributes
      attr(ans, "type") <- .cal_columns()[type]
   }
   
   if(type == "Development"){
      if(!"TRI_CUM" %in% .c$TRI_CAL)
         .data <- Recall(.data, type = "Cumulative")
      
      ans <- .data %>% 
         arrange_(.c$TRI_ROW) %>% 
         group_by_(.c$TRI_ROW) %>% 
         mutate_(COL_OLDER = .c$TRI_COLUMN) %>% 
         mutate(COL_NEWER = lead(COL_OLDER), 
                TRI_LINK = paste0(COL_OLDER, '-to-', COL_NEWER), 
                VALUE.OLDER = TRI_CUM, 
                VALUE.NEWER = lead(TRI_CUM),
                TRI_DEV_FCT = VALUE.NEWER/VALUE.OLDER) %>%
         filter(!is.na(COL_NEWER)) %>% 
         ungroup() %>%
         select_(.c$TRI_ROW,"TRI_LINK","TRI_DEV_FCT") 
      
      ##-- Adding Attributes
      attr(ans, "type") <- .cal_columns()[type]
   }
   
   class(ans) <-  c("tbl_tri", "tbl_df", "tbl", "data.frame")
   return(ans)
}

#' Function
#' 
#' @export
summary.tbl_tri <- function(.data){
   ##TRI_ROW & TRI_COLUMN: Column 1 and 2 are ALWAYS the ROW and COLUMN of the triangle respectfully
   ##TRI_FILTER: Columns between 2 and the first auto.cal.columns are ALWAYS filter and group_by columns
   ##TRI_VALUE: Column with the first auto.cal.columns is the value in which the triangle shows
   ##TRI_IGNORE: Columns after the first auto.cal.columns is ignored
   ##TRI_CAL: Columns which are calculated columns
   
   .names <- names(.data)
   
   ##TRI_ROW & TRI_COLUMN
   tri.row <- .names[1]
   tri.column <- .names[2]
   
   first.auto.cal.column.loc <- min(which(.names %in% .cal_columns()))
   ##TRI_FILTER
   tri.filter <- NULL
   if(first.auto.cal.column.loc > 3)
      tri.filter <- .names[3:(first.auto.cal.column.loc-1)]
   
   ##TRI_VALUE
   tri.value <- .names[first.auto.cal.column.loc]
   
   ##TRI_IGNORE
   tri.ignore <- NULL
   if(length(.names) > first.auto.cal.column.loc)
      tri.ignore <- .names[(first.auto.cal.column.loc+1):length(.names)]
   
   ##TRI_CAL
   tri.cal <- .names[.names %in% .cal_columns()]
   
   list("TRI_ROW" = tri.row,
        "TRI_COLUMN" = tri.column,
        "TRI_FILTER" = tri.filter,
        "TRI_VALUE" = tri.value,
        "TRI_IGNORE" = tri.ignore,
        "TRI_CAL" = tri.cal)
}