#' Coefficients de variation du Gha et par essence sur une region SER donnee
#'
#' #' @description La fonction renvoie des coefficients de variation sur la surface terriere
#' en utilisant la base de donnees arbres de l'IFN.
#' La fonction necessite en entree un shape correspondant au perimetre retenu : forĂȘt, massif,
#' sylvoecoregion, etc.
#'
#' @param enreg = FALSE par defaut, n'enregistre pas le tableau resultat
#' @param fichier = nom du fichier (chemin du repertoire compris) de la zone sur laquelle est calcule le tableau resultat
#' @param annee = c(2005:2016) par defaut, vecteur indiquant les donnees IGN servant au calcul du tableau resultat
#' @param periode = NULL par defaut, couvre donc l'ensemble de la periode du vecteur annee, si 1 alors tableau resultat calcule annee par annee
#' @param tailleBuffer = 450 par defaut (450m), distance au-dela de la zone calculee sur laquelle les points des placettes IGN sont pris
#' @param tableau = 1 par defaut, renvoi un tableau des coefficients de variation sur la surface terriere totale, par essence et categorie de
#' diametre regroupee (PER, PB, BM, GB), si 2 renvoi un tableau des coefficients de variation sur la surface terriere par essence et par periode,
#' si 3 renvoi un tableau des coefficients de variation sur la surface terriere par essence, par periode et classe de diametre
#'
#' @return La fonction renvoie un tableau des coefficients de variation sur la surface terriere
#' \itemize{
#' \item des essences contribuant a plus de 10\% de la surface terriere
#' \item des PER, PB, BM et GB
#' \item des gros bois des 2 essences contribuant le plus a la surface terriere
#' \item des essences par periode annuelle regroupee des donnees IGN
#' \item des essences par periode annuelle regroupee des donnees IGN
#' }
#'
#' @export CvIFNSER
#'
#' @author Pascal Obstetar
#'
#' @examples
#' \dontrun{
#' CvIFNSER(fichier = '~/frt_test.shp', enreg = F, tableau = 1)
#' CvIFNSER(fichier = '~/frt_test.shp', enreg = F, tableau = 2)
#' CvIFNSER(fichier = '~/frt_test.shp', enreg = F, tableau = 3)
#' CvIFNSER(fichier = '~/frt_test.shp', enreg = F, tableau = 2, periode=6)
#' CvIFNSER(fichier = '~/ec21.shp', enreg = F, tableau = 3, periode=6)
#' }
#'
CvIFNSER <- function(fichier = NULL, annee = c(2005:2016), periode = NULL, tailleBuffer = 450, enreg = F, tableau = 1) {
if (is.null(fichier)) {
stop("Your fichier is NULL!")
}
if (file.access(fichier) == -1) {
stop(paste("You have no access to file:", fichier))
}
vecteur_annee <- annee
periode <- dplyr::if_else(is.null(periode), max(annee) - min(annee) + 1, periode)
donnees <- system.file("extdata/IFN", package = "gftools")
CodesEssIFN <- gftools::getData("IFNCODE") %>% dplyr::filter(donnee %in% "ESPAR")
# Extract placettes et arbres
message("Extract data placettes...")
plac <- data.frame()
for (i in 1:length(vecteur_annee)) {
yrs <- as.numeric(vecteur_annee[i])
ifn <- gftools::getFich_IFN(obj = c("Pla"), Peup = FALSE, Morts = FALSE, Doc = TRUE, ans = yrs, doss = donnees)
placet <- data.frame(yrs = yrs, ifn$Pla[[1]][, c("idp", "ser", "xl93", "yl93")])
plac <- rbind(plac, placet)
}
message("Extract data arbres...")
arb <- data.frame()
for (i in 1:length(vecteur_annee)) {
yrs <- as.numeric(vecteur_annee[i])
ifn <- gftools::getFich_IFN(obj = c("Arb"), Peup = FALSE, Morts = FALSE, Doc = TRUE, ans = yrs, doss = donnees)
arbre <- data.frame(yrs = yrs, ifn$Arb[[1]][, c("idp", "espar", "c13", "w")])
arb <- rbind(arb, arbre)
}
ser <- sf::st_read(system.file("extdata/shapes/SER/ser_l93.shp", package = "gftools"), quiet = TRUE)
perimetre <- sf::st_read(fichier, quiet = TRUE)
perimetre <- sf::st_transform(perimetre, crs = 2154)
ser <- sf::st_transform(ser, crs = 2154)
perimetre <- sf::st_union(perimetre)
zone <- sf::st_buffer(perimetre, dist = tailleBuffer)
placettes <- sf::st_intersection(sf::st_as_sf(plac, coords = c("xl93", "yl93"), crs = 2154, agr = "constant"), zone)
## Au niveau arbre
suppressWarnings(
suppressMessages(
Gha <- arb %>%
dplyr::filter(idp %in% placettes$idp) %>%
dplyr::filter(!is.na(w)) %>%
dplyr::mutate(Diam = round(c13 / pi, 0)) %>%
dplyr::mutate(Classe = floor(c13 / pi / 5 + 0.5) * 5) %>%
dplyr::mutate(Gha = pi / 40000 * Diam ^ 2 * as.numeric(w)) %>%
dplyr::mutate(Population = 1 + (yrs - min(yrs)) %/% periode) %>%
dplyr::mutate(Periode = paste(min(arb$yrs) + (Population - 1) * periode, min(arb$yrs) + (Population * periode) - 1, sep = " - ")) %>%
dplyr::left_join(CodesEssIFN[, 2:3], by = c(espar = "code"))
)
)
## Au niveau placette (idp)
suppressWarnings(
suppressMessages(
GhaPla <- Gha %>%
dplyr::group_by(idp) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::group_by(vars) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE)) %>%
dplyr::ungroup() %>%
tibble::add_column(.before = 1, libelle = "Totale")
)
)
tab <- GhaPla
nidp <- tab$n
## Au niveau placette (idp) par periode
suppressWarnings(
suppressMessages(
GhaPlaPer <- Gha %>%
dplyr::group_by(idp, Periode) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::group_by(Periode) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE))
)
)
tabp <- GhaPlaPer
np <- tabp$n
## Au niveau essence
suppressWarnings(
suppressMessages(
GhaEss <- Gha %>%
dplyr::group_by(idp, libelle) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::transmute(sum = sum / nidp) %>%
dplyr::group_by(libelle) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE)) %>%
dplyr::arrange(desc(sum)) %>%
dplyr::ungroup()
)
)
ListeEssPrinc <- GhaEss$libelle
tab <- rbind(tab, GhaEss)
## Au niveau essence par categorie de diametre regroupee
suppressWarnings(
suppressMessages(
GhaEssCat <- Gha %>%
dplyr::mutate(Cat = cut(Classe, breaks = c(0, 17.5, 27.5, 47.5, 200), labels = c("PER", "PB", "BM", "GB"))) %>%
dplyr::group_by(idp, Cat) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::transmute(sum = sum / nidp) %>%
dplyr::group_by(Cat) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE)) %>%
dplyr::rename(libelle = Cat) %>%
dplyr::ungroup()
)
)
tab <- rbind(tab, GhaEssCat)
## Au niveau des 2 essences principales par GB+BM
suppressWarnings(
suppressMessages(
GhaEssCat2 <- Gha %>%
dplyr::mutate(Cat = cut(Classe, breaks = c(0, 17.5, 27.5, 47.5, 200), labels = c("PER", "PB", "BM", "GB"))) %>%
dplyr::filter(libelle %in% ListeEssPrinc[1:2] & (Cat == "GB" | Cat == "BM")) %>%
dplyr::group_by(idp, libelle, Cat) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::transmute(sum = sum / nidp) %>%
dplyr::group_by(libelle) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE)) %>%
dplyr::ungroup() %>%
dplyr::mutate(libelle = paste(libelle, "GB + BM")) %>%
dplyr::arrange(desc(sum))
)
)
tab <- rbind(tab, GhaEssCat2)
if (tableau == 1) {
out <- list(tab)
names(out) <- c("Tableau1")
if (enreg) {
readr::write_excel_csv(tab, paste0(dirname(fichier), "/tab1CvIGNSER.csv"))
message(paste0("Result is saved in: ", paste0(dirname(fichier), "/tab1CvIGNSER.csv")))
}
}
if (tableau == 2) {
## Au niveau placette (idp) par periode et par essence
suppressWarnings(
suppressMessages(
GhaPlaPerEss <- Gha %>%
dplyr::group_by(idp, libelle, Periode) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::transmute(sum = sum / nidp) %>%
dplyr::group_by(Periode, libelle) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE)) %>%
dplyr::ungroup() %>%
dplyr::arrange(libelle, Periode)
)
)
out <- list(GhaPlaPerEss)
names(out) <- c("Tableau2")
if (enreg) {
readr::write_excel_csv(GhaPlaPerEss, paste0(dirname(fichier), "/tab2CvIGNSER.csv"))
message(paste0("Result is saved in: ", paste0(dirname(fichier), "/tab2CvIGNSER.csv")))
}
}
if (tableau == 3) {
## Au niveau placette (idp) par periode, par essence et par Classe
suppressWarnings(
suppressMessages(
GhaEssPerEssCla <- Gha %>%
dplyr::group_by(idp, libelle, Periode, Classe) %>%
dplyr::do(gftools::describe(.$Gha, fast = TRUE)) %>%
dplyr::transmute(sum = sum / nidp) %>%
dplyr::group_by(Periode, libelle, Classe) %>%
dplyr::do(gftools::describe(.$sum, fast = TRUE)) %>%
dplyr::ungroup() %>%
dplyr::arrange(libelle, Periode)
)
)
out <- list(GhaEssPerEssCla)
names(out) <- c("Tableau3")
if (enreg) {
readr::write_excel_csv(GhaEssPerEssCla, paste0(dirname(fichier), "/tab3CvIGNSER.csv"))
message(paste0("Result is saved in: ", paste0(dirname(fichier), "/tab3CvIGNSER.csv")))
}
}
message("Calculation realized!")
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.