#'
#' @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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.