R/peuplement_ch.R
In jprenaud-02/coopR: Fonctions R pour la Coop
#' @title Calcul des variable peuplements dans mesure2
#'
#' @description Cette fonction calcule les variables peuplements (Dg, D0, RDI,...) et les modele circonférence-hauteur a partir des differents inventaires dans la table mesure2.
#'
#' @param Mes : table mesure2 issue de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @param Arb_gen : table arbre generalise issu de la fonction arbre_general_ch
#' @param Arb_ech : table des arbres echantillons issue de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @note Trois cas de figure sont possible : renseigner les tables Mes, Arb_gen, auquel cas les donn?es peuplements sont renvoy?es ; renseigner les tables Mes, Arb_ech, auquel cas les donn?es des mod?les circonf?rence-hauteur sont renvoy?es ; renseigner les tables Mes, Arb_gen et Arb_ech, auquel cas les donn?es peuplements et les donn?es des mod?les circonf?rence-hauteur sont renvoy?es.
#' @return peuplement : data.frame au meme format et nombre de lignes que mesure2 mais avec les variables peuplements et les parametres du modele circonference-hauteur.
#'
#' @author Quentin Girard
#' @references Protocole Coop chene...
#
#'
#' @seealso load_xls_to_R_ch, load_bdd_to_R_ch, arbre_general_ch, ci_ht_regression, ci_ht_fonction
#' @examples
#' # A venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export
peuplement_ch <- function(Mes = NULL, Arb_gen = NULL, Arb_ech = NULL) {
# verification des entrees
# V?rification de Mes
if (!is.data.frame(Mes) | NROW(Mes) == 0) {
stop("Mes doit ?tre un data.frame d'au moins une ligne \n")
}
# verification de Arb_gen et Arb_ech
if (is.null(Arb_gen) & is.null(Arb_ech)) {
stop("Il faut renseigner au moins une des deux tables Arb_gen et Arb_ech")
}
# calcul des variables liees a la densite et a la circonference
if (!is.null(Arb_gen)) {
# est-ce bien un data.frame ?
if (!is.data.frame(Arb_gen)) {
stop("Arb_gen doit ?tre un data.frame")
# Manque-t-il des variables ?
} else if (length(setdiff(c("id_unite", "no_mesure", "av_ap_id", "no_inventaire", "essence_id", "effectif", "c130"), names(Arb_gen))) != 0){
cat("Il manque des donn?es dans Arb_gen pour pouvoir calculer les variables dendrom?triques \n")
# Sinon, c'est qu'il y a tout, allons-y...
} else {
# Pour chaque ligne de Mes, calcul des variables de peuplements
for (val in 1:nrow(Mes)) {
# selection des tiges
arbre.tp <- merge(Mes[val,], Arb_gen, by = c("id_unite", "no_mesure", "av_ap_id", "no_inventaire"), all = F)
if (NROW(arbre.tp) != 0) {
# calcul des grandeurs
# toutes essences confondues
Mes[val, "Nha_tot"] <- sum(arbre.tp$effectif * 10000 / arbre.tp$surf_inv)
Mes[val, "Gha_tot"] <- calc_Gha(Circ = arbre.tp$c130, Surf = Mes[val, "surf_inv"], Effectif = arbre.tp$effectif, na.rm = T)
Mes[val, "D0_tot"] <- calc_D0(arbre.tp$c130, arbre.tp$effectif, Mes[val, "surf_inv"], 100)
Mes[val, "Dg_tot"] <- calc_Dg(arbre.tp$c130, effectif = arbre.tp$effectif, na.rm = T)
# taux de chene
Mes[val, "%N_chp"] <- sum((arbre.tp$essence_id == 20) * arbre.tp$effectif) / sum(arbre.tp$effectif)
Mes[val, "%N_chs"] <- sum((arbre.tp$essence_id == 21) * arbre.tp$effectif) / sum(arbre.tp$effectif)
Mes[val, "%N_chx"] <- sum((arbre.tp$essence_id == 22) * arbre.tp$effectif) / sum(arbre.tp$effectif)
Mes[val, "%G_chp"] <- sum((arbre.tp$essence_id == 20) * arbre.tp$effectif * arbre.tp$c130^2) / sum(arbre.tp$effectif * arbre.tp$c130^2)
Mes[val, "%G_chs"] <- sum((arbre.tp$essence_id == 21) * arbre.tp$effectif * arbre.tp$c130^2) / sum(arbre.tp$effectif * arbre.tp$c130^2)
Mes[val, "%G_chx"] <- sum((arbre.tp$essence_id == 22) * arbre.tp$effectif * arbre.tp$c130^2) / sum(arbre.tp$effectif * arbre.tp$c130^2)
# chene seul
arbre.tp <- subset(arbre.tp, essence_id %in% c(20, 21, 22))
Mes[val, "Nha_ch"] <- sum(arbre.tp$effectif * 10000 / arbre.tp$surf_inv)
Mes[val, "Gha_ch"] <- calc_Gha(Circ = arbre.tp$c130, Surf = Mes[val, "surf_inv"], Effectif = arbre.tp$effectif, na.rm = T)
Mes[val, "D0_ch"] <- calc_D0(arbre.tp$c130, arbre.tp$effectif, Mes[val, "surf_inv"], 100)
Mes[val, "D300_ch"] <- calc_D0(arbre.tp$c130, arbre.tp$effectif, Mes[val, "surf_inv"], 300)
Mes[val, "Dg_ch"] <- calc_Dg(arbre.tp$c130, effectif = arbre.tp$effectif, na.rm = T)
rm(arbre.tp)
}
}
cat("Nouvelle variable Nha_tot : nombre de tiges a l'hectare, toutes essences confondues \n")
cat("Nouvelle variable Gha_tot : surface terriere (m2/ha), toutes essences confondues \n")
cat("Nouvelle variable D0_tot : diametre dominant (cm), toutes essences confondues \n")
cat("Nouvelle variable Dg_tot : diametre quadratique moyen (cm), toutes essences confondues \n")
cat("Nouvelle variable %N_chp : Pourcentage de Ch?ne p?doncul? en nombre de tiges par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %N_chs : Pourcentage de Ch?ne sessile en nombre de tiges par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %N_chx : Pourcentage de Ch?ne indetermin? en nombre de tiges par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %G_chp : Pourcentage de Ch?ne p?doncul? en surface terriere par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %G_chs : Pourcentage de Ch?ne sessile en surface terriere par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %G_chx : Pourcentage de Ch?ne indetermin? en surface terriere par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable Nha_ch : nombre de tiges a l'hectare, en ne considerant que les chenes \n")
cat("Nouvelle variable Gha_ch : surface terriere (m2/ha), en ne considerant que les chenes \n")
cat("Nouvelle variable D0_ch : diametre dominant (cm), en ne considerant que les chenes \n")
cat("Nouvelle variable D300_ch : diametre quadratique moyen des 300 plus gros chenes a l'hectare (cm) \n")
cat("Nouvelle variable Dg_ch : diametre quadratique moyen des chenes (cm) \n")
rm(val, Arb_gen)
# autres variables
Mes$RDI_tot <- with(Mes, calc_RDI(N = Nha_tot, Dg = Dg_tot, ess = "CHS", modele = "Dhote"))
Mes$RDI_ch <- with(Mes, calc_RDI(N = Nha_ch, Dg = Dg_ch, ess = "CHS", modele = "Dhote"))
cat("Nouvelle variable RDI_tot : Reineke Density Index, toutes essences confondues \n")
cat("Nouvelle variable RDI_ch : Reineke Density Index, en ne considerant que les chenes \n")
}
}
# calcul de variables liees a la hauteur
if (!is.null(Arb_ech)) {
# est-ce bien un data.frame ?
if (!is.data.frame(Arb_ech)) {
stop("Arb_ech doit ?tre un data.frame")
# Manque-t-il des variables ?
} else if (length(setdiff(c("id_unite", "no_mesure", "c130", "hauteur_ech"), names(Arb_ech))) != 0) {
cat("Il manque des donn?es dans Arb_gen pour pouvoir calculer les variables dendrom?triques \n")
# Sinon, c'est qu'il y a tout, allons-y...
} else {
# Pour chaque campagne, un seul modele circonference-hauteur, calcule une fois.
# NB: en cas de double echantillonnage (bandelette et placette lors d'un changement), tout est reuni pour faire un seul echantillon et un seul modele
modele <- unique(Mes[,c("id_unite", "no_mesure")])
for (val in 1:nrow(modele)) {
# selection des tiges pour la modelisation circnference-hauteur
arbre.ech <- subset(Arb_ech, id_unite == modele[val, "id_unite"] & no_mesure == modele[val, "no_mesure"])
# realisation du modele et stockage
regr <- ci_ht_regression(arbre.ech$c130, arbre.ech$hauteur_ech)
modele[val, "modL"] <- regr$modL
modele[val, "par1"] <- regr$par1
modele[val, "par2"] <- regr$par2
modele[val, "C130.min"] <- regr$C130.min
modele[val, "C130.max"] <- regr$C130.max
modele[val, "nb_echant."] <- regr$effectif
rm(regr, arbre.ech)
}
Mes <- merge(Mes, modele, all.x = T)
cat("Nouvelles variables modL, par1, par2, C130.min, C130.max : parametres du modele Circonference-Hauteur \n")
# variable calcul? grace au mod?le
if ("D0_ch" %in% names(Mes)) {
Mes$H0_ch <- with(Mes, ci_ht_fonction(D0_ch * pi, par1 = par1, par2 = par2, modL = modL))
cat("Nouvelle variable H0_ch : Hauteur dominante peuplement, en ne consid?rant que les ch?nes (cm) \n")
}
if ("Dg_ch" %in% names(Mes)) {
Mes$Hg_ch <- with(Mes, ci_ht_fonction(Dg_ch * pi, par1 = par1, par2 = par2, modL = modL))
cat("Nouvelle variable Hg_ch : Hauteur moyenne du peuplement, en ne considerant que les chenes (cm) \n")
}
if ("Nha_ch" %in% names(Mes) & "H0_ch" %in% names(Mes)) {
Mes$HB_ch <- 100 * 100 * sqrt(10000/(Mes$Nha_ch * 0.866))/Mes$H0_ch
cat("Nouvelle variable HB_ch : Espacement de Hart-Becking (%) en ne consid?rant que les ch?nes \n")
}
}
}
# renvoie des r?sultats
return(Mes)
}
jprenaud-02/coopR documentation built on May 3, 2019, 7:06 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @title Calcul des variable peuplements dans mesure2
#'
#' @description Cette fonction calcule les variables peuplements (Dg, D0, RDI,...) et les modele circonférence-hauteur a partir des differents inventaires dans la table mesure2.
#'
#' @param Mes : table mesure2 issue de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @param Arb_gen : table arbre generalise issu de la fonction arbre_general_ch
#' @param Arb_ech : table des arbres echantillons issue de la fonction load_xls_to_R_ch(format = "R") ou de load_bdd_to_R_ch
#' @note Trois cas de figure sont possible : renseigner les tables Mes, Arb_gen, auquel cas les donn?es peuplements sont renvoy?es ; renseigner les tables Mes, Arb_ech, auquel cas les donn?es des mod?les circonf?rence-hauteur sont renvoy?es ; renseigner les tables Mes, Arb_gen et Arb_ech, auquel cas les donn?es peuplements et les donn?es des mod?les circonf?rence-hauteur sont renvoy?es.
#' @return peuplement : data.frame au meme format et nombre de lignes que mesure2 mais avec les variables peuplements et les parametres du modele circonference-hauteur.
#'
#' @author Quentin Girard
#' @references Protocole Coop chene...
#
#'
#' @seealso load_xls_to_R_ch, load_bdd_to_R_ch, arbre_general_ch, ci_ht_regression, ci_ht_fonction
#' @examples
#' # A venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export
peuplement_ch <- function(Mes = NULL, Arb_gen = NULL, Arb_ech = NULL) {
# verification des entrees
# V?rification de Mes
if (!is.data.frame(Mes) | NROW(Mes) == 0) {
stop("Mes doit ?tre un data.frame d'au moins une ligne \n")
}
# verification de Arb_gen et Arb_ech
if (is.null(Arb_gen) & is.null(Arb_ech)) {
stop("Il faut renseigner au moins une des deux tables Arb_gen et Arb_ech")
}
# calcul des variables liees a la densite et a la circonference
if (!is.null(Arb_gen)) {
# est-ce bien un data.frame ?
if (!is.data.frame(Arb_gen)) {
stop("Arb_gen doit ?tre un data.frame")
# Manque-t-il des variables ?
} else if (length(setdiff(c("id_unite", "no_mesure", "av_ap_id", "no_inventaire", "essence_id", "effectif", "c130"), names(Arb_gen))) != 0){
cat("Il manque des donn?es dans Arb_gen pour pouvoir calculer les variables dendrom?triques \n")
# Sinon, c'est qu'il y a tout, allons-y...
} else {
# Pour chaque ligne de Mes, calcul des variables de peuplements
for (val in 1:nrow(Mes)) {
# selection des tiges
arbre.tp <- merge(Mes[val,], Arb_gen, by = c("id_unite", "no_mesure", "av_ap_id", "no_inventaire"), all = F)
if (NROW(arbre.tp) != 0) {
# calcul des grandeurs
# toutes essences confondues
Mes[val, "Nha_tot"] <- sum(arbre.tp$effectif * 10000 / arbre.tp$surf_inv)
Mes[val, "Gha_tot"] <- calc_Gha(Circ = arbre.tp$c130, Surf = Mes[val, "surf_inv"], Effectif = arbre.tp$effectif, na.rm = T)
Mes[val, "D0_tot"] <- calc_D0(arbre.tp$c130, arbre.tp$effectif, Mes[val, "surf_inv"], 100)
Mes[val, "Dg_tot"] <- calc_Dg(arbre.tp$c130, effectif = arbre.tp$effectif, na.rm = T)
# taux de chene
Mes[val, "%N_chp"] <- sum((arbre.tp$essence_id == 20) * arbre.tp$effectif) / sum(arbre.tp$effectif)
Mes[val, "%N_chs"] <- sum((arbre.tp$essence_id == 21) * arbre.tp$effectif) / sum(arbre.tp$effectif)
Mes[val, "%N_chx"] <- sum((arbre.tp$essence_id == 22) * arbre.tp$effectif) / sum(arbre.tp$effectif)
Mes[val, "%G_chp"] <- sum((arbre.tp$essence_id == 20) * arbre.tp$effectif * arbre.tp$c130^2) / sum(arbre.tp$effectif * arbre.tp$c130^2)
Mes[val, "%G_chs"] <- sum((arbre.tp$essence_id == 21) * arbre.tp$effectif * arbre.tp$c130^2) / sum(arbre.tp$effectif * arbre.tp$c130^2)
Mes[val, "%G_chx"] <- sum((arbre.tp$essence_id == 22) * arbre.tp$effectif * arbre.tp$c130^2) / sum(arbre.tp$effectif * arbre.tp$c130^2)
# chene seul
arbre.tp <- subset(arbre.tp, essence_id %in% c(20, 21, 22))
Mes[val, "Nha_ch"] <- sum(arbre.tp$effectif * 10000 / arbre.tp$surf_inv)
Mes[val, "Gha_ch"] <- calc_Gha(Circ = arbre.tp$c130, Surf = Mes[val, "surf_inv"], Effectif = arbre.tp$effectif, na.rm = T)
Mes[val, "D0_ch"] <- calc_D0(arbre.tp$c130, arbre.tp$effectif, Mes[val, "surf_inv"], 100)
Mes[val, "D300_ch"] <- calc_D0(arbre.tp$c130, arbre.tp$effectif, Mes[val, "surf_inv"], 300)
Mes[val, "Dg_ch"] <- calc_Dg(arbre.tp$c130, effectif = arbre.tp$effectif, na.rm = T)
rm(arbre.tp)
}
}
cat("Nouvelle variable Nha_tot : nombre de tiges a l'hectare, toutes essences confondues \n")
cat("Nouvelle variable Gha_tot : surface terriere (m2/ha), toutes essences confondues \n")
cat("Nouvelle variable D0_tot : diametre dominant (cm), toutes essences confondues \n")
cat("Nouvelle variable Dg_tot : diametre quadratique moyen (cm), toutes essences confondues \n")
cat("Nouvelle variable %N_chp : Pourcentage de Ch?ne p?doncul? en nombre de tiges par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %N_chs : Pourcentage de Ch?ne sessile en nombre de tiges par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %N_chx : Pourcentage de Ch?ne indetermin? en nombre de tiges par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %G_chp : Pourcentage de Ch?ne p?doncul? en surface terriere par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %G_chs : Pourcentage de Ch?ne sessile en surface terriere par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable %G_chx : Pourcentage de Ch?ne indetermin? en surface terriere par rapport ? l'ensemble du peuplement \n")
cat("Nouvelle variable Nha_ch : nombre de tiges a l'hectare, en ne considerant que les chenes \n")
cat("Nouvelle variable Gha_ch : surface terriere (m2/ha), en ne considerant que les chenes \n")
cat("Nouvelle variable D0_ch : diametre dominant (cm), en ne considerant que les chenes \n")
cat("Nouvelle variable D300_ch : diametre quadratique moyen des 300 plus gros chenes a l'hectare (cm) \n")
cat("Nouvelle variable Dg_ch : diametre quadratique moyen des chenes (cm) \n")
rm(val, Arb_gen)
# autres variables
Mes$RDI_tot <- with(Mes, calc_RDI(N = Nha_tot, Dg = Dg_tot, ess = "CHS", modele = "Dhote"))
Mes$RDI_ch <- with(Mes, calc_RDI(N = Nha_ch, Dg = Dg_ch, ess = "CHS", modele = "Dhote"))
cat("Nouvelle variable RDI_tot : Reineke Density Index, toutes essences confondues \n")
cat("Nouvelle variable RDI_ch : Reineke Density Index, en ne considerant que les chenes \n")
}
}
# calcul de variables liees a la hauteur
if (!is.null(Arb_ech)) {
# est-ce bien un data.frame ?
if (!is.data.frame(Arb_ech)) {
stop("Arb_ech doit ?tre un data.frame")
# Manque-t-il des variables ?
} else if (length(setdiff(c("id_unite", "no_mesure", "c130", "hauteur_ech"), names(Arb_ech))) != 0) {
cat("Il manque des donn?es dans Arb_gen pour pouvoir calculer les variables dendrom?triques \n")
# Sinon, c'est qu'il y a tout, allons-y...
} else {
# Pour chaque campagne, un seul modele circonference-hauteur, calcule une fois.
# NB: en cas de double echantillonnage (bandelette et placette lors d'un changement), tout est reuni pour faire un seul echantillon et un seul modele
modele <- unique(Mes[,c("id_unite", "no_mesure")])
for (val in 1:nrow(modele)) {
# selection des tiges pour la modelisation circnference-hauteur
arbre.ech <- subset(Arb_ech, id_unite == modele[val, "id_unite"] & no_mesure == modele[val, "no_mesure"])
# realisation du modele et stockage
regr <- ci_ht_regression(arbre.ech$c130, arbre.ech$hauteur_ech)
modele[val, "modL"] <- regr$modL
modele[val, "par1"] <- regr$par1
modele[val, "par2"] <- regr$par2
modele[val, "C130.min"] <- regr$C130.min
modele[val, "C130.max"] <- regr$C130.max
modele[val, "nb_echant."] <- regr$effectif
rm(regr, arbre.ech)
}
Mes <- merge(Mes, modele, all.x = T)
cat("Nouvelles variables modL, par1, par2, C130.min, C130.max : parametres du modele Circonference-Hauteur \n")
# variable calcul? grace au mod?le
if ("D0_ch" %in% names(Mes)) {
Mes$H0_ch <- with(Mes, ci_ht_fonction(D0_ch * pi, par1 = par1, par2 = par2, modL = modL))
cat("Nouvelle variable H0_ch : Hauteur dominante peuplement, en ne consid?rant que les ch?nes (cm) \n")
}
if ("Dg_ch" %in% names(Mes)) {
Mes$Hg_ch <- with(Mes, ci_ht_fonction(Dg_ch * pi, par1 = par1, par2 = par2, modL = modL))
cat("Nouvelle variable Hg_ch : Hauteur moyenne du peuplement, en ne considerant que les chenes (cm) \n")
}
if ("Nha_ch" %in% names(Mes) & "H0_ch" %in% names(Mes)) {
Mes$HB_ch <- 100 * 100 * sqrt(10000/(Mes$Nha_ch * 0.866))/Mes$H0_ch
cat("Nouvelle variable HB_ch : Espacement de Hart-Becking (%) en ne consid?rant que les ch?nes \n")
}
}
}
# renvoie des r?sultats
return(Mes)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.