coopR: Fonctions R pour la Coop

#' @title Graphe des grandeurs dendrom?triques
#'
#' @description Cette fonction r?alise un graphe qui pr?sente l'?volution des variables dendrom?trique de peuplement en fonction de l'?ge ou de la hauteur dominante
#'
#' @param x : variables des abscisses du graphes, peut ?tre ?gale ? "age" ou "Ho"
#' @param y : variables des abscisses, peut ?tre ?gale ? "RDI", "Ho", "Do100", "Do300", ... ou toute autre variable num?rique de la table mes
#' @param couleur : variable des couleurs, ?gale ? "lib_disp", "co_traitement" ou "essence_principale1_id" ou toute autre variable factorielle de la table plac
#' @param mes : table contenant les moyennes de peuplement , sortie de peuplement_ch.
#' @param plac : table unite issu de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @param theme_coop : liste des paramètres graphiques de ggplot, ? remplir avec la fonction theme(). Par d?faut, theme_bw().
#' @return graphique de l'?volution des variables par placette
#'
#' @author Quentin Girard
#' @references Protocole Coop chene
#'
#' @seealso  load_xls_to_R_ch, load_bdd_to_R_ch, peuplement_ch
#' @examples
#' a venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export
#' @importFrom ggplot2 ggplot


graph_evolution_ch <- function(x  = "age", y  = "RDI_ch", couleur = "lib_disp", mes = NULL, plac   = NULL, theme_coop = theme_bw()) {
# v?rification de mes et plac
  if (is.null(mes)) {
    stop("mes doit ?tre renseign?. Il s'agit de la table issue de la fonction peuplement_ch")
  }
  if (is.null(plac)) {
    stop("plac doit ?tre renseign?. Il s'agit des tables de type 'unite' issues des fonction de chargement au format R")
  }
# variables
  tp     <- merge(mes, plac, by = "id_unite")
  if (length(setdiff(c(x, y, couleur), names(tp))) != 0) {
     stop("L'une des variables que vous voulez presenter dans le graphe n'est pas presente dans les tables. Verifiez")
  }
  if (length(setdiff(c("pl_sp"), names(tp))) != 0) {
     stop("Il manque la nature de l'unite de suivi (pl_sp) dans les tables. Verifiez")
  }
  tp$x   <- tp[,x]
  tp$y   <- tp[,y]
  tp$couleur <- as.character(tp[,couleur])
#ordre des mesures
  tp <- tp[with(tp, order(id_unite, no_mesure, av_ap_id, no_inventaire)),]
  tp$ordre <- 1:nrow(tp)

# etendue de la fenetre graphique (en elargissant de 10% sur les cotes
  range_x <- range(tp$x, na.rm = T)
    range_x <- range_x + (range_x[2] - range_x[1])* c(-1, 1) /10
  range_y <- range(tp$y, na.rm = T)
    range_y <- range_y + (range_y[2] - range_y[1])* c(-1, 1) /10

# reference graphique: couleur utilis?e pour les graphes
  list_couleur_RDI <- c("RDI 0" = "black", "RDI 0.25" = "purple", "RDI 0.5" = "orange", "RDI 1" = "red",
                        "RDI croissant" = "blue", "RDI decroissant" = "chocolate", "Detourage" = "forestgreen")
  # les r?f?rences (sc?nario, RDI, courbe de croissance, ...)
  if (y %in% c("RDI_ch", "RDI_tot") & x == "age") {
    list_reference <- list(geom_ribbon(data = scenario.ch, aes(x=Age, ymin=b_inf, ymax=b_sup, fill=Scen), alpha=0.3),
                           scale_fill_manual(values = list_couleur_RDI, name = "Scenario"))
  } else if (y %in% c("H0_ch", "H0_tot") & x == "age") {
    list_reference <- list()  # a terme, des croubes de croissances en hauteur
  } else {
    list_reference <- list()
  }
  # les choix des couleurs des courbes et points
  if (couleur == "co_traitement") {
    list_reference2 <- scale_colour_manual(values = list_couleur_RDI, name = "Scenario")
  } else if (length(unique(tp[,couleur])) <= 7) {
    list_reference2 <- scale_colour_manual(values = c("forestgreen","red","blue","black","purple","orange","chocolate"), name = couleur)
  } else {
    list_reference2 <- list()
  }

# graphe
  g <- ggplot(tp) +
    list_reference +
    geom_path(aes(x = x, y = y, colour = couleur, group = id_unite, order = ordre, linetype = pl_sp)) +
    geom_point(aes(x = x, y = y, colour = couleur, shape = pl_sp)) +
    # echelle graphique
    scale_shape_manual(values = c("pl" = 16, "sp" = 1), labels = c("pl" = "Placette", "sp" = "Sous-placette"), name = "Sous-unite") +
    scale_linetype_manual(values = c("pl" = "solid", "sp" = "dashed"), labels = c("pl" = "Placette", "sp" = "Sous-placette"), name = "Sous-unite")+
    list_reference2 +
    theme_coop +
    coord_cartesian(xlim = range_x, ylim = range_y) +
    ggtitle(label = paste("Evolution de", y, "en fonction de", x))  +
    labs(x= x, y= y, colour = couleur)
  print(g)
}