R/calc_Ke.R

In jprenaud-02/coopR: Fonctions R pour la Coop

#' @title  Coefficient d'eclaircie
#'
#' @description Cette fonction calcule le coefficient d'éclaircie d'une intervention (Diamètre quadratique moyen des tiges ?claircie rapport? au diam?tre quadratique moyen du peuplement avant intervention). Peut se calculer de plusieurs façons.
#'
#' @param N.i : vecteur ou scalaire, densité avant intervention(tiges/ha)
#' @param G.i : vecteur ou scalaire, surface terrière avant intervention (m2/ha)
#' @param  N.f : vecteur ou scalaire, densité après intervention (tiges/ha)
#' @param  G.f : vecteur ou scalaire, surface terrière apr?s intervention (m2/ha)
#' @param  Dg.e : vecteur ou scalaire, Dg des tiges éclaircies (cm)
#' @param  Dg.i : vecteur ou scalaire, Dg des tiges avant intervention (cm)
#' @note # il faut que les vecteurs soient de même longueur.
#' Il y a plusieurs possibilit?s de calcul du coefficient d'éclaircie, choisi automatiquement par la fonction, avec par ordre de priorit? :
#' - un calcul à partir de N.i, G.i, N.f, G.f
#' - un calcul à partir de Dg.e, N.i, G.i
#' - un calcul à partir de Dg.e et Dg.i
#' Attention quant à l'utilisation de cette fonction, il n'y a aucune controle de la réalité des valeurs des entrées.
#' @return Coefficient d'éclaircie Ke (Diamètre quadratique moyen des tiges éclaircie rapporté au diamètre quadratique moyen du peuplement avant intervention)
#'
#' @author Quentin Girard
#' @references Protocole Coop chene
#'
#' @seealso
#' @examples
#' a venir
#'
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export


calc_Ke <- function(N.i = NULL, G.i = NULL, N.f = NULL, G.f = NULL, Dg.e = NULL, Dg.i = NULL) {
# 1e cas de calcul (avec N.i, G.i, N.f et G.f)
  if (!is.null(N.i) & !is.null(G.i) & !is.null(N.f) & !is.null(G.f)) {
    if (length(N.i) == length(G.i) & length(N.f) == length(G.f) & length(N.i) == length(N.f)) {
      if (!is.null(Dg.e) | !is.null(Dg.i)) {
        warning("Les vecteurs Dg.e et Dg.i n'ont pas ?t? utilis?s")
      }
      if ((sum(N.i < N.f, na.rm = T) + sum(G.i < G.f, na.rm = T)) != 0) {
        warning("En toute logique, N.f et G.f sont respectivement strictement inf?rieur ? N.i et G.i. NA est renvoy? pour le calcul de Ke")
      }
      Dg.e <- ifelse(N.i <= N.f | G.i <= G.f, NA, 100*sqrt(4 * (G.i - G.f) / (pi * (N.i - N.f))))
      Dg.i <-  100*sqrt(4 * G.i / (pi * N.i))
    } else {
      stop("les vecteurs N.i, G.i, N.f et G.f n'ont pas la m?me longueur \n")
    }
# 2e cas de calcul (avec N.i, G.i et Dg.e)
  } else if (!is.null(Dg.e) &  !is.null(N.i) & !is.null(G.i)) {
    if (length(N.i) == length(G.i) & length(N.i) == length(Dg.e)) {
      if (!is.null(N.f) | !is.null(G.f) | !is.null(Dg.i)) {
        warning("Les vecteurs N.f, G.f et Dg.i n'ont pas ?t? utilis?s")
      }
      Dg.i <-  100*sqrt(4 * G.i / (pi * N.i))
    } else {
      stop("les vecteurs N.i, G.i et Dg.e n'ont pas la m?me longueur \n")
    }
# 3e cas de calcul (avec Dg.i et Dg.e)
  } else if (!is.null(Dg.e) & !is.null(Dg.i)) {
    if (!is.null(N.f) | !is.null(G.f) | !is.null(N.i) | !is.null(G.i)) {
      warning("Les vecteurs N.i, G.i, N.f, G.f n'ont pas ?t? utilis?s")
    }
    if (length(Dg.e) != length(Dg.i)) {
      stop("les vecteurs Dg.e et Dg.i n'ont pas la m?me longueur \n")
    }
# Aucun des cas n'est possible
  } else {
      stop("il manque des donn?es. 3 combinaisons sont possibles : (N.i,G.i,N.f,G.f), (N.i,G.i,Dg.e) ou (Dg.i,Dg.e)  \n")
  }
# calcul et renvoi de Ke
  return(Dg.e / Dg.i)
}