coopR: Fonctions R pour la Coop

#' @title  table Intervention
#'
#' @description Cette fonction construit la table des éclaircies et nettoiement avec, quand c'est possible, les caract?ristiques de l'intervention (taux de pr?l?vement en surface terri?re et coefficient d'?claircie, calcul? uniquement pour les ch?nes). Utilise le dernier inventaire realise avant ?claircie et le premier r?alis? apr?s ?claircie (a priori les plus pr?cis). Fonctionne directement avec la table mesure2 issue des fonctions de chargement dans R ou bien avec la table des donn?es peuplement issue de la fonction peuplement_ch.
#'
#' @param Peupl : table issu de la fonction peuplement_ch (format de mesure2 avec les donn?es dendrom?triques). Si on utilise la table de type mesure2 directement, la fonction identifie les p?riodes de croissance sans calcul? les ?volution de grandeur de peuplement.
#' @note Les deux inventaires entourant l'intervention ne sont pas forc?ment fait sur la m?me surface ou avec la m?me technique. Pour pouvoir le visualiser, les surfaces et techniques des inventaires (liste ou classe) avant et apr?s intervention sont laiss?es dans la table de sortie (si toutefois ils sont renseign?s en entr?e).
#' Pour que les arbres d'un inventaire issue de la feuil arb ou inv soit int?gr? ? la table de sortie, il faut que l'inventaire correspondant soit ?galement pr?sent dans la table mes
#' Par ailleurs, il n'y aucun lien qui a ?t? fait avec la table Intervention ? ce stade...
#' @return table des interventions avec ?ventuellement leur caract?ristique.
#' @infos plus d infos a ajouter...
#'
#'
#' @author Quentin Girard
#' @references Protocole Coop chene
#'
#' @seealso  peuplement_ch, load_xls_to_R_ch, load_bdd_to_R_ch, calc_Ke
#' @examples
#' a venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export

intervention_ch <- function(Peupl = NA) {        # table mesure2 ou peuplement
# v?rification des entr?es
  if (is.null(Peupl)) {
    stop("Peupl doit ?tre renseign?")
  } else if (!is.data.frame(Peupl)) {
    stop("Peupl doit ?tre un data.frame")
  } else if (length(setdiff(c("id_unite", "no_mesure", "av_ap_id", "ordre_inv"), names(Peupl))) != 0) {
    stop("Il manque des colonnes dans Peupl (obligatoires: 'id_unite', 'no_mesure', 'av_ap_id', 'ordre_inv')")
  }

  # jonction des inventaire qui se suive : a priori, avec la variable ordre_inv, il suffit de regarder deux num?ros d'inventaire qui se suivent et qui encadre une intervention
  names(Peupl)[which(names(Peupl) == "ordre_inv")] <- "ordre_inv.av"
  Peupl$ordre_inv.ap <- Peupl$ordre_inv + 1
  # table des interventions
  Peupl <- merge(Peupl, Peupl[, -which(names(Peupl) %in% c("ordre_inv.ap", "an_vegetation"))],
               by.x = c("id_unite", "no_mesure", "ordre_inv.ap"),
               by.y = c("id_unite", "no_mesure", "ordre_inv.av"),
               suffixes = c(".av", ".ap"))
  Output <- subset(Peupl, av_ap_id.av == 1 & av_ap_id.ap == 2)
 # Output <- Output[,which(names(Output) %in% c("id_unite",     "no_mesure", "an_vegetation",
 #                                              "ordre_inv.av", "suivi.av",  "surf_inv.av",  "Gha_ch.av", "Nha_ch.av", "Gha_tot.av", "Nha_tot.av",
 #                                              "ordre_inv.ap", "suivi.ap",  "surf_inv.ap",  "Gha_ch.ap", "Nha_ch.ap", "Gha_tot.ap", "Nha_tot.ap"))]

  # calcul des caract?ristiques d'interventions
  if ("Gha_ch.av" %in% names(Output)) {
    Output$tx.prelG_ch <- with(Output, (Gha_ch.av - Gha_ch.ap) / Gha_ch.av)
    cat("Nouvelle variable : tx.prelG_ch est le taux de pr?l?vement en surface terri?re de l'intervention (G_ecl/G_av, uniquement sur le ch?ne) \n")
  }
  if ("Gha_ch.av" %in% names(Output) & "Nha_ch.av" %in% names(Output)) {
    Output$Ke_ch       <- with(Output, calc_Ke(N.i = Nha_ch.av, G.i = Gha_ch.av, N.f = Nha_ch.ap, G.f = Gha_ch.ap))
    cat("Nouvelle variable : Ke_ch est le coefficient d'?claircie de l'intervention (Dg tiges ?claircie/Dg avant intervention, uniquement sur le ch?ne) \n")
  }
  if ("Gha_tot.av" %in% names(Output)) {
    Output$tx.prelG_tot <- with(Output, (Gha_tot.av - Gha_tot.ap) / Gha_tot.av)
    cat("Nouvelle variable : tx.prelG_tot est le taux de pr?l?vement en surface terri?re de l'intervention (G_ecl/G_av, toutes essences confondues) \n")
  }
  if ("Gha_tot.av" %in% names(Output) & "Nha_tot.av" %in% names(Output)) {
    Output$Ke_tot       <- with(Output, calc_Ke(N.i = Nha_tot.av, G.i = Gha_tot.av, N.f = Nha_tot.ap, G.f = Gha_tot.ap))
    cat("Nouvelle variable : Ke_tot est le coefficient d'?claircie de l'intervention (Dg tiges ?claircie/Dg avant intervention, toutes essences confondues) \n")
  }

  # variable conserv?es ? la sortie
  Output <- Output[,which(names(Output) %in% c("id_unite",     "no_mesure", "an_vegetation",
                                               "ordre_inv.av", "suivi.av",  "surf_inv.av", "suivi.ap",  "surf_inv.ap",
                                               "tx.prelG_ch", "Ke_ch", "tx.prelG_tot", "Ke_tot"))]
  return(Output)
}