R/graph_modele_ch.R

In jprenaud-02/coopR: Fonctions R pour la Coop

#' @title Graphe des modeles circonferences hauteurs
#'
#' @description Cette fonction realise un graphe qui presente la regression Circonference-Hauteur
#'
#' @param peupl : table issue de la fonction peuplement_ch avec les donnees dendrometriques calculees.
#' @param arb : table arbre_echantillon issu de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_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 graphe presentant les modeles circonference-hauteur
#'
#' @author Quentin Girard
#' @references Protocole Coop chene... document d Ingrid et Claudine
#'
#' @seealso  graph_age_ch
#' @examples
#' a venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export
#' @importFrom ggplot2 ggplot

graph_ci_ht_ch <- function(plac = NULL,  peupl = NULL,  arb = NULL, theme_coop = theme_bw()) {
  par(ask = T)
# verification
  if (is.null(plac)) {
    stop("La table decrivant les unites de suivis (table 'unite') est indispensable")
  }
  if (is.null(peupl) | length(setdiff(c("modL", "par1", "par2", "C130.min", "C130.max"), names(peupl))) != 0) {  # pas de table ou donnees manquante: on ne fait que les nuages de points
    stop("Il n'y a pas les parametres des modeles")
  }
  if (is.null(arb) | length(setdiff(c("c130", "hauteur_ech"), names(arb))) != 0) {  # pas de table ou donnees manquante: on ne fait que les nuages de points
    stop("Il n'y a pas les donnees arbres echantillons")
  }
# Preparation des tables
  peupl <- unique(peupl[,c("id_unite", "no_mesure", "an_vegetation", "modL", "par1", "par2", "C130.min","C130.max")])
  peupl <- merge(peupl, plac[,c("id_unite", "pl_sp", "co_traitement", "essence_principale1_id", "lib_disp")])
  arb   <- merge(subset(arb, essence_id %in% c(20,21,22)),
                 peupl[,c("id_unite", "pl_sp", "co_traitement", "essence_principale1_id", "lib_disp", "no_mesure", "an_vegetation")])

  # pour chaque site, pris un par un...
  for (val in unique(plac$lib_disp)) {
    # parametre des modeles
    tp0 <- subset(peupl,lib_disp == val)
    # arbre echantillons ayant servi ? leur realisation
    tp1 <- subset(arb,lib_disp == val)
    # trace de chaque courbe
    tp2 <- merge(tp0, data.frame(c130 = c(0:50)/50))
      tp2$c130 <- with(tp2, C130.min + c130 * (C130.max - C130.min))
      tp2$hauteur_ech <- with(tp2, ci_ht_fonction(Circ = c130, par1 = par1, par2 = par2, modL = modL))

    # graphique
    g <- ggplot(tp1) +
      aes(x = c130, y = hauteur_ech) +
      geom_point(aes(shape = pl_sp, col = as.factor(essence_id)), size = 2) +
      geom_line(data = tp2, aes(group = pl_sp, linetype = pl_sp), size = 1.2) +
      facet_grid(an_vegetation~co_traitement) +
      scale_colour_manual(values = c("20" = "blue", "21" = "forestgreen", "22" = "red"),
                          labels = c("20" = "...pedoncule", "21" = "...sessile", "22" = "...indetermine"), name = "Chene...") +
      scale_shape_manual(values = c("pl" = 16, "sp" = 1), labels = c("pl" = "Placette", "sp" = "Sous-placette"), name = "Unite de suivi") +
      scale_linetype_manual(values = c("pl" = "solid", "sp"="dashed"), labels = c("pl"="Placette", "sp"="Sous-placette"), name = "Unite de suivi") +
      theme_coop +
      labs(x = "Circonference (cm)", y = "Hauteur totale (cm)", colour = "code essence",
           linetype = "unite de suivi", shape = "unite de suivi") +
      ggtitle(label = val)
    print(g)
    rm(tp1, g, tp0, tp2)
  }
  par(ask = F)
}