coopR: Fonctions R pour la Coop

#' @title  Graphe des ages des placettes Coop etudiees
#'
#' @description Cette fonction realise un graphe representant la gamme d'age sur lequel l'essai a ete suivi ainsi que l'age lors de la realisation des inventaires. Fonctionne avec le couple (Placette, Mesure) type fichier excel et le couple (unite, mesure) du chargement destine au calcul.
#'
#' @param plac : unite = table unite de la Coop dans la forme une ligne par unite (sortie 'unite' de la fonction load_xls_to_R_ch(format = "R") et de load_bdd_to_R_ch ou bien sortie 'Placette' de la fonction load_xls_to_R_ch(format = "xls") et de load_bdd_to_xls_ch)
#' @param mes : table mesure de la Coop dans la forme une ligne par unite*mesure (sortie 'mesure' de la fonction load_xls_to_R_ch(format = "R") et de load_bdd_to_R_ch ou bien sortie 'Mesure' de la fonction load_xls_to_R_ch(format = "xls") et de load_bdd_to_xls_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'age couvert par les mesures pour chaque placette.
#'
#' @author Quentin Girard
#' @references Protocole Coop chene... document d Ingrid et Claudine

#'
#' @seealso  load_xls_to_R_ch, load_bdd_to_R_ch, load_bdd_to_xls_ch
#' @examples
#' a venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export
#' @importFrom ggplot2 ggplot


graph_age_ch <- function(plac = NA, mes = NA, theme_coop = theme_bw()) {
# passage des noms de colonnes du format 'xls' au nom du format 'R'
  if (!"id_unite" %in% names(plac)) {
    plac$id_unite <- plac$id_placette
    mes$id_unite <- mes$id_placette
  }
  if (!"age" %in% names(mes)) {
    mes <- merge(mes, plac[,c("id_unite", "age_installation", "an_deb_obs", "mois_deb_obs_id")])
    mes$age  <- mes$age_installation + mes$an_vegetation - calc_veg(mes$an_deb_obs, mes$mois_deb_obs_id)
  }
# donnees complementaires
  mes <- merge(mes, plac[, c("id_unite", "essence_principale1_id", "co_traitement", "lib_disp")])
  mes$action <- ifelse(mes$no_mesure == 1, "Installation", "Mesure")
# Y a-t-il eu cloture ? que si avec Placette et Mesure
  if ("an_arret_mesure" %in% names(plac)) {
    if (sum(!is.na(plac[,"an_arret_mesure"])) != 0) {
      clot <- subset(plac, !is.na(an_arret_mesure))
      clot$age <- calc_veg(clot$an_arret_mesure, clot$mois_arret_mesure_id) - calc_veg(clot$an_deb_obs, clot$mois_deb_obs_id) + clot$age_installation
      clot$action <- "Arret des mesures"
      mes <- rbind(mes[,c("id_unite", "age", "action", "essence_principale1_id", "co_traitement", "lib_disp")],
                   clot[,c("id_unite", "age", "action", "essence_principale1_id", "co_traitement", "lib_disp")])
    }
  }
# ordre des placettes sur l'axe y
  tp <- merge(subset(mes, action == "Installation"),
              summaryBy(age ~ lib_disp, subset(mes, action == "Installation"), FUN = mean))                  ### doBy
  tp <- tp[order(tp$age.mean, tp$lib_disp, tp$age),]
  tp$ordre <- c(1:nrow(tp))
  mes <- merge(mes, tp[,c("id_unite", "ordre")], all = T)
  mes$sous_unite <- "Placette"
    mes[grep("sp", mes$id_unite), "sous_unite"] <- "Sous-placette"
  tp5 <- summaryBy(ordre ~ lib_disp, mes, FUN = function(x) range(x))
  rm(tp)

# graphe
  g <- ggplot(mes) +
    aes(x = age, y = ordre, col = as.factor(essence_principale1_id)) +   # pas de unite
    # donnees age
    geom_line(aes(group = id_unite, linetype = sous_unite)) +
    geom_point(aes(shape = action)) +
    # dispositif
    geom_abline(data = tp5, aes(slope = 0, intercept = ordre.FUN1-0.5), col = "grey") +
    geom_abline(data = tp5, aes(slope = 0, intercept = ordre.FUN2+0.5), col = "grey35") +
    geom_text(data = tp5, aes(y = (ordre.FUN1 + ordre.FUN2)/2, label = lib_disp), x = min(mes$age) - 1, hjust = 1, col = "black", size = 4) +
    # echelle graphique
    scale_y_discrete(breaks = mes$ordre, labels = mes$id_unite, name = "Placette ou Unite de suivi") +
    scale_linetype_manual(values = c("Placette" = "solid", "Sous-placette" = "dashed"), name = "Type d'unite de suivi") +
    scale_shape_manual(values = c("Arret des mesures" = 4, "Installation" = 16, "Mesure" = 1), name = "Action realisee") +
    scale_colour_manual(values = c("20" = "blue", "21" = "forestgreen", "22" = "red"),
                        labels = c("20" = "...pedoncule", "21" = "...sessile", "22" = "...melangees"), name = "Chene...") +
    scale_x_continuous(limits = c(0, max(mes$age)+2)) +
    # mise en page
    theme_coop +
    labs(x= "Age", col = "Dispositif") +
    ggtitle(label = paste("Gamme d'age couvert par les placettes Coop Chene",
                          ifelse("existence_ss_unite" %in% names(plac) & sum(plac$existence_ss_unite) != 0, "(sous-placette nom renseignees)",
                          ifelse(!"an_arret_mesure" %in% names(plac), "(arret des mesures non renseignee)",""))))
  print(g)
}