coopR: Fonctions R pour la Coop

#'
#' @title  Diametre dominant
#' 
#' @description Cette fonction calcule le diametre dominant d'une population sur une surface donnee 
#'
#' @details
#' A venir
#'
#' @param Circ : vecteur des circonferences a partir desquelles on veut calculer un D0 (toutes a la meme unite)
#' @param effectif : vecteur de meme taille que Circ, poids de chaque tige (typiquement, effectif dans le cas d'une classe). Si non renseigne, chaque tige est comptabilisee une fois.
#' @param  SurfPla : scalaire, surface de l'inventaire en m2
#' @param  N : 100 par defaut, effectif par hectare de tiges les plus grosses utilisee dans le calcul de D0.
#'
#' @note Si il y a moins de tiges/ha que le nombre theorique de tiges dominante, c'est le diamete quadratique moyen de toutes les tiges qui est renvoye
#' @note Si la surface est trop petite pour qu'une tiges fasse pleinement partie de l'effectif de dominant, c'est le diametre de la plus grosse tige qui est renvoye
#' @return  Diametre quadratique moyen des N plus grosses tiges/ha (meme unite que Circ)
#'
#' @author Quentin Girard
#' @references Protocole Coop chene...
#'
#' @seealso dico.ch, load_bdd_to_R_ch, load_bdd_to_xls_ch, load_bdd_to_R_ch
#' @examples
#' a venir
#' @keywords function
#'
#' @include coopR-package.R
#' @family coopR
#' @export
  # 2). Diametre dominant pour differents effectifs  # inspire de onfR
calc_D0 <- function (Circ, effectif = NULL, SurfPla, N = 100) {
  # verification des donnees d'entree
  if (is.null(effectif)) { 
    effectif = rep(1, length(Circ))
  }
  if (length(Circ) != length(effectif)) {
    stop("effectif doit etre de meme longueur que Circ")
  }
 
  # mise en forme de la table a deux colonnes (circ et effectif)
  data <- data.frame(Circ = Circ, effectif = effectif)
  data <- data[order(data$Circ, decreasing = TRUE), ] # classe de diametre trie du plus gros au plus petit
  data$D2 <- data$Circ * data$Circ / (pi^2)           # carre du diametre     
  data <- na.omit(data)     

  # nombre de tiges necessaires pour le calcul de D0
  eff_tig <- SurfPla/100 * N/100 
  if (SurfPla < 5000) 
      eff_tig <- eff_tig - 1
  if (eff_tig < 1) {
      eff_tig <- 1
      warning("Surface trop petite : c'est le diametre de la plus grosse tige qui est retourne")
  }
  
  # boucle de constitution du peuplement de dominant
  if (eff_tig >= sum(data$effectif)) {    # pas assez de tiges
    data$eff.dom <- data$effectif
    warning("Il n'y a pas assez de tiges : la moyenne quadratique de toutes les tiges est retournee")
  } else if (eff_tig < sum(data$effectif)) {
    for (val in 1:nrow(data)) {
      nb_tige <- min(data[val, "effectif"], eff_tig)
      data[val, "eff.dom"] <- nb_tige
      eff_tig <- eff_tig - nb_tige
      if (eff_tig <= 0) { break }
    }
    data$eff.dom <- ifelse(is.na(data$eff.dom), 0, data$eff.dom)
  }                                                            
  res <- sqrt(sum(data$D2 * data$eff.dom)/sum(data$eff.dom))
  return(res)
}