R/aux_fonctions_MJ.R

In MehdiChelh/triangle.tlbx: An Amazing Shiny App

# Fonctions auxiliaires MJ

#' @title Plot_settings
#' @description  ....
#'
#' @param triangle ...
#' @param m ...
#'
#' @rdname Plot_settings
#'
#' @keywords internal
#' @export 
Plot_settings <-function(triangle, m){
  
  origin <- names(na.omit(triangle[, m$col]))
  amounts <- Extract_dataframe(triangle, m)
  link_ratio <- Extract_dataframe(ata(triangle), m)
  
  # Dans le grahique on met les charges en année de développement N 
  #   en parallèle avec les link ratio N+1/N.
  amounts <- amounts[ - length(amounts) ]
  origin <- origin[ - length(origin) ]
  
  Final <- data.frame(list("value"=amounts,
                           "origin"=origin,
                           "LR"=link_ratio))
  return(Final)
}

#' @title Extract_dataframe
#' @description  ....
#'
#' @param triangle ...
#' @param m ...
#'
#' @rdname Extract_dataframe
#'
#' @keywords internal
#' @export 
Extract_dataframe <- function(triangle, m){
  Extract  <- triangle[ , m$col]
  return(as.numeric(na.omit(Extract)))
}

#' @title Plot_highchart
#' @description  ....
#'
#' @param triangle ...
#' @param m ...
#'
#' @rdname Plot_highchart
#'
#' @keywords internal
#' @export 
#' @import highcharter
#' @import plotly
Plot_highchart <- function(triangle, m){
  triangle <- Plot_settings(triangle, m) 
  h <- highchart() %>%
    hc_title(text = paste("Coefficients de développement n°", triangle$dev[1]),
             style = list(fontSize = "20px")) %>% 
    
    hc_xAxis(categories = as.numeric(triangle$origin), title=list(text="Années") ) %>%
    hc_yAxis_multiples(
      #opposite = TRUE,
      list(title = list(text = paste("Coefficients de développement"))),
      list(title = list(text = paste("Montants de charge")), opposite = TRUE)) %>% 
    hc_add_series(data = triangle$value, type = "column", yAxis = 1,  name=paste("Montants de charge"), color="#f0c300")%>% 
    hc_add_series(data = triangle$LR, type = "spline", yAxis = 0, name=paste("coefficients de développement"), color="#8B0000")%>%
    #hc_add_series(data = triangle$LR, type = "point", yAxis = 0, size=4)%>%
    hc_tooltip( crosshairs = TRUE, backgroundColor = "#FCFFC5", borderWidth = 2, shared = TRUE) 
  return(h)
  
}





#' @title Plot_ggplot
#' @description  ....
#'
#' @param Link_ratios a matrix representing the link ratios triangle
#' @param map a dataframe giving the rows and columns of the selected cells in the link ratios triangle. 
#' The first column of the dataframe corresponds to rows of the selected cells. 
#' The second column of the dataframe correspond to columns selected cells. 
#' @param m a list giving the row (m$row) and the column (m$col) of the last selected cell in the link ratios triangle. 
#'
#' @rdname Plot_ggplot
#'
#' @keywords internal
#' @export 
#' @import ggplot2
#' @import plotly
Plot_ggplot  <- function(Link_ratios, map, m){
  # TODO: Mettre à jour la fonction
  
  # m   : last clicked cell
  # map : list of selected cells
  # Link_ratios doit être déjà bien paramétré
  Charges <- Link_ratios
  if(length(m)==0){ # TODO: Comprendre ce que l'on teste ici
    m <- as.data.frame(cbind(row=0, col=0))
  }
  if(length(m)!=0){
    Link_ratios <- Plot_settings(Link_ratios, m)
  }
  if(length(map)==0){ 
    map <- as.data.frame(cbind(V1=1, V2=0))
  }
  
  maptemporary                          <- map[map[, 2] == m$col, 1]
  Link_ratios$PointsSize                <- 3
  Link_ratios$PointsSize[maptemporary]  <- 4
  # Link_ratios$PointsColor               <- 'grey'
  # Link_ratios$PointsColor[maptemporary] <- 'red'
  Link_ratios$PointsColor               <- 'conserves'
  Link_ratios$PointsColor[maptemporary] <- 'elimines'
  Link_ratios$PointsShape               <- 'disque'
  Link_ratios$PointsShape[maptemporary] <- 'raye'
  
  # Mean_unselected                       <- mean(Link_ratios$LR[-maptemporary])
  # if(length(maptemporary)==0){
  #   Mean_unselected  <- mean(Link_ratios$LR)
  # }
  # 
  # if(length(maptemporary)==0){
  #   Link_ratios$PointsSize                <- 1
  #   Link_ratios$PointsColor               <- 'grey'
  # }
  # if(is.null(maptemporary)){
  #   Link_ratios$PointsSize                <- 1
  #   Link_ratios$PointsColor               <- 'grey'
  # }
  # if(length(m)==0){
  #   Link_ratios$PointsSize                <- 1
  #   Link_ratios$PointsColor               <- 'grey'
  # }
  # 
  # if(is.null(m)){
  #   Link_ratios$PointsSize                <- 1
  #   Link_ratios$PointsColor               <- 'grey'
  # }
  
  previous_mcol<-NULL
  if(length(m)==0){
    previous_mcol<-m$col}
  
  Lignes                                <- dim(Link_ratios)[1]
  if(length(maptemporary)==0){
    Mean_unselected                       <- mean(Link_ratios$LR)
  }
  Mean_unselected                       <- sum(Link_ratios$value * Link_ratios$LR) / sum(Link_ratios$value) #mean(Triangle$LR[-maptemporary])
  
  
  Mean_Claims                           <- Charges[1:Lignes,m$col]
  Mean_Claims                           <- sum(Mean_Claims[-maptemporary]*Link_ratios$LR[-maptemporary])/sum(Mean_Claims[-maptemporary])
  
  
  if(length(maptemporary)==0){
    Mean_unselected  <- sum(Link_ratios$value * Link_ratios$LR) / sum(Link_ratios$value) 
  }
  print(maptemporary)
  if(length(maptemporary)==0){
    Link_ratios$PointsSize                <- 3
    Link_ratios$PointsColor               <- 'conserves'
    Link_ratios$PointsShape               <- 'disque'
  }
  if(is.null(maptemporary)){
    Link_ratios$PointsSize                <- 3
    Link_ratios$PointsColor               <- 'conserves'
    Link_ratios$PointsShape               <- 'disque'
  }
  if(length(m)==0){
    Link_ratios$PointsSize                <- 3
    Link_ratios$PointsColor               <- 'conserves'
    Link_ratios$PointsShape               <- 'disque'
  }
  
  if(is.null(m)){
    Link_ratios$PointsSize                <- 3
    Link_ratios$PointsColor               <- 'conserves'
    Link_ratios$PointsShape               <- 'disque'
  }
  
  
  #Adouci <- as.data.frame(spline(Triangle$origin,Triangle$LR))
  Link_ratios$Jugement_Expert <- ifelse(Link_ratios$PointsSize==3,4,2)
  
  print(names(Link_ratios))
  #Triangle$value <- Triangle$value-min(Triangle$value)+1000
  names(Link_ratios) <- c("Montant", "Annee", "Link_ratio", "PointsSize", "PointsColor", "PointsShape", "Jugement_Expert")
  # print(names(Triangle))
  # print(summary(Triangle))
  # print(Triangle)
  
  ## Rescaling du second axe
  a <-lm(c(min(Link_ratios$Montant), max(Link_ratios$Montant)) ~ c(min(Link_ratios$Link_ratio), max(Link_ratios$Link_ratio)))$coefficients[2]
  b <-lm(c(min(Link_ratios$Montant), max(Link_ratios$Montant)) ~ c(min(Link_ratios$Link_ratio), max(Link_ratios$Link_ratio)))$coefficients[1]
  
  # g <- ggplotly(ggplot(Link_ratios)+
  #                 geom_line(aes(x=origin,y=LR))+
  #                 geom_point(aes(x=origin,y=LR, size=PointsSize,color=PointsColor))+
  #                 theme_minimal()+theme(legend.position = "none") +
  #                 scale_color_manual("",
  #                                    breaks=c('grey','red'),
  #                                    values=c('#f0c300','darkred')) + 
  #                 geom_abline(slope=0,intercept=Mean_unselected,color='#f0c300',linetype='dashed') + 
  #                 xlab('Années de survenance') + 
  #                 ylab('Link ratios')
  # )
  # return(g)
  
  ay <- list(
    tickfont = list(size=11.7),
    titlefont=list(size=14.6),
    overlaying = "y",
    showline = FALSE,
    side = "right",
    title = "Montants",
    tickcolor='#000',
    position=0.97
  )
  
  # saveRDS(Link_ratios, "Link_ratios.rds")
  # saveRDS(Link_ratios, "~/1_RD/Code/triangle.tlbx/Link_ratios.rds")
  g <- ggplotly(ggplot(Link_ratios,aes(x = Annee, y = Link_ratio)) + 
                  geom_segment(Link_ratios, mapping = aes(x = Annee, 
                                                          y = min(Link_ratios$Link_ratio), 
                                                          xend = Annee, 
                                                          yend = (Montant - b) / a,
                                                          color = PointsColor, 
                                                          alpha = Jugement_Expert), size = 6) +
                  geom_point(aes(size = Montant, 
                                 color = PointsColor, 
                                 shape = PointsShape, 
                                 alpha = PointsSize)) + 
                  
                  geom_abline(slope = 0,
                              intercept = Mean_unselected,
                              color = 'gray',
                              linetype = 'dashed') +
                  
                  geom_abline(slope = 0, 
                              intercept = Mean_Claims, 
                              color = '#f0c300',
                              linetype = 'dotted') +
                  
                  scale_y_continuous('Link ratios',
                                     sec.axis = sec_axis(~ . * a + b, 
                                                         name = 'Montants'),
                                     limits = c(min(Link_ratios$Link_ratio),
                                                max(Link_ratios$Link_ratio))) +
                  # scale_x_continuous('Années de survenance', breaks = as.numeric(as.character(Link_ratios$Annee)))+
                  
                  theme_minimal() +
                  
                  scale_fill_manual("",
                                    labels = c('elimines','conserves'),
                                    values = c('#f0c300','darkred'))+ 
                  
                  scale_color_manual("Jugement d'expert",
                                     labels = c('elimines','conserves'),
                                     values = c('#f0c300','darkred')) +
                  
                  scale_shape_manual("",
                                     labels = c('raye', 'disque'),
                                     values = c(19, 4), guide = FALSE)+
                  
                  scale_size(guide=FALSE) +
                  
                  theme(legend.position = "bottom"),
                tooltip=c('Annee', 'Link_ratio', 'intercept', 'Montant')) %>%
    
    add_lines(x = ~ Annee, y = ~ Montant, yaxis = "y2",
              data = Link_ratios, showlegend = FALSE, inherit = FALSE, opacity = 0.005) %>% 
    
    layout(yaxis2 = ay,
           legend = list(
             orientation="h", 
             x = 0.4, 
             y = -0.2))
  # saveRDS(g, "~/1_RD/Code/triangle.tlbx/g.rds")
  return(g)
}