R/cvsgraph-histo.R

In INESSSQC/variation: Analyse Coefficient Variation Systématique

#' Distribution des thetaj
#'
#' @import dplyr
#' @import data.table
#' @import ggplot2
#' @import ggrepel
#' @import latex2exp
#'
#' @export
cvsgraph <- function (x,
                      cvs, cvslabel = max(cvs),
                      ci = 0.95,
                      max.ratio = 3,
                      lines = c("solid","twodash","dotted"),
                      limitsY = NULL,
                      point.size = 2,
                      text.size = 2,
                      line.size = 0.6) {

  x <- as.data.table(x)
  x <- x %>%
    select(an, code, descriptif, region, expj, CVS, RTj,
           starts_with("liminf_cvs"),
           starts_with("limsup_cvs")) %>%
    as.data.table()
  x <- melt(x, id.vars = 1:7,
            variable.name = "limites", value.name = "valeur")
  x <- x[!is.na(expj)]

  limits <- x[, c(5,7:9)]
  limits[, cvs := as.numeric(substr(limites, 11, 11))]
  limitslabel <- unique(limits[limites %in% paste0(c("liminf_cvs", "limsup_cvs"),cvslabel)]$valeur)

  x <- x[limites %in% paste0("limsup_cvs",cvslabel), 1:7]
  x[, label := FALSE]
  x[RTj < min(limitslabel), label := TRUE][RTj > max(limitslabel), label := TRUE]


  # Fonctions Graphiques
  insert_minor <- function(major_labs, n_minor){
    labs <- c(sapply(major_labs, function(x) c(x, rep("", 4))))
    labs[1:(length(labs)-n_minor)]
  }
  # Graphique
  ggplot(x, aes(expj, RTj)) +
    # Affichage des points
    geom_point(size = point.size,  # taille
               col = "red") +  # couleur
    # Affichage des régions outliers
    geom_text_repel(label = ifelse(x$label == TRUE, x$region, ""),
                    box.padding = 0.10, # distance du point
                    size = text.size) +  # taille
    # Moyenne de 1
    geom_hline(yintercept = 1, size = 0.2, col = "black", linetype = 1) +
    # Limites
    geom_line(aes(expj, valeur,
                  group = limites,
                  linetype = factor(cvs)),
              data = limits,
              col = "#5792CC",
              size = line.size) +
    scale_linetype_manual(values = lines) +
    # Axes Y et X
    {
      if (is.null(limitsY)) {
        scale_y_continuous(limits = c(ifelse(min(x$RTj) < 0.5 & min(x$RTj) != 0,
                                             min(x$RTj),
                                             0.5),
                                      ifelse(is.null(max.ratio),
                                             (ceiling(max(x$RTj)*10)) / 10,
                                             (ceiling(max(x$RTj[x$RTj <= max.ratio])*10)) / 10)),
                           breaks = seq(0, ceiling(ceiling(max(x$RTj)*10) / 10), by = 0.1),
                           labels = insert_minor(seq(0, ceiling(ceiling(max(x$RTj)*10) / 10), by= 0.5), 4))
      } else {
        scale_y_continuous(limits = c(limitsY[[1]],
                                      {if(limitsY[[2]]<max.ratio) limitsY[[2]] else max.ratio}),
                           breaks = seq(0,ceiling(max.ratio),by=.1),
                           labels = insert_minor(seq(0,ceiling(max.ratio),by=.5),4))
      }
    } +
    scale_x_continuous(limits = c(0, max(x$expj) * 1.01),
                       breaks = function(x, n = 5) pretty(x, n)[pretty(x, n) %% 1 == 0],
                       labels = function(x) x / 1,
                       expand = c(0,0)) +
    # Labels
    labs(title = paste0(unique(x$code)," - ",unique(x$descriptif),
                        " (",unique(x$an)," - ",as.numeric(unique(x$an))+1,")"),
         subtitle = paste("CVS =", format(round(unique(x$CVS), 1), nsmall = 1, decimal.mark = ",")),
         x = "Nombre d'événements attendus",
         y = TeX("$\\hat{\\theta}_{j}$"),
         linetype = paste0("CVS de référence\n(IC",ci*100,"%)")) +
    # Themes
    theme_classic() +
    theme(
      # titre
      plot.title = element_text(hjust = 0.5,  # centré
                                size = 10),  # taille
      plot.subtitle = element_text(hjust = 0.5,  # centré
                                   size = 7,  # taille
                                   colour = "red"),  # couleur
      axis.line.x = element_blank(), #disparition de la ligne des x
      axis.line.y = element_line(size = .3), #grosseur de la ligne de l'axe
      axis.title = element_text(size = 7), #grosseur du titre
      axis.text = element_text(size = 6), #grosseur du texte des axes (labels)
      axis.ticks = element_line(size = .3), #grosseur des tiraits
      legend.position = c(.9,.9), #position de la legende
      legend.title.align = 0, #alignement du titre
      legend.title = element_text(size = 6), #grosseur du titre de la legende
      legend.text = element_text(size = 5), #grosseur du texte dans la legende
      legend.key.size = unit(.5,"lines") #le nombre de ligne entre les elements de la legende
    )

}