R/arbre_general_ch.R

#'
#' @title Table arbre-generalise
#' 
#' @description Cette fonction construit la table arbre-generalise dans laquelle une classe de circonference est toujours reliee a un effectif (si suivi par liste, regroupement des meme circonference par classe ou bien effectif = 1) et ou une ligne ne correspond qu'a un seul inventaire (si suivi par liste, duplication des lignes en cas de tiges notes comme eclaircie).
#'
#' @details
#' # A venir
#' @param arb : table arbre issu de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @param inv : inventaire_somme = table inventaire_somme issu de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @param mes : table mesure2 issu de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch 
#'
#' @return arbre.general : table presentee a la maniere d'une liste d'inventaire par classe
#'
#' @author Quentin Girard
#' @keywords function
#' @rdname arbre_general_ch
#' @aliases arbre_general_ch
#'
#' @examples
#' # A venir
#' 
#' @references 
#' # A venir
# 
#' @seealso load_xls_to_R_ch, load_bdd_to_R_ch
#
#' @family load
#' @keywords function
#' @export

arbre_general_ch <- function(mes = NULL, arb = NULL, inv = NULL) { 
# garde fou : verification de la table mes
  if (!(is.null(mes) | is.data.frame(mes)) | !(is.null(arb) | is.data.frame(arb)) | !(is.null(inv) | is.data.frame(inv))) {     
    stop("mes, arb et inv doivent  tre des data.frame ou bien NULL \n")         
  } 
  if (NROW(mes) == 0) {
    stop("La table 'mes' doit contenir au moins une ligne")
  } else if (length(setdiff(c("id_unite", "no_mesure", "av_ap_id", "no_inventaire", "suivi"), names(mes))) != 0) {        
    stop("Il manque une colonne dans la table table 'mes' (colonnes obligatoires : 'id_unite', 'no_mesure', 'av_ap_id', 'no_inventaire', 'suivi' \n")
  }
  mes <- mes[,c("id_unite", "no_mesure", "av_ap_id", "no_inventaire", "suivi")] 
  
# arbre suivi sur liste (si arb = NULL, reste NULL)     
  if (!is.null(arb)) {
    if (length(setdiff(c("id_unite","no_mesure","essence_id","eclairci_realise_id","c130","co_ech","etat_san_id","statut_av_id"), names(arb))) != 0) {
      stop("Il manque une colonne dans la table table 'arb' (colonnes obligatoires : 'id_unite', 'no_mesure', 'essence_id', 'eclairci_realise_id', 'c130', 'co_ech', 'etat_san_id', 'statut_av_id' \n")
    }                                                          
    arb <- arb[,c("id_unite", "no_mesure", "essence_id", "eclairci_realise_id", "c130","co_ech","etat_san_id","statut_av_id")]
    # on joint chaque ligne de mesure2 les arbres qui y seront associe (en dupliquant les tiges en cas d'eclaircie si besoin) 
    arb <- merge(subset(mes, suivi == "liste"), arb, all = F)
    # Dans les cas d'inventaire apres eclairci, on retire les tiges eclaircies. Puis, on retire l'indicateur d'eclaircie
    arb <- subset(arb, !(av_ap_id == 2 & eclairci_realise_id == 1))
    # arbre qui soit vivant, et qui appartiennent a l'etage principal
    arb  <- subset(arb, co_ech %in% c(0,1,2,3) & etat_san_id %in% c(-1,0,1,2) & statut_av_id != 4)
    # on rend la table equivalente e une table d'inventaire en ajountant une colonne effectif (=1) (peut se faire avec summaryBy mais necessite doBy
    arb$effectif <- rep(1, nrow(arb))   
    # colonne n cessaire   la fin                                                                                                    
    arb[,c("id_unite", "no_mesure", "av_ap_id", "no_inventaire", "essence_id", "c130", "effectif")]  
    # regroupement des tiges de m me inventaire, essence et dimension
    if (nrow(arb) != 0) {
      arb <- summaryBy(effectif ~ id_unite + no_mesure + av_ap_id + no_inventaire + essence_id + c130, arb, FUN = sum, keep.names = T)
    }
  }          


# inventaire par classe (si inv = NULL, reste NULL)  : deja pret avec la table somme_inventaire     
  if (!is.null(inv)) {
    if (length(setdiff(c("id_unite", "no_mesure", "av_ap_id", "no_inventaire","essence_id", "effectif", "c130"), names(inv))) != 0) {        
      stop("Il manque une colonne dans la table table 'inv' (colonnes obligatoires : 'id_unite', 'no_mesure', 'av_ap_id', 'no_inventaire', 'essence_id', 'effectif', 'c130' \n")
    }
    inv <- inv[,c("id_unite", "no_mesure", "av_ap_id", "no_inventaire","essence_id", "effectif", "c130")]  
    inv <- merge(subset(mes, suivi == "classe"), inv, all = F)                                           
    inv <- inv[,c("id_unite", "no_mesure", "av_ap_id", "no_inventaire", "essence_id", "c130", "effectif")]
  }
  
# cumul des deux tables
  arbre.gen <- rbind(arb, inv)
  return(arbre.gen)
}

       
jprenaud-02/coopR documentation built on May 3, 2019, 7:06 p.m.