R/ecofloRe.R
In jprenaud-02/ecofloRe: Fonctions R pour Ecoflore
Defines functions
eco.weighted.mean
weighted.var
et
ecofloRe
Documented in
ecofloRe
eco.weighted.mean
et
weighted.var
################################################################################
# Ce script est un clone du logiciel
# ECOFLORE du Departement ONF RDI
#
# Auteurs : Didier Francois, Christine Deleuze, Victor Moinard Pole de Dole
# JP Renaud-02, Noemie Pousse, Pole de Nancy
# Jean Ladier, Isabelle Dottarelli, Pole d'Avignon
# Vincent Boulanger, Pole de Fontainebleau
#
# date : novembre 2016
#
#References : Bartoli et al 2000, Revue Forestiere Francaise
# Bruno et Bartoli 2001, Revue Forestiere Francaise
# en.wikipedia.org/wiki/Weighted_arithmetic_mean#Weighted_sample_variance
################################################################################
#' @title Moyenne pondérée pour ecofloRe
#'
#' @description Moyenne pondérée qui remplace NaN par NA dans le résultat. Oui, d'accord, c'est un peu de l'abus de faire une fonction pour ça
#'
#' @details fonctionne exactement comme la fonction \code{\link[stats]{weighted.mean}}
#'
#' @rdname eco.weighted.mean
#' @aliases eco.weighted.mean
#'
#' @param x vecteur des valeurs
#' @param w vecteur des poids
#' @param na.rm booléen, si TRUE, on enlève les valeurs NA
#'
#' @return la moyenne pondérée avec NA à la place de NaN
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @seealso weighted.mean ECOFLORE.data
#' @export
#'
#' @examples
#' x<-c(5,4,6,3,NA)
#' w<-c(2,3,2,2,3)
#' mean<-eco.weighted.mean(x,w,na.rm=TRUE)
#' mean
#' mean<-weighted.mean(x,w,na.rm=TRUE)
#' mean
#'
#' eco.weighted.mean(c(NA,NA),c(1,2),na.rm=TRUE)
#' weighted.mean(c(NA,NA),c(1,2),na.rm=TRUE)
eco.weighted.mean<-function(x,w,na.rm=TRUE){
#requireNamespace("stats")
res<-stats::weighted.mean(x,w,na.rm=na.rm)
return(ifelse(is.nan(res),NA,res))
}
#' @title Estimateur de la variance pondérée
#'
#' @description Calcul l'estimateur de la variance pondérée par des poids
#'
#' @details La formule utilisée est la formule de l'estimateur de la variance
#' pondérée où les poids sont les poids et non des fréquences (en anglais,
#' reliability weight != frequency weight)
#'
#' @rdname weighted.var
#' @aliases weighted.var
#'
#' @param x vecteur des valeurs
#' @param w vecteur des poids
#' @param na.rm booléen, si TRUE, on enlève les valeurs NA
#'
#' @return la variance pondérée
#'
#' @author Victor Moinard
#'
#' @references en.wikipedia.org/wiki/Weighted_arithmetic_mean#Weighted_sample_variance
#'
#' @family ecofloRe
#' @keywords function
#' @seealso var
#' @export
#' @examples
#'
#' x0<-c(5,4,6,3,NA)
#' w0<-c(2.4,3/2,2/3,1.2,3)
#' var0<-weighted.var(x0,w0,na.rm=TRUE)
#' var0
#'
#' #avec ponderation
#' x<-c(5,4,6,3,NA)
#' w<-c(2,3,2,2,3)
#' var<-weighted.var(x,w,na.rm=TRUE)
#' var
#'
#' #sans ponderation
#' x2<-c(5,5,4,4,4,6,6,3,3,NA,NA,NA)
#' var2<-var(x2,na.rm=TRUE)
#' var2
#' #on obtient un resultat different. Cela est normal, car la formule utilisee
#' # considere que les poids ne sont pas des frequences (frequency weights),
#' # mais des poids (reliability weights)
#' # voir References pour plus d'informations
#'
#' #absence de donnees
#' weighted.var(c(NA,NA),c(1,2),na.rm=TRUE)
#'
weighted.var<-function(x,w,na.rm=TRUE){
if(na.rm){
x2<-x[(!is.na(x)) & (!is.na(w))]
w2<-w[(!is.na(x)) & (!is.na(w))]
x<-x2
w<-w2
}
res<-sum(w*((x-eco.weighted.mean(x,w,na.rm=TRUE))**2))/(sum(w)-(sum(w**2)/sum(w)))
return(ifelse(is.nan(res),NA,res))
}
#' @title Fonction logique ET (&)
#'
#' @description Fonction logique ET (&) appliquée à un vecteur de booléen
#'
#' @rdname et
#' @aliases et
#'
#' @param x vecteurs de booléens
#'
#' @return La fonction retourne TRUE si tout les booléens sont TRUE, FALSE sinon
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#'
#' x1<-c(TRUE,TRUE,TRUE,TRUE)
#' et(x1)
#' x2<-c(TRUE,TRUE,NA,TRUE)
#' et(x2)
#' x3<-c(TRUE,FALSE,TRUE,TRUE)
#' et(x3)
#' x4<-c(TRUE,FALSE,NA,TRUE)
#' et(x4)
#'
et<-function(x){
if(FALSE %in% x){
y<-FALSE
}else if(NA %in% x){
y<-NA
}else if(unique(x)==TRUE){
y<-TRUE
}else{
stop("Erreur d'input")
}
return(y)
}
#######################################################################################
# La fonction ecofloRe prend en entree :
# $releve : un data.frame, avec les colonnes "Releve", merge, et possiblement "Abondance"
# $abdo : (default TRUE) : logical : prend-on en compte l'abondance/dominance?
# $Rdata : string, emplacement de la base de donnees ECOFLORE.data.Rdata à utiliser. Cette base de donnees doit etre au format .Rdata et comporter les tables suivantes : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (defaut), la base est chargee avec \code{ECOFLORE.data}
# $catalogue : quel catalogue utiliser ? vecteur avec un ou plusieurs des code "MON" (montagne), "PC"(plaine et colines), "MED"(mediterranee)
# $enregistreChoix : (default TRUE) : est-ce que toutes les plantes d'une meme espece appartiennent au meme groupe de bimodalite ?
# $noBimodal : (default FALSE) : si TRUE, les plantes bimodales ne sont pas prises en compte.
# $merge : vecteur : sur quelle(s) colonne(s) doit se faire le merge entre les plantes de Releve et la base de donnee ? peut etre "Nom_fr_fff", Nom_latin_fff", "CD_REF" par exemple, ou toute colonne de liste
#
#
# La fonction ecofloRe renvoie deux data.frame :
# 1. un resultat de bioindication par releve?
# 2. un tableau floristique avec l'information de bioindiction pour chaque espece de plante
#######################################################################################
#' @title Méthode "ecofloRe" de bioindication troph-hydrique
#'
#' @description Fonctions qui calcule la position d'un relevé floristique dans le diagramme troph-hydrique de Rameau. Il s'agit d'un clône du logiciel codé sous VBA par Michel Bartoli.
#'
#' @details La fonction \code{ecofloRe} attribue un groupe floristique à chaque plante du relevé floristique, à partir de la base de référence ECOFLORE.data.Rdata. La position de ce relevé dans le diagramme de Rameau est calculé comme le barycentre pondéré de ces groupes troph-hydriques.
#'
#' La pondération se fait selon trois paramètres : l'inverse de l'amplitude du groupe (plus le groupe est large, moins il porte d'information), un coéfficient de surpondération attribuée à dire d'expert et présent dans la base de donnée, et optionnelement une pondération selon le coéfficient d'abondance.
#'
#' L'utilisateur doit rentrer dans la fonction quel groupe doit être utilisé pour les plantes bimodales.
#'
#' @rdname ecofloRe
#' @aliases ecofloRe
#'
#' @param releve un data.frame comportant les données du relevé floristique, possédant les champs de types character : "$Releve" (identifiant du releve floristique), les champs character indiqués par l'argument \code{merge} (noms des plantes), et le champ character "$Abondance" si \code{abdo} est situé à \code{TRUE}
#' @param abdo booléen, vaut \code{TRUE} par défaut. Si \code{TRUE}, on prend en compte la pondération par le coéfficient d'abondance.
#' @param Rdata string, emplacement de la base de données ECOFLORE.data à utiliser. Cette base de données doit être au format .Rdata et comporter les data.frame suivants : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (défaut), la base est chargée avec \code{ECOFLORE.data}
#' @param catalogue vecteur de character pouvant contenir les champs "PC" (Plaines et Collines), "MON" (montagne) et/ou "MED" (méditerranée). Indique quel(s) catalogue la fonction doit utiliser.
#' @param enregistreChoix booléen. Si FALSE, la fonction demandera une seul fois à l'utilisateur le groupe de chaque espèce de bimodale. Si FALSE, la fonction demandera le groupe d'une espèce bimodale pour chaque relevé ou elle apparait.
#' @param noBimodal booléen. Si FALSE, on demande à l'utilisateur de choisir le groupe des plantes bimodales, si TRUE, les plantes bimodales sont retirées de l'analyse.
#' @param merge vecteur de character. Il s'agit du ou des noms de colonnes sur lesquelles la reconnaissance des espèces doit se faire. Les différentes valeurs possibles peuvent être : "CD_REF", "Nom_fr_fff", Nom_latin_fff", "Nom_valide_mhn", "Nom_epure_mhn", "Nom_latin_mhn", "Nom_vern_mhn" (soit les colonnes de la table ECOFLORE.liste dans la base de données ECOFLORE.data.Rdata)
#'
#' @return une liste composée de deux data.frame.
#'
#' le data.frame "resultat" contient la position de chaque relevé floristique dans le diagramme de Rameau
#'
#' Les champs du data.frame resultat signifient : "X" = position trophique.
#' "Y" = position hydrique. "IC_MIN_*"=coordonnées basse de l'intervalle de
#' confiance sur l'axe * . "IC_MAX_*"=idem mais avec la coordonnées haute.
#' "groupe"=regroupement des relevés floristiques (ex: "bloc 1"/"bloc 2", ou
#' "site 1"/"site 2")
#'
#' le data.frame "releve" contient l'information de bioindiction pour chaque espèce de plante (à quelle groupe elle appartient, quelle est sa position et son importance, etc)
#'
#' @author Victor Moinard (redacteur), basé sur des scripts de Didier François et Jean_Pierre Renaud
#'
#' @note Le package \code{data.table} est requis
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @family ecofloRe
#' @keywords function
#' @export
#'
#' @examples
#' # 1.on charge un relevé floristique
#'
#' ReleveFloreCoisia
#' coisia<-ReleveFloreCoisia
#'
#' ReleveFloreChaux
#' chaux<-ReleveFloreChaux
#'
#' ## on vérifie les noms de champs
#' colnames(coisia)
#' colnames(chaux)
#'
#' # 2.on calcul la position des relevés dans le diagramme de Rameau,
#' # basé sur le catalogue "Plaine et Collines"
#'
#' eco1<-ecofloRe(coisia,catalogue=c("PC"),merge=c("Nom_latin_fff","Nom_fr_fff"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#'
#' eco1$resultat
#' eco1$releve
#'
#' eco2<-ecofloRe(chaux,catalogue=c("PC"),noBimodal=TRUE,merge=c("CD_REF"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#'
ecofloRe<-function(releve,abdo=TRUE,Rdata=NULL,catalogue=c("MON","PC","MED"),enregistreChoix=TRUE,noBimodal=FALSE,merge="CD_REF"){
#requireNamespace("data.table")
MON<-FALSE
PC<-FALSE
MED<-FALSE
if("MON" %in% catalogue){
MON<-TRUE
}
if("PC" %in% catalogue){
PC<-TRUE
}
if("MED" %in% catalogue){
MED<-TRUE
}
#1.on charge la base de donnees
if(is.null(Rdata)){
#data("ECOFLORE.data")
}else{
load(Rdata)
}
#2.reperer les erreurs de Rdata
##bons noms de dataframe
nom_tables<-c("ECOFLORE.abondance","ECOFLORE.liste","ECOFLORE.especes","ECOFLORE.GEI")
# dif<-setdiff(nom_tables,ls());
# if(length(dif)>0){
# stop(paste0("tables non trouvees: ",paste0(dif,collapse = ", ")))
# }
##bons noms de colonne
nom_cols<-list(
abondance=c("Code","Valeur"),
liste=c("Nom_fr_fff","Nom_latin_fff","MON","PC","MED","Especes_informations",merge),
especes=c("Contexte_Info","CODE_GROUPE","Nom_latin_fff","Nom_fr_fff"),
GEI=c("Id","CODE_GROUPE","MON","PC","MED","Libelle","X0","Y0","Largeur","Hauteur","Sur_pond_hyd","Sur_pond_trop")
)
for(i in 1:length(nom_tables)){
dif<-setdiff(nom_cols[[i]],colnames(get(nom_tables[i])))
if(length(dif)>0){
stop(paste("colonnes non trouvees dans",nom_tables[i],":",dif,collapse="\n"))
}
}
#3.reperer les erreurs de releve: bons noms de colonne
nomcol_releve<-c("Releve",merge)
if(abdo){nomcol_releve<-c(nomcol_releve,"Abondance")}
dif<-setdiff(nomcol_releve,colnames(releve));
if(length(dif)>0){
stop(paste("colonnes non trouvees dans releve:",dif))
}
#4.enlever les doublons
if(!abdo){
releve<-unique(releve)
}else{
by.ag<-list(releve$Releve)
for(l in merge){
by.ag<-c(by.ag,list(releve[,l]))
}
releve<-aggregate(releve$Abondance,by=by.ag,FUN=function(x){return(x[1])})
colnames(releve)<-c("Releve",merge,"Abondance")
}
#4bis.ne garder que les bons catalogues
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("MON","CODE_GROUPE")],by="CODE_GROUPE")
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("MED","CODE_GROUPE")],by="CODE_GROUPE")
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("PC","CODE_GROUPE")],by="CODE_GROUPE")
if(sum(MON,MED,PC)==1){
if(MON){
ECOFLORE.especes<-ECOFLORE.especes[which(ECOFLORE.especes$MON==1),]
}
if(MED){
ECOFLORE.especes<-ECOFLORE.especes[which(ECOFLORE.especes$MED==1),]
}
if(PC){
ECOFLORE.especes<-ECOFLORE.especes[which(ECOFLORE.especes$PC==1),]
}
}else if(sum(MON,MED,PC)==2){
if(MON&MED){
ECOFLORE.especes<-ECOFLORE.especes[which((ECOFLORE.especes$MON==1) | (ECOFLORE.especes$MED==1)),]
}
if(MED&PC){
ECOFLORE.especes<-ECOFLORE.especes[which((ECOFLORE.especes$PC==1) | (ECOFLORE.especes$MED==1)),]
}
if(PC&MON){
ECOFLORE.especes<-ECOFLORE.especes[which((ECOFLORE.especes$MON==1) | (ECOFLORE.especes$PC==1)),]
}
}else if(sum(MON,MED,PC)==0){
ECOFLORE.especes<-ECOFLORE.especes[FALSE,]
}
#5.mettre les valeurs du GEI dans releve
##merge de l'abondance
if(abdo){
releve<-merge(releve,ECOFLORE.abondance,by.x="Abondance",by.y="Code",all.x=TRUE,sort=F)
colnames(releve)<-gsub("^Valeur$","Pond_abdo",colnames(releve))
nr<-unique(releve$Abondance[is.na(releve$Pond_abdo)])
if(length(nr)>0){
warning(paste("Code(s) abondance non reconnu(s), ponderation = 1 : ",paste(nr,collapse = " ")))
}
releve$Pond_abdo[is.na(releve$Pond_abdo)]<-1
}
##merge de releve sur ECOFLORE.liste : colonne merge
releve<-merge(releve,ECOFLORE.liste,by=merge,sort=FALSE,all.x=TRUE)
#releve$connu<-is.na(releve$Nom_latin_fff)|is.na(releve$Nom_fr_fff)
#releve.mergeE.list<-apply(as.data.frame(releve),1,function(x) mergeE(x=x,col=merge,df=ECOFLORE.liste[,merge]))
#releve.mergeE<-data.frame()
#for(i in 1:length(releve.mergeE.list)){
# releve.mergeE<-rbind(releve.mergeE,releve.mergeE.list[[i]])
#}
##merge de releve sur ECOFLORE.espece : nom latin et français fff. selection des contexte ici
###plus simple de faire un nouveau code : n merge releve et ECOFLORE.especes sur la colonne CODE_LATFR
releve$CODE_LATFR<-paste0(releve$Nom_latin_fff,"$$$",releve$Nom_fr_fff)
ECOFLORE.especes$CODE_LATFR<-paste0(ECOFLORE.especes$Nom_latin_fff,"$$$",ECOFLORE.especes$Nom_fr_fff)
ECOFLORE.liste$CODE_LATFR<-paste0(ECOFLORE.liste$Nom_latin_fff,"$$$",ECOFLORE.liste$Nom_fr_fff)
###on regarde le nombre de contexte detecte
releve$nb_contexte<-apply(as.data.frame(releve[,c("CODE_LATFR")]),1,function(x) length(ECOFLORE.especes$CODE_GROUPE[ECOFLORE.especes[,c("CODE_LATFR")]==x]))
releve$connu<-TRUE
releve$connu[releve$nb_contexte==0]<-releve[releve$nb_contexte==0,c("CODE_LATFR")] %in% ECOFLORE.liste[,c("CODE_LATFR")]
releve$CODE_GROUPE<-"None"
###On merge toutes les plantes qui ont un seul contexte
tmp<-
merge(releve[releve$nb_contexte==1,],
ECOFLORE.especes[,c("CODE_LATFR","CODE_GROUPE")],
all.x=TRUE,
by=c("CODE_LATFR"),
sort=FALSE
)
colnames(tmp)<-gsub("^CODE_GROUPE.y$","CODE_GROUPE",colnames(tmp))
tmp$CODE_GROUPE<-as.character(tmp$CODE_GROUPE)
releve[releve$nb_contexte==1,]<-tmp[,colnames(releve)]
###On merge toutes les plantes qui ont plusieurs contextes
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("CODE_GROUPE","Libelle")],by="CODE_GROUPE")
if(!noBimodal){
if(enregistreChoix){
#on ne demande qu'une seule fois chaque espece
register<-data.frame(Nom_latin_fff=character(0),Nom_fr_fff=character(0),CODE_LATFR=character(0),CODE_GROUPE=character(0));
tmp<-unique(releve[releve$nb_contexte>1,c("CODE_LATFR","Nom_fr_fff","Nom_latin_fff","nb_contexte")])
if(nrow(tmp)>0){
for(i in 1:nrow(tmp)){
#on eaffiche les informations de contexte
titre<-tmp[i,c("Nom_fr_fff","Nom_latin_fff")];
print(titre);
aff<-cbind(ECOFLORE.especes[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")],colnames(ECOFLORE.especes)!="CODE_LATFR"],data.frame(n=1:tmp$nb_contexte[i]));
print(aff);
stay<-TRUE;
#on attend un retour de l'utilisateur
while(stay){
input<-readline("quel numero de contexte ? (0: None): ")
n<-NULL
suppressWarnings(n<-as.integer(input))
if(is.integer(n)&(!is.na(n))){
if(n %in% 0:tmp$nb_contexte[i]){
stay<-F
}
}
}
#register : enregistre le resultat pour l'espece. ligne par espece
register<-rbind(register,
data.frame(Nom_latin_fff=tmp$Nom_latin_fff[i],
Nom_fr_fff=tmp$Nom_fr_fff[i],
CODE_LATFR=tmp$CODE_LATFR[i],
CODE_GROUPE=ifelse(n==0,"None",ECOFLORE.especes$CODE_GROUPE[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")]][n])
)
)
}
}
##on merge releve et ECOFLORE.especes (register contient les donnees selectionnees de ECOFLORE.especes)
tmp<-
merge(releve[releve$nb_contexte>1,],
register,
all.x=TRUE,
by=c("CODE_LATFR","Nom_fr_fff","Nom_latin_fff"),
sort=F
)
colnames(tmp)<-gsub("^CODE_GROUPE.y$","CODE_GROUPE",colnames(tmp))
tmp$CODE_GROUPE<-as.character(tmp$CODE_GROUPE)
releve[releve$nb_contexte>1,]<-tmp[,colnames(releve)]
}else{
#on ne demande qu'une seule fois chaque espece
tmp<-releve[releve$nb_contexte>1,c("CODE_LATFR","Nom_fr_fff","Nom_latin_fff","nb_contexte","Releve")]
if(nrow(tmp)>0){
for(i in 1:nrow(tmp)){
#on affiche les informations
titre<-paste0(tmp$Releve[i],", ",tmp[i,c("Nom_fr_fff")]," - ",tmp[i,c("Nom_latin_fff")]);
print(titre);
aff<-cbind(ECOFLORE.especes[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")],colnames(ECOFLORE.especes)!="CODE_LATFR"],data.frame(n=1:tmp$nb_contexte[i]));
print(aff);
stay<-TRUE;
#on attend le retour de l'utilisateur
while(stay){
input<-readline("quel numero de contexte ? (0: None): ")
n<-NULL
suppressWarnings(n<-as.integer(input))
if(is.integer(n)&(!is.na(n))){
if(n %in% 0:tmp$nb_contexte[i]){
stay<-FALSE
}
}
}
##on merge releve et les donnees selectionnees de ECOFLORE.especes pour la ligne
releve$CODE_GROUPE[releve$nb_contexte>1][i]<-ifelse(n==0,"None",ECOFLORE.especes$CODE_GROUPE[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")]][n])
}
}
}
}
##merge de releve sur ECOFLORE.GEI : par CODE_GROUPE
releve<-merge(releve,
ECOFLORE.GEI[,c("CODE_GROUPE","X0","Y0","Hauteur","Largeur","Sur_pond_hyd","Sur_pond_trop")],
by=c("CODE_GROUPE"),
sort=FALSE,
all.x=TRUE
)
#6.afficher les CD_REF non reconnus
#if(length(merge)==1){
# tab<-as.data.frame(unique(releve[!releve$connu,merge]))
# }else{
# tab<-unique(releve[!releve$connu,merge])
# }
if(nrow(as.data.frame(unique(releve[!releve$connu,merge])))){
warning(paste0("Plantes non reconnues : ",nrow(as.data.frame(unique(releve[!releve$connu,merge])))))
warn<-""
for(i in 1:nrow(as.data.frame(unique(releve[!releve$connu,merge])))){
v<-as.vector(as.data.frame(unique(releve[!releve$connu,merge]))[i,])
warn<-paste0(warn,"Plante non reconnue : ",paste0(v,collapse="-"),"\n")
}
warning(warn)
}
#7.aggreger les releves
#probabilite de 95% que la vrai valeur soit entre ICbas et IChaut
#en supposant que les donnees indicatrices soient indedendantes et issues d'une loi Normale
# ce qui est difficile à tester si on a peu de plantes ...
releve<-as.data.table(releve)
releve<-releve[,':='(Xp=X0+Largeur/2,Yp=Y0+Hauteur/2)]
if(abdo){
releve<-releve[,':='(poidsX=Sur_pond_trop/Largeur*Pond_abdo,poidsY=Sur_pond_hyd/Hauteur*Pond_abdo)]
}else{
releve<-releve[,':='(poidsX=Sur_pond_trop/Largeur,poidsY=Sur_pond_hyd/Hauteur)]
}
resultat<-releve[,.(X=as.double(eco.weighted.mean(Xp,poidsX,na.rm=TRUE)),
Y=as.double(eco.weighted.mean(Yp,poidsY,na.rm=TRUE)),
VAR_X=as.double(weighted.var(Xp,poidsX,na.rm=TRUE)),
VAR_Y=as.double(weighted.var(Yp,poidsY,na.rm=TRUE)),
N_plantes=sum(CODE_GROUPE!="None"))
,by=Releve]
resultat<-resultat[,':='(SD_X=sqrt(VAR_X),
SD_Y=sqrt(VAR_Y))]
resultat<-resultat[,':='(ERR_X=qt(0.975,df=N_plantes-1)*SD_X/sqrt(N_plantes),
ERR_Y=qt(0.975,df=N_plantes-1)*SD_Y/sqrt(N_plantes))]
resultat<-resultat[,':='(IC_MIN_X=X-ERR_X,
IC_MAX_X=X+ERR_X,
IC_MIN_Y=Y-ERR_Y,
IC_MAX_Y=Y+ERR_Y)]
resultat<-as.data.frame(resultat)
releve<-as.data.frame(releve)
#8.return
return(list(releve=releve,resultat=resultat))
}
############################################################
# La fonction diag.troph.hydr prend en entree :
# un data.frame resultat qui contient les colonnes X, Y, IC_MIN_X, IC_MAX_X, IC_MIN_Y, IC_MAX_Y, groupe
# IC : booleen : doit on afficher les intervalles de confiance ?
# type : "points, "labels", "couleurs", "couleurs.IC", "couleurs.large"
# alpha : transparence utilisee par les rectangles de couleurs
# rect.fill, rect.col, rect.linetype, rect.size : parametres pour les rectangles de fond
# couleurs : vecteur de couleur pour les differents points, peut etre nomme avec le nom des groupes
# essences : un data.frame issu de la fonction diag.ess avec les essences dont on veut afficher le diagramme
# legende.titre : string : titre de la legende
#
# La fonction renvoie un objet ggplot
#
###############################################################
#' @title Diagramme trophy-hydrique de Rameau
#'
#' @description Fonction qui prend en entrée les positions de relevées floristiques (output de la fonction \code{ecofloRe}), et qui les places dans le diagramme troph-hydrique de Rameau
#'
#' @details Les champs du paramètre resultat signifient : "X" = position trophique.
#' "Y" = position hydrique. "IC_MIN_*"=coordonnées basse de l'intervalle de
#' confiance sur l'axe * . "IC_MAX_*"=idem mais avec la coordonnées haute.
#' "groupe"=regroupement des relevés floristiques (ex: "bloc 1"/"bloc 2", ou
#' "site 1"/"site 2")
#'
#' Les noms des paramètres graphiques sont basées sur les noms de paramètreq ggplot.
#'
#' essences doit contenir les champs suivants : "xmin","ymin","xmax","ymax" (emplacement du rectangle);
#' "fill", "alpha", "size", "color", "linetype" (paramètre graphique du rectangle, même signification que les paramètres ggplot);
#' "label", "size.txt", "color.txt" : texte à afficher, couleur et taille du texte.
#'
#' La fonction \code{ecofloRe} renvoie un data.frame resultat sans champ "groupe", ce champ doit donc être rajouté manuellement
#'
#' Les types de graphiques. "points" : des croix (avec où sans intervalles de confiances si IC=TRUE ou IC=FALSE). "label" : noms des relevés. "couleurs": On colorie la case dans laquelle tombe le point.
#' "couleurs.IC" : rectangle autour de l'intervalle de confiance. "couleurs.large" : on colorie toutes les cases touchées par l'intervalle de confiance.
#'
#' @rdname diag.trop.hydr
#' @aliases diag.trop.hydr
#'
#' @param resultat un data.frame issu de la fonction \code{ecofloRe} qui contient les colonnes X, Y, IC_MIN_X, IC_MAX_X, IC_MIN_Y, IC_MAX_Y, groupe
#' @param IC booléen. Si type= "point", doit-on voire les intervalles de confiance ?
#' @param type string designant le type d'affichage. Doit être parmis la liste : "points, "labels", "couleurs", "couleurs.IC", "couleurs.large"
#' @param couleurs couleurs des points si type = "points" ou "label"
#' @param alpha transparence des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.fill couleurs de fond les rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.linetype type de lignes autours des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.size taille de lignes autours des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.col couleurs de lignes autours des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param essences un data.frame issu de la fonction diag.ess avec les essences dont on veut afficher le diagramme. Voir détails.
#' @param legende.titre string, titre de la légende
#'
#' @return un objet ggplot avec le diagramme qui peut-être affiché ou modifié
#'
#' @author Victor Moinard (redacteur), basé sur des scripts de Didier François et Jean_Pierre Renaud
#'
#' @note Le package ggplot est requis.
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @family ecofloRe
#' @keywords function
#' @export
#'
#' @examples
#' # 1.on charge un relevé floristique
#' ReleveFloreCoisia
#' coisia<-ReleveFloreCoisia
#'
#' ReleveFloreChaux
#' chaux<-ReleveFloreChaux
#'
#' # 2.on calcul la position des relevés dans le diagramme de Rameau
#'
#' eco1<-ecofloRe(coisia,catalogue=c("PC"),merge=c("Nom_latin_fff","Nom_fr_fff"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#' resultatCoisia<-eco1$resultat
#'
#' eco2<-ecofloRe(chaux,catalogue=c("PC"),noBimodal=TRUE,merge=c("CD_REF"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#' resultatChaux<-eco2$resultat
#'
#' # 3.On peut grouper les relevés
#'
#' resultatCoisia$groupe<-1
#' resultatCoisia$groupe<-c("bloc 1","bloc 1","bloc 2","bloc 1","bloc 2","bloc 1","bloc 1",
#' "bloc 1","bloc 2","bloc 2","bloc 2","bloc 2","ext","bloc 2")
#'
#' resultatChaux$groupe<-resultatChaux$Releve
#'
#' # 4.on affiche le diagramme
#'
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="points",legende.titre="Bloc")
#' diag.trop.hydr(resultat=resultatChaux,IC=FALSE,type="points",legende.titre="Station")
#' diag.trop.hydr(resultat=resultatCoisia,IC=TRUE,type="points")
#' diag.trop.hydr(resultat=resultatCoisia,IC=TRUE,type="points",couleurs ="red")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs",rect.col="black")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.IC")
#' diag.trop.hydr(resultat=resultatChaux,IC=FALSE,type="couleurs.IC")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.large",rect.col = "black")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs",rect.col="red")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.IC",
#' alpha=0.1,rect.fill = "black",rect.linetype=0)
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.large",
#' alpha=0.1,rect.fill="black",rect.col = "black")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs",alpha=0.1,
#' rect.fill="black",rect.col = "black")
#'
#'
#' # 5.on peut rajouter les diagrammes des essences
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
#' ##on peut modifier les données d'affichage directement
#' ##ex:
#' essence$fill[essence$label=="PC_Frêne"]<-"red"
#'
#' ##on peut rajouter des lignes :
#' station<-data.frame(xmin=1,
#' xmax=3,
#' ymin=5,
#' ymax=6,
#' fill="green",
#' alpha=0.5,
#' color="black",
#' color.txt="black",
#' size=1,
#' size.txt=3,
#' linetype=1,
#' label="Station XX"
#' )
#' essence<-rbind(essence,station)
#'
#' ##on affiche
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="points",essences = essence)
#'
diag.trop.hydr<-function(resultat,IC=TRUE,type="points",couleurs=NA,alpha=1,rect.fill="grey70",rect.linetype=1,rect.size=1,rect.col="grey50",essences=data.frame(),legende.titre="Groupe"){
#requireNamespace("ggplot2")
######## MISE EN FORME ########
#donnees de resultats
#colonnes necessaires : X, Y
#potentiellement : IC_MIN_max_X_Y
#potentiellement : groupe
if(length(setdiff(c("X","Y"),colnames(resultat)))>0){
stop("colonnes X et/ou Y manquantes");
}
if(IC){
if(length(setdiff(c("IC_MIN_X","IC_MAX_Y","IC_MIN_Y","IC_MAX_X"),colnames(resultat)))>0){
stop("colonnes IC manquantes");
}
}
if(!("groupe" %in% colnames(resultat))){
resultat$groupe<-"";
}
if(is.na(couleurs)){
couleurs<-c("black");
if(length(unique(resultat$groupe))>1){
couleurs<-c(couleurs,rainbow(length(unique(resultat$groupe))-1));
}
}
if(length(couleurs)<length(unique(resultat$groupe))){
couleurs<-c(couleurs,rep("black",length(unique(resultat$groupe))-length(couleurs)));
}
#Configuration des parametres des points/rectangles (en data.frame pour ggplot2)
taille<-rep(0.1,nrow(resultat))
if(nrow(resultat)>0){
labels<-as.character(1:nrow(resultat))
}else{
labels<-character(0)
}
# On colore la case ou tombe le point
if(type=="couleurs"){
rectangle<-data.frame(
xmin=floor(resultat$X),
ymin=floor(resultat$Y),
xmax=floor(resultat$X)+1,
ymax=floor(resultat$Y)+1,
labels=labels,
groupe=as.factor(resultat$groupe)
)
#on fait un rectangle autour de l'intervalle de confiance du point
}else if(type=="couleurs.IC"){
rectangle<-data.frame(
xmin=resultat$IC_MIN_X,
ymin=resultat$IC_MIN_Y,
xmax=resultat$IC_MAX_X,
ymax=resultat$IC_MAX_Y,
labels=labels,
groupe=as.factor(resultat$groupe)
)
#on colore tous les rectangles dans l'intervalle de confiance du point
}else if(type=="couleurs.large"){
rectangle<-data.frame(
xmin=floor(resultat$IC_MIN_X),
ymin=floor(resultat$IC_MIN_Y),
xmax=floor(resultat$IC_MAX_X)+1,
ymax=floor(resultat$IC_MAX_Y)+1,
labels=labels,
groupe=as.factor(resultat$groupe)
)
}else{
#point ou label avec l'intervalle de confiance
if(IC){
segment<-data.frame(
verty1=resultat$IC_MIN_Y,
verty2=resultat$IC_MAX_Y,
vertx=resultat$X,
horx1=resultat$IC_MIN_X,
horx2=resultat$IC_MAX_X,
hory=resultat$Y,
bardgy1=resultat$Y-taille,
bardgy2=resultat$Y+taille,
bardx=resultat$IC_MAX_X,
bargx=resultat$IC_MIN_X,
barhbx1=resultat$X-taille,
barhbx2=resultat$X+taille,
barby=resultat$IC_MIN_Y,
barhy=resultat$IC_MAX_Y,
labels=labels,
groupe=as.factor(resultat$groupe)
)
}else{
#point ou label sans l'intervalle de confiance
segment<-data.frame(
verty1=resultat$Y-taille,
verty2=resultat$Y+taille,
vertx=resultat$X,
horx1=resultat$X-taille,
horx2=resultat$X+taille,
hory=resultat$Y,
labels=labels,
groupe=as.factor(resultat$groupe)
)
}
}
#donnees pour le graphique : grille generale
df1 <- expand.grid(xmax = 0:5, ymax = 0)
df1$xmin <- c(1:6)
df1$ymin <- -1
df1$z <- c("AA", "A", "aa", "a", "n", "b")
df1$lib <- c("tres acides", "acides", "assez acides", "peu acides", "neutres", "calcaires")
df1$z <- factor(df1$z)
df1$x2 <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5)
df1$y2 <- -0.5
df1$y3 <- -1.5
df2 <- expand.grid(xmax = 0, ymax = 0:8)
df2$xmin <- -1
df2$ymin <- c(1:9)
df2$z <- c("H", "hh", "h", "f", "mf", "mx", "X", "XX","XXX")
df2$lib <- c("mouille", "humide", "assez humide", "frais", "assez frais", "assez sec", "sec", "tres sec","hyper sec")
df2$z <- factor(df2$z)
df2$x2 <- -0.5
df2$y2 <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5, 7.5,8.5)
df2$x3 <- -2
cols <- c("AA" = "#FFFF66", "A" = "#FFCC00", "aa" = "#FF9900",
"a" = "#CC9933", "n" = "#996633", "b" = "#663300",
"H" = "#003366", "hh" = "#0066CC", "h" = "#3399FF",
"f" = "#99CCFF", "mf"="#CCFFCC", "mx" = "#FFFF99",
"X" = "#FFCC00", "XX" = "#FF6600","XXX"="#FF3300", "red"="red","black"="black")
#line<-rbind(data.frame(x=0:6,y=0,xend=0:6,yend=9),data.frame(x=0,y=0:9,xend=6,yend=0:9))
line<-rbind(data.frame(x=0:6,y=-1,xend=0:6,yend=9),data.frame(x=-1,y=0:9,xend=6,yend=0:9),data.frame(x=-1,y=0,xend=-1,yend=9),data.frame(x=0,y=-1,xend=6,yend=-1))
############ CREATION DU GGPLOT ##################
#on affiche tout dans le bon ordre
ggplot<-ggplot()
#couleurs de fond des essences
if(nrow(essences)>0){
for(i in 1:nrow(essences)){
ggplot<-ggplot+
geom_rect(data=essences[i,],aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),fill=essences$fill[i],alpha=essences$alpha[i],linetype=0,inherit.aes = F)
}
}
#couleurs de fond des rectangles
if(type %in% c("couleurs","couleurs.IC","couleurs.large")){
ggplot<-ggplot+
geom_rect(data=rectangle,aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),linetype=0,fill=rect.fill,alpha=alpha)
}
#corps : affichage de la grille
ggplot<-ggplot+
theme_classic()+
theme(axis.line=element_blank())+
scale_x_continuous(limits=c(-1,6+2)) +
scale_y_continuous(limits=c(-1,9+2)) +
#geom_rect(data=df1, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, fill=z, color=z)) +
#geom_rect(data=df2, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, fill=z, color=z)) +
geom_rect(data=df1, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax),fill="grey50") +
geom_rect(data=df2, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax),fill="grey50") +
scale_fill_manual(values = cols) +
#scale_color_manual(values = cols) +
scale_size_manual(values=c("p"=7,"g"=7))+
geom_text(data=df1, aes(x2, y2, label=z),size=7) +
geom_text(data=df2, aes(x2, y2, label=z), size = 7) +
#geom_text(data=df1, aes(x2, y3, label=lib), size=3, angle=45) +
#geom_text(data=df2, aes(x3, y2, label=lib), size=3, angle=45) +
#theme(legend.position="none") +
theme(panel.border = element_blank()) +
theme(panel.grid.major = element_blank()) +
theme(axis.ticks = element_blank()) +
theme(axis.text = element_blank()) +
coord_equal() +
geom_segment(data=line,aes(x=x,xend=xend,y=y,yend=yend),size=1)+
theme(axis.title = element_blank())+
scale_color_manual(values=couleurs,name=legende.titre)
#bordure des rectangles des essences
if(nrow(essences)>0){
for(i in 1:nrow(essences)){
ggplot<-ggplot+
geom_rect(data=essences[i,],aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),size=essences$size[i],color=essences$color[i],linetype=essences$linetype[i],alpha=0,inherit.aes = F)
}
}
#bordure des rectangles
if(type %in% c("couleurs","couleurs.IC","couleurs.large")){
ggplot<-ggplot+
geom_rect(data=rectangle,aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),linetype=rect.linetype,size=rect.size,col=rect.col,fill=rect.fill,alpha=0)
}
# affichage des points
if(type=="points" | IC){
ggplot<-ggplot+
geom_segment(data=segment,aes(x=vertx,y=verty1,xend=vertx,yend=verty2,color=groupe),size=1)+
geom_segment(data=segment,aes(x=horx1,y=hory,xend=horx2,yend=hory,color=groupe),size=1)
}
if(IC & ((type=="points")|(type=="couleurs"))){
ggplot<-ggplot+
geom_segment(data=segment,aes(x=bardx,y=bardgy1,xend=bardx,yend=bardgy2,color=groupe),size=1)+
geom_segment(data=segment,aes(x=bargx,y=bardgy1,xend=bargx,yend=bardgy2,color=groupe),size=1)+
geom_segment(data=segment,aes(x=barhbx1,y=barby,xend=barhbx2,yend=barby,color=groupe),size=1)+
geom_segment(data=segment,aes(x=barhbx1,y=barhy,xend=barhbx2,yend=barhy,color=groupe),size=1)
}
#affichage des labels
if(type=="labels"){
ggplot<-ggplot+
geom_label(data=segment,aes(x=vertx,y=hory,label=labels,color=groupe),size=4)
}
#labels des essences
if(nrow(essences)>0){
for(i in 1:nrow(essences)){
ggplot<-ggplot+
geom_label(data=essences[i,],aes(x=xmin,y=ymin,label=label),hjust=0,vjust=0,size=essences$size.txt[i],color=essences$color.txt[i],inherit.aes = F)
}
}
return(ggplot)
}
#################################################################################
#
# Fonction qui lit le fichier excel saisie.xslx
# fichier : string : chemin vers le fichier
#
# retourne un data.frame pouvant etre lance dans dans la fonction ecofloRe
#
#################################################################################
#' @title Lire une fiche de saisie excel pour Ecoflore
#'
#' @description Lire une fiche de saisie excel pour Ecoflore, afin d'importer les relevés floristiques
#'
#' @rdname lireExcel
#' @aliases lireExcel
#'
#' @param fichier string, emplacement du fichier .xlsx à importer
#'
#' @return La fonction retourne un data.frame qui peut être analyser à travers la fonction \code{ecofloRe}
#'
#' @note Le package XLConnect est requis.
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#' # On importe les relevés floristiques
#' #releve<-lireExcel(fichier = "saisie_Cèdres_Coisia.xlsx")
#'
#' # On calcule la position des relevées dans le digramme de Rameau
#' #res<-ecofloRe(releve,abdo=FALSE,catalogue=c("PC"),enregistreChoix = TRUE,
#' # merge=c("Nom_fr_fff","Nom_latin_fff"))
#'
#'
lireExcel<-function(fichier="./saisie.xlsx"){
#requireNamespace("XLConnect")
wb<-loadWorkbook(fichier)
res<-readWorksheet(wb,sheet = "Resultat",header=TRUE,startRow = 1,startCol = 1)
res$Releve.xls<-res$Releve
res$Releve<-paste0(res$Site,"_",res$Releve.xls)
res$Nom_fr_fff<-res$Nom.francais.ECOFLORE
res$Nom_latin_fff<-res$Nom.latin.ECOFLORE
res<-res[which((res$Nom_fr_fff!="")|(res$Nom_latin_fff!="")|(res$Releve.xls!=0)),]
print(paste0(nrow(res)," lignes lues"))
return(res)
}
#' @title Lire une fiche de saisie excel simple pour Ecoflore
#'
#' @description Lire une fiche de saisie excel simple pour Ecoflore, afin d'importer les relevés floristiques
#'
#' @rdname lireExcel2
#' @aliases lireExcel2
#'
#' @param fichier string, emplacement du fichier .xlsx à importer
#'
#' @return La fonction retourne un data.frame qui peut être analyser à travers la fonction \code{ecofloRe}
#'
#' @note Le package XLConnect est requis.
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#' # On importe les relevés floristiques
#' # releve<-lireExcel2(fichier = "saisie2.xlsx")
#'
#' # On calcule la position des relevées dans le digramme de Rameau
#' # res<-ecofloRe(releve,abdo=FALSE,catalogue=c("PC"),enregistreChoix = TRUE,
#' # merge=c("Nom_fr_fff","Nom_latin_fff"))
#'
lireExcel2<-function(fichier="./saisie.xlsx"){
#requireNamespace("XLConnect")
#on charge le excel
wb<-loadWorkbook(fichier)
res<-readWorksheet(wb,sheet = "Flore",header=TRUE,startRow = 1,startCol = 1)
res<-res[which((res$Nom_fr_fff!="")|(res$Nom_latin_fff!="")|(res$Releve!=0)),]
print(paste0(nrow(res)," lignes lues"))
return(res)
}
#################################################################################
#
# Fonction qui importe le diagramme d'une essence
# ess : vecteur des noms d'essences à recuperer
# $Rdata : une autre base de données que celle par défaut
#
# retourne un data.frame pouvant etre lance dans diag.troph.hydr en parametre
#################################################################################
#' @title Données autoécologiques d'une essence
#'
#' @description Fonction qui importe les données pour afficher le diagramme autoécologique d'une ou plusieurs essences. Ces données peuvent être affichée grâce à la fonction \code{diag.trop.hydr}
#'
#' @rdname diag.ess
#' @aliases diag.ess
#'
#' @param ess vecteur de caractère contenant les noms des essences à extraire
#' @param Rdata string, emplacement de la base de données ECOFLORE.data à utiliser. Cette base de données doit être au format .Rdata et comporter les data.frame suivants : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (défaut), la base est chargée avec \code{ECOFLORE.data}
#'
#' @return La fonction retourne un data.frame qui peut être afficher grâce à la fonction \code{diag.trop.hydr}
#'
#' Ce data.frame contient les champs suivants : "xmin","ymin","xmax","ymax" (emplacement du rectangle);
#' "fill", "alpha", "size", "color", "linetype" (paramètre graphique du rectangle, même signification que les paramètres ggplot);
#' "label", "size.txt", "color.txt" : texte à afficher, couleur et taille du texte.
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#'
#' # On vérifie les noms d'espèces et on charge les données
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
#' ##on peut modifier les données d'affichage directement
#' ##ex:
#' essence$fill[essence$label=="PC_Frêne"]<-"red"
#'
#' # On affiche
#' vide<-data.frame(X=numeric(0),
#' Y=numeric(0),
#' IC_MIN_X=numeric(0),
#' IC_MAX_X=numeric(0),
#' IC_MIN_Y=numeric(0),
#' IC_MAX_Y=numeric(0),
#' groupe=character(0)
#' )
#'
#' diag.trop.hydr(resultat=vide,IC=FALSE,type="points",essences = essence)
#'
#'
#'
#' #SINON
#'
#' # 1.on charge un relevé floristique
#'
#' ReleveFloreCoisia
#' releve<-ReleveFloreCoisia
#' ## on vérifie les noms de champs
#' colnames(releve)
#'
#' # 2.on calcul la position des relevés dans le diagramme de Rameau
#'
#' eco<-ecofloRe(releve,catalogue=c("PC"),merge=c("Nom_latin_fff","Nom_fr_fff"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#' resultat<-eco$resultat
#'
#' # 3.On peut grouper les relevés
#'
#' releve$groupe<-1
#'
#' #4. On vérifie les noms d'espèces et on charge les données
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
#' # 5.On affiche
#' diag.trop.hydr(resultat=res$resultat,IC=FALSE,type="points",essences = essence)
#'
#'
diag.ess<-function(ess,Rdata=NULL){
#1.on charge la base de donnees
if(is.null(Rdata)){
#ECOFLORE.data
}else{
load(Rdata)
}
# if(length(setdiff("ECOFLORE.essences",ls()))>0){
# stop("table ECOFLORE.essences non trouvee")
# }
input<-ECOFLORE.essences[ECOFLORE.essences$Essence %in% ess,c("Essence","X0","Y0","Largeur","Hauteur")]
n<-nrow(input)
xmin<-input$X0
res<-data.frame(xmin=xmin)
res$xmax<-input$X0+input$Largeur
res$ymin<-input$Y0
res$ymax<-input$Y0+input$Hauteur
res$fill<-rep("black",n)
res$alpha<-rep(0.5,n)
res$color<-rep("black",n)
res$color.txt<-rep("black",n)
res$size<-rep(0.5,n)
res$size.txt<-rep(3,n)
res$linetype<-rep(1,n)
res$label<-input$Essence
return(res)
}
#################################################################################
#
# Fonction qui liste les essences
# $Rdata : une autre base de donnees que celle par defaut
##################################################################################
#' @title Vue des essence dans la base de données ecofloRe
#'
#' @description Fonction qui affiche les essences décrites dans la base de données ecofloRe
#'
#' @rdname view.ess
#' @aliases view.ess
#'
#' @param Rdata string, emplacement de la base de données ECOFLORE.data à utiliser. Cette base de données doit être au format .Rdata et comporter les data.frame suivants : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (défaut), la base est chargée avec \code{ECOFLORE.data}
#'
#' @return Nom des essences présentes dans la table ECOFLORE.essences
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
view.ess<-function(Rdata=NULL){
#1.on charge la base de donnees
if(is.null(Rdata)){
#ECOFLORE.data
}else{
load(Rdata)
}
# if(length(setdiff("ECOFLORE.essences",ls()))>0){
# stop("table ECOFLORE.essences non trouvée")
# }
res<-ECOFLORE.essences[,c("Essence")]
print(res)
return()
}
jprenaud-02/ecofloRe 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.
Defines functions eco.weighted.mean weighted.var et ecofloRe
Documented in ecofloRe eco.weighted.mean et weighted.var
################################################################################
# Ce script est un clone du logiciel
# ECOFLORE du Departement ONF RDI
#
# Auteurs : Didier Francois, Christine Deleuze, Victor Moinard Pole de Dole
# JP Renaud-02, Noemie Pousse, Pole de Nancy
# Jean Ladier, Isabelle Dottarelli, Pole d'Avignon
# Vincent Boulanger, Pole de Fontainebleau
#
# date : novembre 2016
#
#References : Bartoli et al 2000, Revue Forestiere Francaise
# Bruno et Bartoli 2001, Revue Forestiere Francaise
# en.wikipedia.org/wiki/Weighted_arithmetic_mean#Weighted_sample_variance
################################################################################
#' @title Moyenne pondérée pour ecofloRe
#'
#' @description Moyenne pondérée qui remplace NaN par NA dans le résultat. Oui, d'accord, c'est un peu de l'abus de faire une fonction pour ça
#'
#' @details fonctionne exactement comme la fonction \code{\link[stats]{weighted.mean}}
#'
#' @rdname eco.weighted.mean
#' @aliases eco.weighted.mean
#'
#' @param x vecteur des valeurs
#' @param w vecteur des poids
#' @param na.rm booléen, si TRUE, on enlève les valeurs NA
#'
#' @return la moyenne pondérée avec NA à la place de NaN
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @seealso weighted.mean ECOFLORE.data
#' @export
#'
#' @examples
#' x<-c(5,4,6,3,NA)
#' w<-c(2,3,2,2,3)
#' mean<-eco.weighted.mean(x,w,na.rm=TRUE)
#' mean
#' mean<-weighted.mean(x,w,na.rm=TRUE)
#' mean
#'
#' eco.weighted.mean(c(NA,NA),c(1,2),na.rm=TRUE)
#' weighted.mean(c(NA,NA),c(1,2),na.rm=TRUE)
eco.weighted.mean<-function(x,w,na.rm=TRUE){
#requireNamespace("stats")
res<-stats::weighted.mean(x,w,na.rm=na.rm)
return(ifelse(is.nan(res),NA,res))
}
#' @title Estimateur de la variance pondérée
#'
#' @description Calcul l'estimateur de la variance pondérée par des poids
#'
#' @details La formule utilisée est la formule de l'estimateur de la variance
#' pondérée où les poids sont les poids et non des fréquences (en anglais,
#' reliability weight != frequency weight)
#'
#' @rdname weighted.var
#' @aliases weighted.var
#'
#' @param x vecteur des valeurs
#' @param w vecteur des poids
#' @param na.rm booléen, si TRUE, on enlève les valeurs NA
#'
#' @return la variance pondérée
#'
#' @author Victor Moinard
#'
#' @references en.wikipedia.org/wiki/Weighted_arithmetic_mean#Weighted_sample_variance
#'
#' @family ecofloRe
#' @keywords function
#' @seealso var
#' @export
#' @examples
#'
#' x0<-c(5,4,6,3,NA)
#' w0<-c(2.4,3/2,2/3,1.2,3)
#' var0<-weighted.var(x0,w0,na.rm=TRUE)
#' var0
#'
#' #avec ponderation
#' x<-c(5,4,6,3,NA)
#' w<-c(2,3,2,2,3)
#' var<-weighted.var(x,w,na.rm=TRUE)
#' var
#'
#' #sans ponderation
#' x2<-c(5,5,4,4,4,6,6,3,3,NA,NA,NA)
#' var2<-var(x2,na.rm=TRUE)
#' var2
#' #on obtient un resultat different. Cela est normal, car la formule utilisee
#' # considere que les poids ne sont pas des frequences (frequency weights),
#' # mais des poids (reliability weights)
#' # voir References pour plus d'informations
#'
#' #absence de donnees
#' weighted.var(c(NA,NA),c(1,2),na.rm=TRUE)
#'
weighted.var<-function(x,w,na.rm=TRUE){
if(na.rm){
x2<-x[(!is.na(x)) & (!is.na(w))]
w2<-w[(!is.na(x)) & (!is.na(w))]
x<-x2
w<-w2
}
res<-sum(w*((x-eco.weighted.mean(x,w,na.rm=TRUE))**2))/(sum(w)-(sum(w**2)/sum(w)))
return(ifelse(is.nan(res),NA,res))
}
#' @title Fonction logique ET (&)
#'
#' @description Fonction logique ET (&) appliquée à un vecteur de booléen
#'
#' @rdname et
#' @aliases et
#'
#' @param x vecteurs de booléens
#'
#' @return La fonction retourne TRUE si tout les booléens sont TRUE, FALSE sinon
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#'
#' x1<-c(TRUE,TRUE,TRUE,TRUE)
#' et(x1)
#' x2<-c(TRUE,TRUE,NA,TRUE)
#' et(x2)
#' x3<-c(TRUE,FALSE,TRUE,TRUE)
#' et(x3)
#' x4<-c(TRUE,FALSE,NA,TRUE)
#' et(x4)
#'
et<-function(x){
if(FALSE %in% x){
y<-FALSE
}else if(NA %in% x){
y<-NA
}else if(unique(x)==TRUE){
y<-TRUE
}else{
stop("Erreur d'input")
}
return(y)
}
#######################################################################################
# La fonction ecofloRe prend en entree :
# $releve : un data.frame, avec les colonnes "Releve", merge, et possiblement "Abondance"
# $abdo : (default TRUE) : logical : prend-on en compte l'abondance/dominance?
# $Rdata : string, emplacement de la base de donnees ECOFLORE.data.Rdata à utiliser. Cette base de donnees doit etre au format .Rdata et comporter les tables suivantes : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (defaut), la base est chargee avec \code{ECOFLORE.data}
# $catalogue : quel catalogue utiliser ? vecteur avec un ou plusieurs des code "MON" (montagne), "PC"(plaine et colines), "MED"(mediterranee)
# $enregistreChoix : (default TRUE) : est-ce que toutes les plantes d'une meme espece appartiennent au meme groupe de bimodalite ?
# $noBimodal : (default FALSE) : si TRUE, les plantes bimodales ne sont pas prises en compte.
# $merge : vecteur : sur quelle(s) colonne(s) doit se faire le merge entre les plantes de Releve et la base de donnee ? peut etre "Nom_fr_fff", Nom_latin_fff", "CD_REF" par exemple, ou toute colonne de liste
#
#
# La fonction ecofloRe renvoie deux data.frame :
# 1. un resultat de bioindication par releve?
# 2. un tableau floristique avec l'information de bioindiction pour chaque espece de plante
#######################################################################################
#' @title Méthode "ecofloRe" de bioindication troph-hydrique
#'
#' @description Fonctions qui calcule la position d'un relevé floristique dans le diagramme troph-hydrique de Rameau. Il s'agit d'un clône du logiciel codé sous VBA par Michel Bartoli.
#'
#' @details La fonction \code{ecofloRe} attribue un groupe floristique à chaque plante du relevé floristique, à partir de la base de référence ECOFLORE.data.Rdata. La position de ce relevé dans le diagramme de Rameau est calculé comme le barycentre pondéré de ces groupes troph-hydriques.
#'
#' La pondération se fait selon trois paramètres : l'inverse de l'amplitude du groupe (plus le groupe est large, moins il porte d'information), un coéfficient de surpondération attribuée à dire d'expert et présent dans la base de donnée, et optionnelement une pondération selon le coéfficient d'abondance.
#'
#' L'utilisateur doit rentrer dans la fonction quel groupe doit être utilisé pour les plantes bimodales.
#'
#' @rdname ecofloRe
#' @aliases ecofloRe
#'
#' @param releve un data.frame comportant les données du relevé floristique, possédant les champs de types character : "$Releve" (identifiant du releve floristique), les champs character indiqués par l'argument \code{merge} (noms des plantes), et le champ character "$Abondance" si \code{abdo} est situé à \code{TRUE}
#' @param abdo booléen, vaut \code{TRUE} par défaut. Si \code{TRUE}, on prend en compte la pondération par le coéfficient d'abondance.
#' @param Rdata string, emplacement de la base de données ECOFLORE.data à utiliser. Cette base de données doit être au format .Rdata et comporter les data.frame suivants : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (défaut), la base est chargée avec \code{ECOFLORE.data}
#' @param catalogue vecteur de character pouvant contenir les champs "PC" (Plaines et Collines), "MON" (montagne) et/ou "MED" (méditerranée). Indique quel(s) catalogue la fonction doit utiliser.
#' @param enregistreChoix booléen. Si FALSE, la fonction demandera une seul fois à l'utilisateur le groupe de chaque espèce de bimodale. Si FALSE, la fonction demandera le groupe d'une espèce bimodale pour chaque relevé ou elle apparait.
#' @param noBimodal booléen. Si FALSE, on demande à l'utilisateur de choisir le groupe des plantes bimodales, si TRUE, les plantes bimodales sont retirées de l'analyse.
#' @param merge vecteur de character. Il s'agit du ou des noms de colonnes sur lesquelles la reconnaissance des espèces doit se faire. Les différentes valeurs possibles peuvent être : "CD_REF", "Nom_fr_fff", Nom_latin_fff", "Nom_valide_mhn", "Nom_epure_mhn", "Nom_latin_mhn", "Nom_vern_mhn" (soit les colonnes de la table ECOFLORE.liste dans la base de données ECOFLORE.data.Rdata)
#'
#' @return une liste composée de deux data.frame.
#'
#' le data.frame "resultat" contient la position de chaque relevé floristique dans le diagramme de Rameau
#'
#' Les champs du data.frame resultat signifient : "X" = position trophique.
#' "Y" = position hydrique. "IC_MIN_*"=coordonnées basse de l'intervalle de
#' confiance sur l'axe * . "IC_MAX_*"=idem mais avec la coordonnées haute.
#' "groupe"=regroupement des relevés floristiques (ex: "bloc 1"/"bloc 2", ou
#' "site 1"/"site 2")
#'
#' le data.frame "releve" contient l'information de bioindiction pour chaque espèce de plante (à quelle groupe elle appartient, quelle est sa position et son importance, etc)
#'
#' @author Victor Moinard (redacteur), basé sur des scripts de Didier François et Jean_Pierre Renaud
#'
#' @note Le package \code{data.table} est requis
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @family ecofloRe
#' @keywords function
#' @export
#'
#' @examples
#' # 1.on charge un relevé floristique
#'
#' ReleveFloreCoisia
#' coisia<-ReleveFloreCoisia
#'
#' ReleveFloreChaux
#' chaux<-ReleveFloreChaux
#'
#' ## on vérifie les noms de champs
#' colnames(coisia)
#' colnames(chaux)
#'
#' # 2.on calcul la position des relevés dans le diagramme de Rameau,
#' # basé sur le catalogue "Plaine et Collines"
#'
#' eco1<-ecofloRe(coisia,catalogue=c("PC"),merge=c("Nom_latin_fff","Nom_fr_fff"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#'
#' eco1$resultat
#' eco1$releve
#'
#' eco2<-ecofloRe(chaux,catalogue=c("PC"),noBimodal=TRUE,merge=c("CD_REF"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#'
ecofloRe<-function(releve,abdo=TRUE,Rdata=NULL,catalogue=c("MON","PC","MED"),enregistreChoix=TRUE,noBimodal=FALSE,merge="CD_REF"){
#requireNamespace("data.table")
MON<-FALSE
PC<-FALSE
MED<-FALSE
if("MON" %in% catalogue){
MON<-TRUE
}
if("PC" %in% catalogue){
PC<-TRUE
}
if("MED" %in% catalogue){
MED<-TRUE
}
#1.on charge la base de donnees
if(is.null(Rdata)){
#data("ECOFLORE.data")
}else{
load(Rdata)
}
#2.reperer les erreurs de Rdata
##bons noms de dataframe
nom_tables<-c("ECOFLORE.abondance","ECOFLORE.liste","ECOFLORE.especes","ECOFLORE.GEI")
# dif<-setdiff(nom_tables,ls());
# if(length(dif)>0){
# stop(paste0("tables non trouvees: ",paste0(dif,collapse = ", ")))
# }
##bons noms de colonne
nom_cols<-list(
abondance=c("Code","Valeur"),
liste=c("Nom_fr_fff","Nom_latin_fff","MON","PC","MED","Especes_informations",merge),
especes=c("Contexte_Info","CODE_GROUPE","Nom_latin_fff","Nom_fr_fff"),
GEI=c("Id","CODE_GROUPE","MON","PC","MED","Libelle","X0","Y0","Largeur","Hauteur","Sur_pond_hyd","Sur_pond_trop")
)
for(i in 1:length(nom_tables)){
dif<-setdiff(nom_cols[[i]],colnames(get(nom_tables[i])))
if(length(dif)>0){
stop(paste("colonnes non trouvees dans",nom_tables[i],":",dif,collapse="\n"))
}
}
#3.reperer les erreurs de releve: bons noms de colonne
nomcol_releve<-c("Releve",merge)
if(abdo){nomcol_releve<-c(nomcol_releve,"Abondance")}
dif<-setdiff(nomcol_releve,colnames(releve));
if(length(dif)>0){
stop(paste("colonnes non trouvees dans releve:",dif))
}
#4.enlever les doublons
if(!abdo){
releve<-unique(releve)
}else{
by.ag<-list(releve$Releve)
for(l in merge){
by.ag<-c(by.ag,list(releve[,l]))
}
releve<-aggregate(releve$Abondance,by=by.ag,FUN=function(x){return(x[1])})
colnames(releve)<-c("Releve",merge,"Abondance")
}
#4bis.ne garder que les bons catalogues
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("MON","CODE_GROUPE")],by="CODE_GROUPE")
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("MED","CODE_GROUPE")],by="CODE_GROUPE")
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("PC","CODE_GROUPE")],by="CODE_GROUPE")
if(sum(MON,MED,PC)==1){
if(MON){
ECOFLORE.especes<-ECOFLORE.especes[which(ECOFLORE.especes$MON==1),]
}
if(MED){
ECOFLORE.especes<-ECOFLORE.especes[which(ECOFLORE.especes$MED==1),]
}
if(PC){
ECOFLORE.especes<-ECOFLORE.especes[which(ECOFLORE.especes$PC==1),]
}
}else if(sum(MON,MED,PC)==2){
if(MON&MED){
ECOFLORE.especes<-ECOFLORE.especes[which((ECOFLORE.especes$MON==1) | (ECOFLORE.especes$MED==1)),]
}
if(MED&PC){
ECOFLORE.especes<-ECOFLORE.especes[which((ECOFLORE.especes$PC==1) | (ECOFLORE.especes$MED==1)),]
}
if(PC&MON){
ECOFLORE.especes<-ECOFLORE.especes[which((ECOFLORE.especes$MON==1) | (ECOFLORE.especes$PC==1)),]
}
}else if(sum(MON,MED,PC)==0){
ECOFLORE.especes<-ECOFLORE.especes[FALSE,]
}
#5.mettre les valeurs du GEI dans releve
##merge de l'abondance
if(abdo){
releve<-merge(releve,ECOFLORE.abondance,by.x="Abondance",by.y="Code",all.x=TRUE,sort=F)
colnames(releve)<-gsub("^Valeur$","Pond_abdo",colnames(releve))
nr<-unique(releve$Abondance[is.na(releve$Pond_abdo)])
if(length(nr)>0){
warning(paste("Code(s) abondance non reconnu(s), ponderation = 1 : ",paste(nr,collapse = " ")))
}
releve$Pond_abdo[is.na(releve$Pond_abdo)]<-1
}
##merge de releve sur ECOFLORE.liste : colonne merge
releve<-merge(releve,ECOFLORE.liste,by=merge,sort=FALSE,all.x=TRUE)
#releve$connu<-is.na(releve$Nom_latin_fff)|is.na(releve$Nom_fr_fff)
#releve.mergeE.list<-apply(as.data.frame(releve),1,function(x) mergeE(x=x,col=merge,df=ECOFLORE.liste[,merge]))
#releve.mergeE<-data.frame()
#for(i in 1:length(releve.mergeE.list)){
# releve.mergeE<-rbind(releve.mergeE,releve.mergeE.list[[i]])
#}
##merge de releve sur ECOFLORE.espece : nom latin et français fff. selection des contexte ici
###plus simple de faire un nouveau code : n merge releve et ECOFLORE.especes sur la colonne CODE_LATFR
releve$CODE_LATFR<-paste0(releve$Nom_latin_fff,"$$$",releve$Nom_fr_fff)
ECOFLORE.especes$CODE_LATFR<-paste0(ECOFLORE.especes$Nom_latin_fff,"$$$",ECOFLORE.especes$Nom_fr_fff)
ECOFLORE.liste$CODE_LATFR<-paste0(ECOFLORE.liste$Nom_latin_fff,"$$$",ECOFLORE.liste$Nom_fr_fff)
###on regarde le nombre de contexte detecte
releve$nb_contexte<-apply(as.data.frame(releve[,c("CODE_LATFR")]),1,function(x) length(ECOFLORE.especes$CODE_GROUPE[ECOFLORE.especes[,c("CODE_LATFR")]==x]))
releve$connu<-TRUE
releve$connu[releve$nb_contexte==0]<-releve[releve$nb_contexte==0,c("CODE_LATFR")] %in% ECOFLORE.liste[,c("CODE_LATFR")]
releve$CODE_GROUPE<-"None"
###On merge toutes les plantes qui ont un seul contexte
tmp<-
merge(releve[releve$nb_contexte==1,],
ECOFLORE.especes[,c("CODE_LATFR","CODE_GROUPE")],
all.x=TRUE,
by=c("CODE_LATFR"),
sort=FALSE
)
colnames(tmp)<-gsub("^CODE_GROUPE.y$","CODE_GROUPE",colnames(tmp))
tmp$CODE_GROUPE<-as.character(tmp$CODE_GROUPE)
releve[releve$nb_contexte==1,]<-tmp[,colnames(releve)]
###On merge toutes les plantes qui ont plusieurs contextes
ECOFLORE.especes<-merge(ECOFLORE.especes,ECOFLORE.GEI[,c("CODE_GROUPE","Libelle")],by="CODE_GROUPE")
if(!noBimodal){
if(enregistreChoix){
#on ne demande qu'une seule fois chaque espece
register<-data.frame(Nom_latin_fff=character(0),Nom_fr_fff=character(0),CODE_LATFR=character(0),CODE_GROUPE=character(0));
tmp<-unique(releve[releve$nb_contexte>1,c("CODE_LATFR","Nom_fr_fff","Nom_latin_fff","nb_contexte")])
if(nrow(tmp)>0){
for(i in 1:nrow(tmp)){
#on eaffiche les informations de contexte
titre<-tmp[i,c("Nom_fr_fff","Nom_latin_fff")];
print(titre);
aff<-cbind(ECOFLORE.especes[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")],colnames(ECOFLORE.especes)!="CODE_LATFR"],data.frame(n=1:tmp$nb_contexte[i]));
print(aff);
stay<-TRUE;
#on attend un retour de l'utilisateur
while(stay){
input<-readline("quel numero de contexte ? (0: None): ")
n<-NULL
suppressWarnings(n<-as.integer(input))
if(is.integer(n)&(!is.na(n))){
if(n %in% 0:tmp$nb_contexte[i]){
stay<-F
}
}
}
#register : enregistre le resultat pour l'espece. ligne par espece
register<-rbind(register,
data.frame(Nom_latin_fff=tmp$Nom_latin_fff[i],
Nom_fr_fff=tmp$Nom_fr_fff[i],
CODE_LATFR=tmp$CODE_LATFR[i],
CODE_GROUPE=ifelse(n==0,"None",ECOFLORE.especes$CODE_GROUPE[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")]][n])
)
)
}
}
##on merge releve et ECOFLORE.especes (register contient les donnees selectionnees de ECOFLORE.especes)
tmp<-
merge(releve[releve$nb_contexte>1,],
register,
all.x=TRUE,
by=c("CODE_LATFR","Nom_fr_fff","Nom_latin_fff"),
sort=F
)
colnames(tmp)<-gsub("^CODE_GROUPE.y$","CODE_GROUPE",colnames(tmp))
tmp$CODE_GROUPE<-as.character(tmp$CODE_GROUPE)
releve[releve$nb_contexte>1,]<-tmp[,colnames(releve)]
}else{
#on ne demande qu'une seule fois chaque espece
tmp<-releve[releve$nb_contexte>1,c("CODE_LATFR","Nom_fr_fff","Nom_latin_fff","nb_contexte","Releve")]
if(nrow(tmp)>0){
for(i in 1:nrow(tmp)){
#on affiche les informations
titre<-paste0(tmp$Releve[i],", ",tmp[i,c("Nom_fr_fff")]," - ",tmp[i,c("Nom_latin_fff")]);
print(titre);
aff<-cbind(ECOFLORE.especes[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")],colnames(ECOFLORE.especes)!="CODE_LATFR"],data.frame(n=1:tmp$nb_contexte[i]));
print(aff);
stay<-TRUE;
#on attend le retour de l'utilisateur
while(stay){
input<-readline("quel numero de contexte ? (0: None): ")
n<-NULL
suppressWarnings(n<-as.integer(input))
if(is.integer(n)&(!is.na(n))){
if(n %in% 0:tmp$nb_contexte[i]){
stay<-FALSE
}
}
}
##on merge releve et les donnees selectionnees de ECOFLORE.especes pour la ligne
releve$CODE_GROUPE[releve$nb_contexte>1][i]<-ifelse(n==0,"None",ECOFLORE.especes$CODE_GROUPE[ECOFLORE.especes[,c("CODE_LATFR")]==tmp[i,c("CODE_LATFR")]][n])
}
}
}
}
##merge de releve sur ECOFLORE.GEI : par CODE_GROUPE
releve<-merge(releve,
ECOFLORE.GEI[,c("CODE_GROUPE","X0","Y0","Hauteur","Largeur","Sur_pond_hyd","Sur_pond_trop")],
by=c("CODE_GROUPE"),
sort=FALSE,
all.x=TRUE
)
#6.afficher les CD_REF non reconnus
#if(length(merge)==1){
# tab<-as.data.frame(unique(releve[!releve$connu,merge]))
# }else{
# tab<-unique(releve[!releve$connu,merge])
# }
if(nrow(as.data.frame(unique(releve[!releve$connu,merge])))){
warning(paste0("Plantes non reconnues : ",nrow(as.data.frame(unique(releve[!releve$connu,merge])))))
warn<-""
for(i in 1:nrow(as.data.frame(unique(releve[!releve$connu,merge])))){
v<-as.vector(as.data.frame(unique(releve[!releve$connu,merge]))[i,])
warn<-paste0(warn,"Plante non reconnue : ",paste0(v,collapse="-"),"\n")
}
warning(warn)
}
#7.aggreger les releves
#probabilite de 95% que la vrai valeur soit entre ICbas et IChaut
#en supposant que les donnees indicatrices soient indedendantes et issues d'une loi Normale
# ce qui est difficile à tester si on a peu de plantes ...
releve<-as.data.table(releve)
releve<-releve[,':='(Xp=X0+Largeur/2,Yp=Y0+Hauteur/2)]
if(abdo){
releve<-releve[,':='(poidsX=Sur_pond_trop/Largeur*Pond_abdo,poidsY=Sur_pond_hyd/Hauteur*Pond_abdo)]
}else{
releve<-releve[,':='(poidsX=Sur_pond_trop/Largeur,poidsY=Sur_pond_hyd/Hauteur)]
}
resultat<-releve[,.(X=as.double(eco.weighted.mean(Xp,poidsX,na.rm=TRUE)),
Y=as.double(eco.weighted.mean(Yp,poidsY,na.rm=TRUE)),
VAR_X=as.double(weighted.var(Xp,poidsX,na.rm=TRUE)),
VAR_Y=as.double(weighted.var(Yp,poidsY,na.rm=TRUE)),
N_plantes=sum(CODE_GROUPE!="None"))
,by=Releve]
resultat<-resultat[,':='(SD_X=sqrt(VAR_X),
SD_Y=sqrt(VAR_Y))]
resultat<-resultat[,':='(ERR_X=qt(0.975,df=N_plantes-1)*SD_X/sqrt(N_plantes),
ERR_Y=qt(0.975,df=N_plantes-1)*SD_Y/sqrt(N_plantes))]
resultat<-resultat[,':='(IC_MIN_X=X-ERR_X,
IC_MAX_X=X+ERR_X,
IC_MIN_Y=Y-ERR_Y,
IC_MAX_Y=Y+ERR_Y)]
resultat<-as.data.frame(resultat)
releve<-as.data.frame(releve)
#8.return
return(list(releve=releve,resultat=resultat))
}
############################################################
# La fonction diag.troph.hydr prend en entree :
# un data.frame resultat qui contient les colonnes X, Y, IC_MIN_X, IC_MAX_X, IC_MIN_Y, IC_MAX_Y, groupe
# IC : booleen : doit on afficher les intervalles de confiance ?
# type : "points, "labels", "couleurs", "couleurs.IC", "couleurs.large"
# alpha : transparence utilisee par les rectangles de couleurs
# rect.fill, rect.col, rect.linetype, rect.size : parametres pour les rectangles de fond
# couleurs : vecteur de couleur pour les differents points, peut etre nomme avec le nom des groupes
# essences : un data.frame issu de la fonction diag.ess avec les essences dont on veut afficher le diagramme
# legende.titre : string : titre de la legende
#
# La fonction renvoie un objet ggplot
#
###############################################################
#' @title Diagramme trophy-hydrique de Rameau
#'
#' @description Fonction qui prend en entrée les positions de relevées floristiques (output de la fonction \code{ecofloRe}), et qui les places dans le diagramme troph-hydrique de Rameau
#'
#' @details Les champs du paramètre resultat signifient : "X" = position trophique.
#' "Y" = position hydrique. "IC_MIN_*"=coordonnées basse de l'intervalle de
#' confiance sur l'axe * . "IC_MAX_*"=idem mais avec la coordonnées haute.
#' "groupe"=regroupement des relevés floristiques (ex: "bloc 1"/"bloc 2", ou
#' "site 1"/"site 2")
#'
#' Les noms des paramètres graphiques sont basées sur les noms de paramètreq ggplot.
#'
#' essences doit contenir les champs suivants : "xmin","ymin","xmax","ymax" (emplacement du rectangle);
#' "fill", "alpha", "size", "color", "linetype" (paramètre graphique du rectangle, même signification que les paramètres ggplot);
#' "label", "size.txt", "color.txt" : texte à afficher, couleur et taille du texte.
#'
#' La fonction \code{ecofloRe} renvoie un data.frame resultat sans champ "groupe", ce champ doit donc être rajouté manuellement
#'
#' Les types de graphiques. "points" : des croix (avec où sans intervalles de confiances si IC=TRUE ou IC=FALSE). "label" : noms des relevés. "couleurs": On colorie la case dans laquelle tombe le point.
#' "couleurs.IC" : rectangle autour de l'intervalle de confiance. "couleurs.large" : on colorie toutes les cases touchées par l'intervalle de confiance.
#'
#' @rdname diag.trop.hydr
#' @aliases diag.trop.hydr
#'
#' @param resultat un data.frame issu de la fonction \code{ecofloRe} qui contient les colonnes X, Y, IC_MIN_X, IC_MAX_X, IC_MIN_Y, IC_MAX_Y, groupe
#' @param IC booléen. Si type= "point", doit-on voire les intervalles de confiance ?
#' @param type string designant le type d'affichage. Doit être parmis la liste : "points, "labels", "couleurs", "couleurs.IC", "couleurs.large"
#' @param couleurs couleurs des points si type = "points" ou "label"
#' @param alpha transparence des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.fill couleurs de fond les rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.linetype type de lignes autours des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.size taille de lignes autours des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param rect.col couleurs de lignes autours des rectangles si type ="couleurs", "couleurs.IC", "couleurs.large"
#' @param essences un data.frame issu de la fonction diag.ess avec les essences dont on veut afficher le diagramme. Voir détails.
#' @param legende.titre string, titre de la légende
#'
#' @return un objet ggplot avec le diagramme qui peut-être affiché ou modifié
#'
#' @author Victor Moinard (redacteur), basé sur des scripts de Didier François et Jean_Pierre Renaud
#'
#' @note Le package ggplot est requis.
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @family ecofloRe
#' @keywords function
#' @export
#'
#' @examples
#' # 1.on charge un relevé floristique
#' ReleveFloreCoisia
#' coisia<-ReleveFloreCoisia
#'
#' ReleveFloreChaux
#' chaux<-ReleveFloreChaux
#'
#' # 2.on calcul la position des relevés dans le diagramme de Rameau
#'
#' eco1<-ecofloRe(coisia,catalogue=c("PC"),merge=c("Nom_latin_fff","Nom_fr_fff"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#' resultatCoisia<-eco1$resultat
#'
#' eco2<-ecofloRe(chaux,catalogue=c("PC"),noBimodal=TRUE,merge=c("CD_REF"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#' resultatChaux<-eco2$resultat
#'
#' # 3.On peut grouper les relevés
#'
#' resultatCoisia$groupe<-1
#' resultatCoisia$groupe<-c("bloc 1","bloc 1","bloc 2","bloc 1","bloc 2","bloc 1","bloc 1",
#' "bloc 1","bloc 2","bloc 2","bloc 2","bloc 2","ext","bloc 2")
#'
#' resultatChaux$groupe<-resultatChaux$Releve
#'
#' # 4.on affiche le diagramme
#'
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="points",legende.titre="Bloc")
#' diag.trop.hydr(resultat=resultatChaux,IC=FALSE,type="points",legende.titre="Station")
#' diag.trop.hydr(resultat=resultatCoisia,IC=TRUE,type="points")
#' diag.trop.hydr(resultat=resultatCoisia,IC=TRUE,type="points",couleurs ="red")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs",rect.col="black")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.IC")
#' diag.trop.hydr(resultat=resultatChaux,IC=FALSE,type="couleurs.IC")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.large",rect.col = "black")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs",rect.col="red")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.IC",
#' alpha=0.1,rect.fill = "black",rect.linetype=0)
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs.large",
#' alpha=0.1,rect.fill="black",rect.col = "black")
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="couleurs",alpha=0.1,
#' rect.fill="black",rect.col = "black")
#'
#'
#' # 5.on peut rajouter les diagrammes des essences
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
#' ##on peut modifier les données d'affichage directement
#' ##ex:
#' essence$fill[essence$label=="PC_Frêne"]<-"red"
#'
#' ##on peut rajouter des lignes :
#' station<-data.frame(xmin=1,
#' xmax=3,
#' ymin=5,
#' ymax=6,
#' fill="green",
#' alpha=0.5,
#' color="black",
#' color.txt="black",
#' size=1,
#' size.txt=3,
#' linetype=1,
#' label="Station XX"
#' )
#' essence<-rbind(essence,station)
#'
#' ##on affiche
#' diag.trop.hydr(resultat=resultatCoisia,IC=FALSE,type="points",essences = essence)
#'
diag.trop.hydr<-function(resultat,IC=TRUE,type="points",couleurs=NA,alpha=1,rect.fill="grey70",rect.linetype=1,rect.size=1,rect.col="grey50",essences=data.frame(),legende.titre="Groupe"){
#requireNamespace("ggplot2")
######## MISE EN FORME ########
#donnees de resultats
#colonnes necessaires : X, Y
#potentiellement : IC_MIN_max_X_Y
#potentiellement : groupe
if(length(setdiff(c("X","Y"),colnames(resultat)))>0){
stop("colonnes X et/ou Y manquantes");
}
if(IC){
if(length(setdiff(c("IC_MIN_X","IC_MAX_Y","IC_MIN_Y","IC_MAX_X"),colnames(resultat)))>0){
stop("colonnes IC manquantes");
}
}
if(!("groupe" %in% colnames(resultat))){
resultat$groupe<-"";
}
if(is.na(couleurs)){
couleurs<-c("black");
if(length(unique(resultat$groupe))>1){
couleurs<-c(couleurs,rainbow(length(unique(resultat$groupe))-1));
}
}
if(length(couleurs)<length(unique(resultat$groupe))){
couleurs<-c(couleurs,rep("black",length(unique(resultat$groupe))-length(couleurs)));
}
#Configuration des parametres des points/rectangles (en data.frame pour ggplot2)
taille<-rep(0.1,nrow(resultat))
if(nrow(resultat)>0){
labels<-as.character(1:nrow(resultat))
}else{
labels<-character(0)
}
# On colore la case ou tombe le point
if(type=="couleurs"){
rectangle<-data.frame(
xmin=floor(resultat$X),
ymin=floor(resultat$Y),
xmax=floor(resultat$X)+1,
ymax=floor(resultat$Y)+1,
labels=labels,
groupe=as.factor(resultat$groupe)
)
#on fait un rectangle autour de l'intervalle de confiance du point
}else if(type=="couleurs.IC"){
rectangle<-data.frame(
xmin=resultat$IC_MIN_X,
ymin=resultat$IC_MIN_Y,
xmax=resultat$IC_MAX_X,
ymax=resultat$IC_MAX_Y,
labels=labels,
groupe=as.factor(resultat$groupe)
)
#on colore tous les rectangles dans l'intervalle de confiance du point
}else if(type=="couleurs.large"){
rectangle<-data.frame(
xmin=floor(resultat$IC_MIN_X),
ymin=floor(resultat$IC_MIN_Y),
xmax=floor(resultat$IC_MAX_X)+1,
ymax=floor(resultat$IC_MAX_Y)+1,
labels=labels,
groupe=as.factor(resultat$groupe)
)
}else{
#point ou label avec l'intervalle de confiance
if(IC){
segment<-data.frame(
verty1=resultat$IC_MIN_Y,
verty2=resultat$IC_MAX_Y,
vertx=resultat$X,
horx1=resultat$IC_MIN_X,
horx2=resultat$IC_MAX_X,
hory=resultat$Y,
bardgy1=resultat$Y-taille,
bardgy2=resultat$Y+taille,
bardx=resultat$IC_MAX_X,
bargx=resultat$IC_MIN_X,
barhbx1=resultat$X-taille,
barhbx2=resultat$X+taille,
barby=resultat$IC_MIN_Y,
barhy=resultat$IC_MAX_Y,
labels=labels,
groupe=as.factor(resultat$groupe)
)
}else{
#point ou label sans l'intervalle de confiance
segment<-data.frame(
verty1=resultat$Y-taille,
verty2=resultat$Y+taille,
vertx=resultat$X,
horx1=resultat$X-taille,
horx2=resultat$X+taille,
hory=resultat$Y,
labels=labels,
groupe=as.factor(resultat$groupe)
)
}
}
#donnees pour le graphique : grille generale
df1 <- expand.grid(xmax = 0:5, ymax = 0)
df1$xmin <- c(1:6)
df1$ymin <- -1
df1$z <- c("AA", "A", "aa", "a", "n", "b")
df1$lib <- c("tres acides", "acides", "assez acides", "peu acides", "neutres", "calcaires")
df1$z <- factor(df1$z)
df1$x2 <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5)
df1$y2 <- -0.5
df1$y3 <- -1.5
df2 <- expand.grid(xmax = 0, ymax = 0:8)
df2$xmin <- -1
df2$ymin <- c(1:9)
df2$z <- c("H", "hh", "h", "f", "mf", "mx", "X", "XX","XXX")
df2$lib <- c("mouille", "humide", "assez humide", "frais", "assez frais", "assez sec", "sec", "tres sec","hyper sec")
df2$z <- factor(df2$z)
df2$x2 <- -0.5
df2$y2 <- c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6.5, 7.5,8.5)
df2$x3 <- -2
cols <- c("AA" = "#FFFF66", "A" = "#FFCC00", "aa" = "#FF9900",
"a" = "#CC9933", "n" = "#996633", "b" = "#663300",
"H" = "#003366", "hh" = "#0066CC", "h" = "#3399FF",
"f" = "#99CCFF", "mf"="#CCFFCC", "mx" = "#FFFF99",
"X" = "#FFCC00", "XX" = "#FF6600","XXX"="#FF3300", "red"="red","black"="black")
#line<-rbind(data.frame(x=0:6,y=0,xend=0:6,yend=9),data.frame(x=0,y=0:9,xend=6,yend=0:9))
line<-rbind(data.frame(x=0:6,y=-1,xend=0:6,yend=9),data.frame(x=-1,y=0:9,xend=6,yend=0:9),data.frame(x=-1,y=0,xend=-1,yend=9),data.frame(x=0,y=-1,xend=6,yend=-1))
############ CREATION DU GGPLOT ##################
#on affiche tout dans le bon ordre
ggplot<-ggplot()
#couleurs de fond des essences
if(nrow(essences)>0){
for(i in 1:nrow(essences)){
ggplot<-ggplot+
geom_rect(data=essences[i,],aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),fill=essences$fill[i],alpha=essences$alpha[i],linetype=0,inherit.aes = F)
}
}
#couleurs de fond des rectangles
if(type %in% c("couleurs","couleurs.IC","couleurs.large")){
ggplot<-ggplot+
geom_rect(data=rectangle,aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),linetype=0,fill=rect.fill,alpha=alpha)
}
#corps : affichage de la grille
ggplot<-ggplot+
theme_classic()+
theme(axis.line=element_blank())+
scale_x_continuous(limits=c(-1,6+2)) +
scale_y_continuous(limits=c(-1,9+2)) +
#geom_rect(data=df1, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, fill=z, color=z)) +
#geom_rect(data=df2, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, fill=z, color=z)) +
geom_rect(data=df1, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax),fill="grey50") +
geom_rect(data=df2, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax),fill="grey50") +
scale_fill_manual(values = cols) +
#scale_color_manual(values = cols) +
scale_size_manual(values=c("p"=7,"g"=7))+
geom_text(data=df1, aes(x2, y2, label=z),size=7) +
geom_text(data=df2, aes(x2, y2, label=z), size = 7) +
#geom_text(data=df1, aes(x2, y3, label=lib), size=3, angle=45) +
#geom_text(data=df2, aes(x3, y2, label=lib), size=3, angle=45) +
#theme(legend.position="none") +
theme(panel.border = element_blank()) +
theme(panel.grid.major = element_blank()) +
theme(axis.ticks = element_blank()) +
theme(axis.text = element_blank()) +
coord_equal() +
geom_segment(data=line,aes(x=x,xend=xend,y=y,yend=yend),size=1)+
theme(axis.title = element_blank())+
scale_color_manual(values=couleurs,name=legende.titre)
#bordure des rectangles des essences
if(nrow(essences)>0){
for(i in 1:nrow(essences)){
ggplot<-ggplot+
geom_rect(data=essences[i,],aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),size=essences$size[i],color=essences$color[i],linetype=essences$linetype[i],alpha=0,inherit.aes = F)
}
}
#bordure des rectangles
if(type %in% c("couleurs","couleurs.IC","couleurs.large")){
ggplot<-ggplot+
geom_rect(data=rectangle,aes(xmin=xmin,ymin=ymin,xmax=xmax,ymax=ymax),linetype=rect.linetype,size=rect.size,col=rect.col,fill=rect.fill,alpha=0)
}
# affichage des points
if(type=="points" | IC){
ggplot<-ggplot+
geom_segment(data=segment,aes(x=vertx,y=verty1,xend=vertx,yend=verty2,color=groupe),size=1)+
geom_segment(data=segment,aes(x=horx1,y=hory,xend=horx2,yend=hory,color=groupe),size=1)
}
if(IC & ((type=="points")|(type=="couleurs"))){
ggplot<-ggplot+
geom_segment(data=segment,aes(x=bardx,y=bardgy1,xend=bardx,yend=bardgy2,color=groupe),size=1)+
geom_segment(data=segment,aes(x=bargx,y=bardgy1,xend=bargx,yend=bardgy2,color=groupe),size=1)+
geom_segment(data=segment,aes(x=barhbx1,y=barby,xend=barhbx2,yend=barby,color=groupe),size=1)+
geom_segment(data=segment,aes(x=barhbx1,y=barhy,xend=barhbx2,yend=barhy,color=groupe),size=1)
}
#affichage des labels
if(type=="labels"){
ggplot<-ggplot+
geom_label(data=segment,aes(x=vertx,y=hory,label=labels,color=groupe),size=4)
}
#labels des essences
if(nrow(essences)>0){
for(i in 1:nrow(essences)){
ggplot<-ggplot+
geom_label(data=essences[i,],aes(x=xmin,y=ymin,label=label),hjust=0,vjust=0,size=essences$size.txt[i],color=essences$color.txt[i],inherit.aes = F)
}
}
return(ggplot)
}
#################################################################################
#
# Fonction qui lit le fichier excel saisie.xslx
# fichier : string : chemin vers le fichier
#
# retourne un data.frame pouvant etre lance dans dans la fonction ecofloRe
#
#################################################################################
#' @title Lire une fiche de saisie excel pour Ecoflore
#'
#' @description Lire une fiche de saisie excel pour Ecoflore, afin d'importer les relevés floristiques
#'
#' @rdname lireExcel
#' @aliases lireExcel
#'
#' @param fichier string, emplacement du fichier .xlsx à importer
#'
#' @return La fonction retourne un data.frame qui peut être analyser à travers la fonction \code{ecofloRe}
#'
#' @note Le package XLConnect est requis.
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#' # On importe les relevés floristiques
#' #releve<-lireExcel(fichier = "saisie_Cèdres_Coisia.xlsx")
#'
#' # On calcule la position des relevées dans le digramme de Rameau
#' #res<-ecofloRe(releve,abdo=FALSE,catalogue=c("PC"),enregistreChoix = TRUE,
#' # merge=c("Nom_fr_fff","Nom_latin_fff"))
#'
#'
lireExcel<-function(fichier="./saisie.xlsx"){
#requireNamespace("XLConnect")
wb<-loadWorkbook(fichier)
res<-readWorksheet(wb,sheet = "Resultat",header=TRUE,startRow = 1,startCol = 1)
res$Releve.xls<-res$Releve
res$Releve<-paste0(res$Site,"_",res$Releve.xls)
res$Nom_fr_fff<-res$Nom.francais.ECOFLORE
res$Nom_latin_fff<-res$Nom.latin.ECOFLORE
res<-res[which((res$Nom_fr_fff!="")|(res$Nom_latin_fff!="")|(res$Releve.xls!=0)),]
print(paste0(nrow(res)," lignes lues"))
return(res)
}
#' @title Lire une fiche de saisie excel simple pour Ecoflore
#'
#' @description Lire une fiche de saisie excel simple pour Ecoflore, afin d'importer les relevés floristiques
#'
#' @rdname lireExcel2
#' @aliases lireExcel2
#'
#' @param fichier string, emplacement du fichier .xlsx à importer
#'
#' @return La fonction retourne un data.frame qui peut être analyser à travers la fonction \code{ecofloRe}
#'
#' @note Le package XLConnect est requis.
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#' # On importe les relevés floristiques
#' # releve<-lireExcel2(fichier = "saisie2.xlsx")
#'
#' # On calcule la position des relevées dans le digramme de Rameau
#' # res<-ecofloRe(releve,abdo=FALSE,catalogue=c("PC"),enregistreChoix = TRUE,
#' # merge=c("Nom_fr_fff","Nom_latin_fff"))
#'
lireExcel2<-function(fichier="./saisie.xlsx"){
#requireNamespace("XLConnect")
#on charge le excel
wb<-loadWorkbook(fichier)
res<-readWorksheet(wb,sheet = "Flore",header=TRUE,startRow = 1,startCol = 1)
res<-res[which((res$Nom_fr_fff!="")|(res$Nom_latin_fff!="")|(res$Releve!=0)),]
print(paste0(nrow(res)," lignes lues"))
return(res)
}
#################################################################################
#
# Fonction qui importe le diagramme d'une essence
# ess : vecteur des noms d'essences à recuperer
# $Rdata : une autre base de données que celle par défaut
#
# retourne un data.frame pouvant etre lance dans diag.troph.hydr en parametre
#################################################################################
#' @title Données autoécologiques d'une essence
#'
#' @description Fonction qui importe les données pour afficher le diagramme autoécologique d'une ou plusieurs essences. Ces données peuvent être affichée grâce à la fonction \code{diag.trop.hydr}
#'
#' @rdname diag.ess
#' @aliases diag.ess
#'
#' @param ess vecteur de caractère contenant les noms des essences à extraire
#' @param Rdata string, emplacement de la base de données ECOFLORE.data à utiliser. Cette base de données doit être au format .Rdata et comporter les data.frame suivants : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (défaut), la base est chargée avec \code{ECOFLORE.data}
#'
#' @return La fonction retourne un data.frame qui peut être afficher grâce à la fonction \code{diag.trop.hydr}
#'
#' Ce data.frame contient les champs suivants : "xmin","ymin","xmax","ymax" (emplacement du rectangle);
#' "fill", "alpha", "size", "color", "linetype" (paramètre graphique du rectangle, même signification que les paramètres ggplot);
#' "label", "size.txt", "color.txt" : texte à afficher, couleur et taille du texte.
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#'
#' # On vérifie les noms d'espèces et on charge les données
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
#' ##on peut modifier les données d'affichage directement
#' ##ex:
#' essence$fill[essence$label=="PC_Frêne"]<-"red"
#'
#' # On affiche
#' vide<-data.frame(X=numeric(0),
#' Y=numeric(0),
#' IC_MIN_X=numeric(0),
#' IC_MAX_X=numeric(0),
#' IC_MIN_Y=numeric(0),
#' IC_MAX_Y=numeric(0),
#' groupe=character(0)
#' )
#'
#' diag.trop.hydr(resultat=vide,IC=FALSE,type="points",essences = essence)
#'
#'
#'
#' #SINON
#'
#' # 1.on charge un relevé floristique
#'
#' ReleveFloreCoisia
#' releve<-ReleveFloreCoisia
#' ## on vérifie les noms de champs
#' colnames(releve)
#'
#' # 2.on calcul la position des relevés dans le diagramme de Rameau
#'
#' eco<-ecofloRe(releve,catalogue=c("PC"),merge=c("Nom_latin_fff","Nom_fr_fff"))
#' 0
#' 0
#' 0
#' 0
#' 0
#' 0
#'
#' resultat<-eco$resultat
#'
#' # 3.On peut grouper les relevés
#'
#' releve$groupe<-1
#'
#' #4. On vérifie les noms d'espèces et on charge les données
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
#' # 5.On affiche
#' diag.trop.hydr(resultat=res$resultat,IC=FALSE,type="points",essences = essence)
#'
#'
diag.ess<-function(ess,Rdata=NULL){
#1.on charge la base de donnees
if(is.null(Rdata)){
#ECOFLORE.data
}else{
load(Rdata)
}
# if(length(setdiff("ECOFLORE.essences",ls()))>0){
# stop("table ECOFLORE.essences non trouvee")
# }
input<-ECOFLORE.essences[ECOFLORE.essences$Essence %in% ess,c("Essence","X0","Y0","Largeur","Hauteur")]
n<-nrow(input)
xmin<-input$X0
res<-data.frame(xmin=xmin)
res$xmax<-input$X0+input$Largeur
res$ymin<-input$Y0
res$ymax<-input$Y0+input$Hauteur
res$fill<-rep("black",n)
res$alpha<-rep(0.5,n)
res$color<-rep("black",n)
res$color.txt<-rep("black",n)
res$size<-rep(0.5,n)
res$size.txt<-rep(3,n)
res$linetype<-rep(1,n)
res$label<-input$Essence
return(res)
}
#################################################################################
#
# Fonction qui liste les essences
# $Rdata : une autre base de donnees que celle par defaut
##################################################################################
#' @title Vue des essence dans la base de données ecofloRe
#'
#' @description Fonction qui affiche les essences décrites dans la base de données ecofloRe
#'
#' @rdname view.ess
#' @aliases view.ess
#'
#' @param Rdata string, emplacement de la base de données ECOFLORE.data à utiliser. Cette base de données doit être au format .Rdata et comporter les data.frame suivants : ECOFLORE.liste, ECOFLORE.especes, ECOFLORE.GEI, ECOFLORE.abondance, ECOFLORE.essences. Si Rdata vaut NULL (défaut), la base est chargée avec \code{ECOFLORE.data}
#'
#' @return Nom des essences présentes dans la table ECOFLORE.essences
#'
#' @references Bartoli et al 2000, Revue Forestière Française
#'
#' Bruno et Bartoli 2001, Revue Forestière Française
#'
#' @author Victor Moinard
#'
#' @family ecofloRe
#' @keywords function
#' @export
#' @examples
#' view.ess()
#' essence<-diag.ess(c("Cèdre de l'Atlas","PC_Frêne"))
#'
view.ess<-function(Rdata=NULL){
#1.on charge la base de donnees
if(is.null(Rdata)){
#ECOFLORE.data
}else{
load(Rdata)
}
# if(length(setdiff("ECOFLORE.essences",ls()))>0){
# stop("table ECOFLORE.essences non trouvée")
# }
res<-ECOFLORE.essences[,c("Essence")]
print(res)
return()
}
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.