Mercurial > repos > mnhn65mo > butterfly_analysis
changeset 8:73d80db53ecc draft default tip
Uploaded
| author | mnhn65mo |
|---|---|
| date | Wed, 22 May 2019 09:28:37 -0400 |
| parents | 22813beb2fa8 |
| children | |
| files | butterfly_analysis/butterfly_crossplot.R butterfly_analysis/butterfly_crossplot.xml butterfly_analysis/code_couleurs.csv butterfly_analysis/stat_bag.r butterfly_analysis/test-data/bourgogne.png butterfly_analysis/test-data/output_ggcomparelevel.png butterfly_analysis/test-data/shortBDD_PAPILLONS_2016.txt butterfly_crossplot.R butterfly_crossplot.xml code_couleurs.csv stat_bag.r |
| diffstat | 11 files changed, 861 insertions(+), 763 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_analysis/butterfly_crossplot.R Wed May 22 09:28:37 2019 -0400 @@ -0,0 +1,561 @@ +################################################################## +#### Script generique pour realiser les figures en croix ###### +#### a partir des donnees brut ###### +################################################################## + +### Version V1.2 _ 2018-07-31 + +library(ggplot2) +library(RColorBrewer) + +args <- commandArgs(trailingOnly = TRUE) + +### importation code +sourcefunctions<-args[1] +source(sourcefunctions) + +## fonction d'importation des fichier des donnes +### fonction d'importation, de concatenation des fichiers +### verification des nom de colonnes +### verification des doublon de ligne +read.data <- function(file=NULL,decimalSigne=".") { +# cat("1) IMPORTATION \n--------------\n") +# cat("<--",file,"\n") + data <- read.table(file,sep="\t",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) + ## verification qu'il y a plusieur colonnes et essaye different separateur + if(ncol(data)==1) { + data <- read.table(file,sep=";",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) + if(ncol(data)==1) { + data <- read.table(file,sep=",",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) + if(ncol(data)==1) { + data <- read.table(file,sep=" ",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) + if(ncol(data)==1) { + stop("!!!! L'importation a echoue\n les seperatateurs de colonne utilise ne sont pas parmi ([tabulation], ';' ',' [espace])\n -> veuillez verifier votre fichier de donnees\n") + } + } + } + } + return(data) +} + + + + + +filtre1niveau <- function(func, + nom_fichier = filename, + dec=".", + nom_fichierCouleur= color_filename, + col_abscisse = "AB_MOYENNE", + figure_abscisse = "Abondance", + col_ordonnee = "DIVERSITE_MOYENNE", + figure_ordonnee = "Diversite", + nomGenerique="GLOBAL", + vec_figure_titre = c("Les Papillons"), + colourProtocole = TRUE, + nomProtocole = "Papillons", + vec_col_filtre = vec_col_filtre_usr, + col_sousGroup = NULL,# + val_filtre = NULL,# + figure_nom_filtre = NULL,# + bagplot = TRUE, + bagProp=c(.05,.5,.95), + seuilSegment=30, + segmentSousSeuil=TRUE, + forcageMajusculeFiltre=TRUE, + forcageMajusculeSousGroupe=TRUE){ + + dCouleur <- read.data(file=nom_fichierCouleur) + d <- read.data(file=nom_fichier,decimalSigne=dec) + if(colourProtocole & !is.null(nomProtocole)) colourProtocole_p <- as.character(dCouleur[dCouleur[,2]==nomProtocole,3]) else colourProtocole_p <- NULL + + for(f in 1:length(vec_col_filtre)) { + if(length(vec_figure_titre)==1){ + figure_titre_f <- vec_figure_titre + }else{ + figure_titre_f <- vec_figure_titre[f] + } + col_filtre_f <- vec_col_filtre[f] + #cat(col_sousGroup) #Just to check + if(func=="ggfiltre1niveau"){ + #cat("ggfiltre1niveau") + ggfiltre1niveau(d, + col_abscisse, + figure_abscisse, + col_ordonnee, + figure_ordonnee, + figure_titre = figure_titre_f, + col_filtre = col_filtre_f, + nomGenerique, + val_filtre = NULL, + figure_nom_filtre = NULL, + tab_figure_couleur= subset(dCouleur,Filtre==col_filtre_f), + colourProtocole = colourProtocole_p, + nomProtocole, + bagplot, + bagProp=c(.05,.5,.95), + seuilSegment, + segmentSousSeuil, + forcageMajusculeFiltre) + }else if(func=="gglocal"){ + #cat("gglocal") + gglocal(d, + col_abscisse, + figure_abscisse, + col_ordonnee, + figure_ordonnee, + figure_titre = figure_titre_f, + col_filtre = col_filtre_f, + nomGenerique = nomGenerique, + col_sousGroup = col_sousGroup, + val_filtre = NULL, + figure_nom_filtre = NULL, + tab_figure_couleur= subset(dCouleur,Filtre==col_filtre_f), + colourProtocole = colourProtocole_p, + nomProtocole, + couleurLocal="#f609c1", + bagplot, + bagProp, + seuilSegment, + segmentSousSeuil, + forcageMajusculeFiltre, + forcageMajusculeSousGroupe) + }else{ + #cat("ggCompareLevel") + ggCompareLevel(d, + col_abscisse, + figure_abscisse, + col_ordonnee, + figure_ordonnee, + figure_titre = figure_titre_f, + col_filtre = col_filtre_f, + nomGenerique = nomGenerique, + val_filtre = NULL, + figure_nom_filtre = NULL, + tab_figure_couleur= subset(dCouleur,Filtre==col_filtre_f), + colourProtocole = colourProtocole_p, + nomProtocole, + bagplot, + bagProp, + seuilSegment, + segmentSousSeuil, + forcageMajusculeFiltre) + } + } +} + +ggfiltre1niveau <- function(d, + col_abscisse = "AB_MOYENNE", + figure_abscisse = "Abondance", + col_ordonnee = "DIVERSITE_MOYENNE", + figure_ordonnee = "Diversite", + figure_titre = "Referentiel papillon", + col_filtre = "nom_reseau", + nomGenerique = "Global", + val_filtre = NULL, + figure_nom_filtre = NULL, + tab_figure_couleur= NULL, + colourProtocole = NULL, + nomProtocole = NULL, + bagplot = TRUE, + bagProp=c(.05,.5,.95), + seuilSegment=30, + segmentSousSeuil=TRUE, + forcageMajusculeFiltre=TRUE, + result_dir="resultats/") { + + d$groupe <- as.character(d[,col_filtre]) + d$abscisse <- d[,col_abscisse] + d$ordonnee <- d[,col_ordonnee] + d$groupe <-gsub("/","_",d$groupe) + d$groupe <-gsub("!","",d$groupe) + + if(forcageMajusculeFiltre){ + d$groupe <- toupper(d$groupe)} + + d <- subset(d,!(is.na(groupe)) & !(is.na(abscisse)) & !(is.na(ordonnee)) & groupe != "") + + if(is.null(val_filtre)){ + lesModalites <- unique(d$groupe) + }else{ + lesModalites <- val_filtre + } + +# repResult <- dir(result_dir) +# current_dir<-getwd() +# dir.create(file.path(current_dir,result_dir)) +# +# if(!(col_filtre %in% repResult)){ +# dir.create(file.path(".",paste(result_dir,col_filtre,sep="")))} +# +# nomRep1 <- paste(result_dir,col_filtre,"/",sep="") + + d.autre <- d + d.autre$groupe <- nomGenerique + + for(m in lesModalites) { + d.reseau <- subset(d,groupe==m) + d.reseau$groupe <- m + ggTable <- rbind(d.autre,d.reseau) + + seuilResum <- nrow(d.reseau) >= seuilSegment + + ggTableResum <- aggregate(cbind(ordonnee, abscisse) ~ groupe, data = ggTable,quantile, c(.25,.5,.75)) + ggTableResum <- data.frame(ggTableResum[,1],ggTableResum[,2][,1:3],ggTableResum[,3][,1:3]) + colnames(ggTableResum) <- c("groupe","ordonnee.inf","ordonnee.med","ordonnee.sup","abscisse.inf","abscisse.med","abscisse.sup") + + if(ggTableResum$groupe[2]==nomGenerique){ + ggTableResum <- ggTableResum[c(2,1),]} + + if(!(is.null(tab_figure_couleur))) { + if(m %in% tab_figure_couleur$Modalite) { + figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), + as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == m])), + c(nomGenerique,m)) + }else{ + figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), + as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == ""])), + c(nomGenerique,m)) + } + } + +# repResult <- dir(nomRep1) +# if(!(m %in% repResult)){ +# dir.create(paste(nomRep1,m,sep=""))} +# nomRep <- paste(nomRep1,m,"/",sep="") +# +# +# if(!is.null(nomProtocole)){ +# repResult <- dir(nomRep) +# if(!(nomProtocole %in% repResult)){ +# dir.create(paste(nomRep,nomProtocole,sep=""))} +# nomRep <- paste(nomRep,nomProtocole,"/",sep="") +# } + + + gg <- ggplot(ggTable,aes(x=abscisse,y=ordonnee,colour=groupe,fill=groupe)) + if(bagplot){ + gg <- gg + stat_bag(data=d.autre,prop=bagProp[1],colour=NA,alpha=.7) + stat_bag(data=d.autre,prop=bagProp[2],colour=NA,alpha=.4) + stat_bag(data=d.autre,prop=bagProp[3],colour=NA,alpha=.2) } + else { + gg <- gg + geom_point(alpha=.2) + } + gg <- gg + geom_hline(data=subset(ggTableResum,groupe== nomGenerique),aes(yintercept = ordonnee.med,colour=groupe),size=.5,linetype="dashed") + geom_vline(data=subset(ggTableResum,groupe==nomGenerique),aes(xintercept = abscisse.med,colour=groupe),size=.5,linetype="dashed") + if(segmentSousSeuil) { + gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size=2.5) + gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size=2.5) + if(!(seuilResum)) { + gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.5,size = 1.5,colour="white") + gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.5,size = 1.5,colour="white") + } + } else { + gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size = 2.5) + gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size = 2.5) + } + + gg <- gg + geom_point(data=d.reseau,size=2) + gg <- gg + labs(list(title=figure_titre,x=figure_abscisse,y=figure_ordonnee)) + + if(!is.null(colourProtocole)){ + gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA), axis.ticks = element_line(colour = colourProtocole, size = 1), axis.ticks.length = unit(0.3, "cm"),plot.title = element_text(colour = colourProtocole)) + }else{ + gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA)) + } + + if(!(is.null(tab_figure_couleur))){ + gg <- gg + scale_colour_manual(values = figure_couleur,name = "") + scale_fill_manual(values = figure_couleur,name = "",guide=FALSE)} + + ggfile <- paste(nomRep,"region",nomProtocole,"_",m,".png",sep="") + #cat("Check",ggfile,":") + ggsave(ggfile,gg) + #cat("\n") + flush.console() + } +} + + +############################################################## +gglocal <- function(d, + col_abscisse = "AB_MOYENNE", + figure_abscisse = "Abondance", + col_ordonnee = "DIVERSITE_MOYENNE", + figure_ordonnee = "Diversite", + figure_titre = "Graphe referentiel", + col_filtre = "NOM_RESEAU", + nomGenerique = "GLOBAL", + col_sousGroup = "PARCELLEID", + val_filtre = NULL, + figure_nom_filtre = NULL, + tab_figure_couleur= NULL, + colourProtocole = NULL, + nomProtocole = NULL, + couleurLocal="#f609c1", + bagplot = TRUE, + bagProp=c(.05,.5,.95), + seuilSegment=30, + segmentSousSeuil=TRUE, + forcageMajusculeFiltre=TRUE, + forcageMajusculeSousGroupe=TRUE) { + + d$groupe <- d[,col_filtre] + d$abscisse <- d[,col_abscisse] + d$ordonnee <- d[,col_ordonnee] + d$sousGroup <- d[,col_sousGroup] + d$groupe <-gsub("/","_",d$groupe) + d$groupe <-gsub("!","",d$groupe) + d$sousGroup <-gsub("/","_",d$sousGroup) + d$sousGroup <-gsub("!","",d$sousGroup) + if(forcageMajusculeFiltre){ + d$groupe <- toupper(d$groupe)} + if(forcageMajusculeSousGroupe){ + d$sousGroup <- toupper(d$sousGroup)} + d <- subset(d,!(is.na(groupe)) & !(is.na(sousGroup)) & !(is.na(abscisse)) & !(is.na(ordonnee)) & groupe != "") + vecSousGroup <- as.character(unique(d$sousGroup)) + if(is.null(val_filtre)){ + lesModalites <- unique(d$groupe)} + else{ lesModalites <- val_filtre} + repResult <- dir("resultats/") +# if(!(col_filtre %in% repResult)){ +# dir.create(paste("resultats/",col_filtre,sep=""))} +# nomRep1 <- paste("resultats/",col_filtre,"/",sep="") + d.autre <- d + d.autre$groupe <- nomGenerique + for(m in lesModalites) { + d.reseau <- subset(d,groupe==m) + d.reseau$groupe <- m + ggTable <- rbind(d.autre,d.reseau) + seuilResum <- nrow(d.reseau) >= seuilSegment + ggTableResum <- aggregate(cbind(ordonnee, abscisse) ~ groupe, data = ggTable,quantile, c(.25,.5,.75)) + ggTableResum <- data.frame(ggTableResum[,1],ggTableResum[,2][,1:3],ggTableResum[,3][,1:3]) + colnames(ggTableResum) <- c("groupe","ordonnee.inf","ordonnee.med","ordonnee.sup","abscisse.inf","abscisse.med","abscisse.sup") + if(ggTableResum$groupe[2]==nomGenerique){ + ggTableResum <- ggTableResum[c(2,1),]} + if(!(is.null(tab_figure_couleur))) { + if(m %in% tab_figure_couleur$Modalite) { + figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), + as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == m]),couleurLocal), + c(nomGenerique,m,"")) + } else { + figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), + as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == ""]),couleurLocal), + c(nomGenerique,m,"")) + } + } +# repResult <- dir(nomRep1) +# if(!(m %in% repResult)){ +# dir.create(paste(nomRep1,m,sep=""))} +# nomRep <- paste(nomRep1,m,"/",sep="") +# if(!is.null(nomProtocole)) { +# repResult <- dir(nomRep) +# if(!(nomProtocole %in% repResult)){ +# dir.create(paste(nomRep,nomProtocole,sep=""))} +# nomRep <- paste(nomRep,nomProtocole,"/",sep="") +# } + d.reseau <- subset(d.reseau, !(is.na(sousGroup))) + figure_size<- setNames(c(1,3,2.5), c(nomGenerique,m,"")) + figure_shape<- setNames(c(16,16,20), c(nomGenerique,m,"")) + vecSousGroup <- as.character(unique(d.reseau$sousGroup)) + for(p in vecSousGroup) { + dp <- subset(d.reseau,sousGroup == p) + dp$groupe <- dp$sousGroup + ggTableSous <- rbind(d.reseau,dp) + ggTableSous <- rbind(d.autre,d.reseau,dp) + names(figure_couleur)[3] <- p + names(figure_shape)[3] <- p + names(figure_size)[3] <- p + gg <- ggplot(ggTableSous,aes(x=abscisse,y=ordonnee,colour=groupe,fill=groupe,shape=groupe,size=groupe)) + if(bagplot){ + gg <- gg + stat_bag(data=d.autre,prop=bagProp[1],colour=NA,alpha=.7) + stat_bag(data=d.autre,prop=bagProp[2],colour=NA,alpha=.4) + stat_bag(data=d.autre,prop=bagProp[3],colour=NA,alpha=.2) + }else{ + gg <- gg + geom_point(alpha=.2)} + gg <- gg + geom_hline(data=subset(ggTableResum,groupe == nomGenerique),aes(yintercept = ordonnee.med,colour=groupe),size=.5,linetype="dashed") + gg <- gg + geom_vline(data=subset(ggTableResum,groupe == nomGenerique),aes(xintercept = abscisse.med,colour=groupe),size=.5,linetype="dashed") + if(segmentSousSeuil) { + gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size=2.5) + gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size=2.5) + if(!(seuilResum)) { + gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.5,size = 1.5,colour="white") + gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.5,size = 1.5,colour="white") + } + } else { + gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size = 2.5) + gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size = 2.5) + } + gg <- gg + geom_point(data=subset(ggTableSous,groupe != nomGenerique)) + if(!(is.null(tab_figure_couleur))){ + gg <- gg + scale_colour_manual(values = figure_couleur,name = "") + scale_fill_manual(values = figure_couleur,name = "",guide=FALSE)} + gg <- gg + scale_shape_manual(values = figure_shape,name = "",guide=FALSE) + scale_size_manual(values = figure_size,guide=FALSE) + gg <- gg + labs(list(title=figure_titre,x=figure_abscisse,y=figure_ordonnee)) + if(!is.null(colourProtocole)){ + gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA), axis.ticks = element_line(colour = colourProtocole, size = 1), axis.ticks.length = unit(0.3, "cm"),plot.title = element_text(colour = colourProtocole)) } + else{ + gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA))} + ggfile <- paste(nomRep,"network",nomProtocole,"_",m,"-",p,".png",sep="") + #cat("Check",ggfile,":") + ggsave(ggfile,gg) + #cat("\n") + flush.console() + } + } +} + + + +##################################################### +ggCompareLevel <- function(d, + col_abscisse = "abond_moyenne", + figure_abscisse = "Abondance", + col_ordonnee = "diversite_moyenne", + figure_ordonnee = "Diversite", + figure_titre = "Rhooo il dechire ce graphe", + col_filtre = "nom_reseau", + nomGenerique = "Global", + val_filtre = NULL, + figure_nom_filtre = NULL, + tab_figure_couleur= NULL, + colourProtocole = NULL, + nomProtocole = NULL, + bagplot = TRUE, + bagProp=c(.05,.5,.95), + seuilSegment=30, + segmentSousSeuil=FALSE, + forcageMajusculeFiltre=TRUE){ + + d$groupe <- d[,col_filtre] + d$abscisse <- d[,col_abscisse] + d$ordonnee <- d[,col_ordonnee] + d$groupe <-gsub("/","_",d$groupe) + d$groupe <-gsub("!","",d$groupe) + + if(forcageMajusculeFiltre){ + d$groupe <- toupper(d$groupe)} + d <- subset(d,!(is.na(groupe)) & !(is.na(abscisse)) & !(is.na(ordonnee)) & groupe != "") + if(is.null(val_filtre)){ + lesModalites <- unique(d$groupe) + }else{ + lesModalites <- val_filtre + } +# repResult <- dir("resultats/") +# if(!(col_filtre %in% repResult)){ +# dir.create(paste("resultats/",col_filtre,sep="")) +# } +# if(!is.null(nomProtocole)){ +# repResult <- dir(paste("resultats/",col_filtre,sep="")) +# if(!(nomProtocole %in% repResult)){ +# dir.create(paste("resultats/",col_filtre,"/",nomProtocole,sep=""))} +# nomRep <- paste("resultats/",col_filtre,"/",nomProtocole,"/",sep="") +# }else{ +# nomRep <- paste("resultats/",col_filtre,"/",sep="") +# } + d.autre <- d + d.autre$groupe <- nomGenerique + d.reseau <- subset(d,groupe %in% lesModalites) + ggTable <- rbind(d.autre,d.reseau) + ggTableResum <- aggregate(cbind(ordonnee, abscisse) ~ groupe, data = ggTable,quantile, c(.25,.5,.75)) + ggTableResum <- data.frame(ggTableResum[,1],ggTableResum[,2][,1:3],ggTableResum[,3][,1:3]) + colnames(ggTableResum) <- c("groupe","ordonnee.inf","ordonnee.med","ordonnee.sup","abscisse.inf","abscisse.med","abscisse.sup") + ggSeuil <- aggregate(ordonnee ~ groupe, data=ggTable,length) + ggSeuil$seuilResum <- ggSeuil$ordonnee >= seuilSegment + colnames(ggSeuil)[ncol(ggSeuil)] <- "seuil" + ggTableResum <- merge(ggTableResum,ggSeuil,by="groupe") + t_figure_couleur <- subset(tab_figure_couleur,Modalite %in% c(nomGenerique,lesModalites)) + modaliteSansCouleur <- lesModalites[(!(lesModalites %in% t_figure_couleur$Modalite))] + nbNxCol <- length(modaliteSansCouleur) + mypalette<-brewer.pal(nbNxCol,"YlGnBu") + figure_couleur <- setNames(c(as.character(t_figure_couleur$couleur),mypalette),c(as.character(t_figure_couleur$Modalite),modaliteSansCouleur)) + tab_coul <- data.frame(groupe=names(figure_couleur),couleur=figure_couleur) + tab_coul <- merge(tab_coul,ggTableResum,"groupe") + tab_coul$nom <- paste(tab_coul$groupe," (",tab_coul$ordonnee,")",sep="") + figure_couleur <- setNames(as.character(tab_coul$couleur),tab_coul$groupe) + figure_couleur_nom<- tab_coul$nom + gg <- ggplot(ggTable,aes(x=abscisse,y=ordonnee,colour=groupe,fill=groupe)) + if(bagplot){ + gg <- gg + stat_bag(data=d.autre,prop=bagProp[1],colour=NA,alpha=.7) + stat_bag(data=d.autre,prop=bagProp[2],colour=NA,alpha=.4) + stat_bag(data=d.autre,prop=bagProp[3],colour=NA,alpha=.2) + }else{ + gg <- gg + geom_point(alpha=.2) + } + gg <- gg + geom_hline(data=subset(ggTableResum,groupe=="Autre"),aes(yintercept = ordonnee.med,colour=groupe),size=.5,linetype="dashed") + geom_vline(data=subset(ggTableResum,groupe=="Autre"),aes(xintercept = abscisse.med,colour=groupe),size=.5,linetype="dashed") + gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.7,size = 2.5) + gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.7,size = 2.5) + if(any(ggTableResum$seuil)){ + gg <- gg + geom_segment(data=subset(ggTableResum,!(seuil)),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.5,size = 1.5,colour="white") + gg <- gg + geom_segment(data=subset(ggTableResum,!(seuil)),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.5,size = 1.5,colour="white") + } + + #browser() # gg <- gg + geom_point(data=d.reseau,size=2) + gg <- gg + scale_colour_manual(values = figure_couleur,name = "",labels = figure_couleur_nom) + scale_fill_manual(values = figure_couleur,name = "",guide=FALSE) + gg <- gg + labs(list(title=figure_titre,x=figure_abscisse,y=figure_ordonnee)) + if(!is.null(colourProtocole)){ + gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA), axis.ticks = element_line(colour = colourProtocole, size = 1), axis.ticks.length = unit(0.3, "cm"),plot.title = element_text(colour = colourProtocole)) + }else{ + gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA)) + } + ggfile <- paste(nomRep,nomProtocole,"_",col_filtre,"_","comparaison.png",sep="") + #cat("Check",ggfile,":") + ggsave(ggfile,gg) + #cat("\n") +flush.console() +} + + +######################################### + +#Lancement des fonctions : + + #Variables a definir : + +#filename="BDD_PAPILLONS_2016.txt" +#color_filename<-"code_couleurs.csv" + + #func +#func="ggCompareLevel" +#func="ggfiltre1niveau" +#func="gglocal" + + #colSousGroupe +#col_sousGroup_usr = NULL #ggfiltre #ggCompareLevel +#col_sousGroup_usr = "PARCELLENOM" #gglocal + + #vec_col_filtre_usr +#vec_col_filtre_usr = c("CONDUITEPARCELLE") #ggCompareLevel +#vec_col_filtre_usr = c("REGION") #ggfiltre +#vec_col_filtre_usr = c("NOM_RESEAU") #gglocal + + + +#Exe fonction : + +#filtre1niveau(func=func,nom_fichier=filename,nom_fichierCouleur=color_filename,col_sousGroup=NULL) #ggfiltre ou ggCompareLevel, depend de func et de vec_col_filtre_usr +#filtre1niveau(func=func,nom_fichier=filename,nom_fichierCouleur=color_filename,col_sousGroup = col_sousGroup_usr,vec_col_filtre=vec_col_filtre_usr) ## ==local + +######################################################## + +filename=args[2] +color_filename=args[3] +functions=strsplit(args[4],",")[[1]] + + + +#create result dir +nomRep="resultats/" +dir.create(file.path(".", nomRep), showWarnings = FALSE) + +for (func in functions){ + print(func) + if(func=="ggCompareLevel"){ + col_sousGroup_usr=NULL + vec_col_filtre_usr=c("CONDUITEPARCELLE") + }else if(func=="ggfiltre1niveau"){ + col_sousGroup_usr=NULL + vec_col_filtre_usr=c("REGION") + }else if(func=="gglocal"){ + col_sousGroup_usr="PARCELLENOM" + vec_col_filtre_usr=c("NOM_RESEAU") + }else{ + #sortie erreur + write("Error, unknown function. Exit(1).", stderr()) + q('no') + } + + filtre1niveau(func=func,nom_fichier=filename,nom_fichierCouleur=color_filename,col_sousGroup=col_sousGroup_usr,vec_col_filtre=vec_col_filtre_usr) +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_analysis/butterfly_crossplot.xml Wed May 22 09:28:37 2019 -0400 @@ -0,0 +1,81 @@ +<tool id="butterfly_crossplot" name="Butterfly data analysis and graph display" version="0.1.0"> + <requirements> + <requirement type="package" version="2.2.1">r-ggplot2</requirement> + <requirement type="package" version="1.5_9">r-cairo</requirement> + </requirements> + <command detect_errors="exit_code"><![CDATA[ + Rscript '$__tool_directory__/butterfly_crossplot.R' + '$__tool_directory__/stat_bag.r' + '$butterfly_db' + '$__tool_directory__/code_couleurs.csv' + $function + ]]></command> + <inputs> + <param name="function" type="select" multiple="True" optional="false" label="Select your analyse" help="Chose at least one element you want to compare. It can be geographical regions, local networks or production methods."> + <option value="ggCompareLevel">Compare production methods</option> + <option value="ggfiltre1niveau">Compare regions</option> + <option value="gglocal">Compare local networks</option> + </param> + <param name="butterfly_db" type="data" format="csv,tabular" label="Butterfly datafile" help="Describe file content."/> + </inputs> + <outputs> + <data format="png" name="ggCompareLevel" label="Compare production methods" from_work_dir="resultats/Papillons_CONDUITEPARCELLE_comparaison.png"> + <filter>'ggCompareLevel' in function</filter> + </data> + <collection type="list" name="output_ggfiltre" label="Compare regions"> + <discover_datasets pattern="region(?P<designation>.+)\.png" visible="false" format="png" directory="resultats"/> + <filter>'ggfiltre1niveau' in function</filter> + </collection> + <collection type="list" name="output_gglocal" label="Compare local networks"> + <discover_datasets pattern="network(?P<designation>.+)\.png" visible="false" format="png" directory="resultats"/> + <filter>'gglocal' in function</filter> + </collection> + </outputs> + <tests> + <test> + <param name="butterfly_db" value="shortBDD_PAPILLONS_2016.txt"/> + <param name="function" value="ggCompareLevel"/> + <output name="ggCompareLevel" value="output_ggcomparelevel.png" ftype="png"/> + </test> + <test> + <param name="butterfly_db" value="shortBDD_PAPILLONS_2016.txt"/> + <param name="function" value="ggfiltre1niveau"/> + <output_collection name="output_ggfiltre" type="list"> + <element name="Papillons_BOURGOGNE" value="bourgogne.png" ftype="png"/> + </output_collection> + </test> + </tests> + <help><![CDATA[ + +===================================== +Butterfly analysis and data display +===================================== + +**What it does** + +This tool allows to compare butterfly diversity and abundance across regions, observation networks, and production methods. + +It uses measures from the Observatoire Agricole de la Biodiversity. + +Plots show abundance (x) versus diversity (y). + +Line lenght gives information about dispertion, longer lines means bigger heterogeneity accross fields. + +| + +**How to use it** + +Chose a database file, and one or more data display. + +| + +**Outputs** + +*Compare production methods* option will show differences accross agricultural production methods accross all data. + +*Compare regions* option will create a collection of graph. One plot for each region in created, they show data informations in that region compared with global data. + +*Compare local networks* does the same as the 'regions' option but for every observation networks. + + ]]></help> +</tool>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_analysis/code_couleurs.csv Wed May 22 09:28:37 2019 -0400 @@ -0,0 +1,24 @@ +Filtre;Modalite;couleur +TYPECULTURE;ARBORICULTURE;"#006600" +TYPECULTURE;AUTRE_CULTURE_PERENNE;"#FF5050" +TYPECULTURE;GRANDE_CULTURE;"#FFC000" +TYPECULTURE;MARAICHAGE;"#FF6600" +TYPECULTURE;PRAIRIE;"#97B314" +TYPECULTURE;VITICULTURE;"#660066" +NOM_RESEAU;;"#31849B" +Protocole;Abeilles;"#EE7F00" +Protocole;Invertebres;"#97B314" +Protocole;Papillons;"#009EE0" +Protocole;Vers de terre;"#666666" +TYPECULTURE;GLOBAL;"#9f0d0d" +NOM_RESEAU;GLOBAL;"#9f0d0d" +REGIONNAME;;"#31849B" +REGIONNAME;GLOBAL;"#9f0d0d" +ANNEE;;"#31849B" +ANNEE;GLOBAL;"#9f0d0d" +REGION;GLOBAL;"#9f0d0d" +REGION;;"#666666" +CONDUITEPARCELLE;;"#31849B" +CONDUITEPARCELLE;GLOBAL;"#9f0d0d" +TRAVAILSOL;;"#31849B" +TRAVAILSOL;GLOBAL;"#9f0d0d" \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_analysis/stat_bag.r Wed May 22 09:28:37 2019 -0400 @@ -0,0 +1,145 @@ +library(ggplot2) +StatBag <- ggproto("Statbag", Stat, + compute_group = function(data, scales, prop = 0.5) { + + ################################# + ################################# + # originally from aplpack package, plotting functions removed + plothulls_ <- function(x, y, fraction, n.hull = 1, + col.hull, lty.hull, lwd.hull, density=0, ...){ + # function for data peeling: + # x,y : data + # fraction.in.inner.hull : max percentage of points within the hull to be drawn + # n.hull : number of hulls to be plotted (if there is no fractiion argument) + # col.hull, lty.hull, lwd.hull : style of hull line + # plotting bits have been removed, BM 160321 + # pw 130524 + if(ncol(x) == 2){ y <- x[,2]; x <- x[,1] } + n <- length(x) + if(!missing(fraction)) { # find special hull + n.hull <- 1 + if(missing(col.hull)) col.hull <- 1 + if(missing(lty.hull)) lty.hull <- 1 + if(missing(lwd.hull)) lwd.hull <- 1 + x.old <- x; y.old <- y + idx <- chull(x,y); x.hull <- x[idx]; y.hull <- y[idx] + for( i in 1:(length(x)/3)){ + x <- x[-idx]; y <- y[-idx] + if( (length(x)/n) < fraction ){ + return(cbind(x.hull,y.hull)) + } + idx <- chull(x,y); x.hull <- x[idx]; y.hull <- y[idx]; + } + } + if(missing(col.hull)) col.hull <- 1:n.hull + if(length(col.hull)) col.hull <- rep(col.hull,n.hull) + if(missing(lty.hull)) lty.hull <- 1:n.hull + if(length(lty.hull)) lty.hull <- rep(lty.hull,n.hull) + if(missing(lwd.hull)) lwd.hull <- 1 + if(length(lwd.hull)) lwd.hull <- rep(lwd.hull,n.hull) + result <- NULL + for( i in 1:n.hull){ + idx <- chull(x,y); x.hull <- x[idx]; y.hull <- y[idx] + result <- c(result, list( cbind(x.hull,y.hull) )) + x <- x[-idx]; y <- y[-idx] + if(0 == length(x)) return(result) + } + result + } # end of definition of plothulls + ################################# + + + # prepare data to go into function below + the_matrix <- matrix(data = c(data$x, data$y), ncol = 2) + + # get data out of function as df with names + setNames(data.frame(plothulls_(the_matrix, fraction = prop)), nm = c("x", "y")) + # how can we get the hull and loop vertices passed on also? + }, + + required_aes = c("x", "y") +) + +#' @inheritParams ggplot2::stat_identity +#' @param prop Proportion of all the points to be included in the bag (default is 0.5) +stat_bag <- function(mapping = NULL, data = NULL, geom = "polygon", + position = "identity", na.rm = FALSE, show.legend = NA, + inherit.aes = TRUE, prop = 0.5, alpha = 0.3, ...) { + layer( + stat = StatBag, data = data, mapping = mapping, geom = geom, + position = position, show.legend = show.legend, inherit.aes = inherit.aes, + params = list(na.rm = na.rm, prop = prop, alpha = alpha, ...) + ) +} + + +geom_bag <- function(mapping = NULL, data = NULL, + stat = "identity", position = "identity", + prop = 0.5, + alpha = 0.3, + ..., + na.rm = FALSE, + show.legend = NA, + inherit.aes = TRUE) { + layer( + data = data, + mapping = mapping, + stat = StatBag, + geom = GeomBag, + position = position, + show.legend = show.legend, + inherit.aes = inherit.aes, + params = list( + na.rm = na.rm, + alpha = alpha, + prop = prop, + ... + ) + ) +} + +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export +GeomBag <- ggproto("GeomBag", Geom, + draw_group = function(data, panel_scales, coord) { + n <- nrow(data) + if (n == 1) return(zeroGrob()) + + munched <- coord_munch(coord, data, panel_scales) + # Sort by group to make sure that colors, fill, etc. come in same order + munched <- munched[order(munched$group), ] + + # For gpar(), there is one entry per polygon (not one entry per point). + # We'll pull the first value from each group, and assume all these values + # are the same within each group. + first_idx <- !duplicated(munched$group) + first_rows <- munched[first_idx, ] + + ggplot2:::ggname("geom_bag", + grid:::polygonGrob(munched$x, munched$y, default.units = "native", + id = munched$group, + gp = grid::gpar( + col = first_rows$colour, + fill = alpha(first_rows$fill, first_rows$alpha), + lwd = first_rows$size * .pt, + lty = first_rows$linetype + ) + ) + ) + + + }, + + default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1, + alpha = NA, prop = 0.5), + + handle_na = function(data, params) { + data + }, + + required_aes = c("x", "y"), + + draw_key = draw_key_polygon +)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_analysis/test-data/shortBDD_PAPILLONS_2016.txt Wed May 22 09:28:37 2019 -0400 @@ -0,0 +1,50 @@ +PARCELLEID PARCELLENOM ANNEE TYPECULTURE CONDUITEPARCELLE REGION AB_MOYENNE AB_TOTALE DIVERSITE_MOYENNE DIVERSITE_TOTALE NB_PASSAGES AUTRES NON_IDENTIFIES AMARYLLIS AURORES BELLE_DAME CITRONS CUIVRE DEMI_DEUILS FLAMBES GAZE HESPERIDES_ORANGEES HESPERIDES_TACHETEES LYCENES_BLEUS MACHAONS MEGERES MYRTIL PAON_DU_JOUR PETITES_TORTUES PIERIDES_BLANCHES PROCRIS ROBERT_LE_DIABLE SOUCIS TABAC_D_ESPAGNE TIRCIS VULCAIN SURFACE LATITUDE LONGITUDE PAYSAGEINTENSIF ESPECESCULTIVEES TETEROTATIONEC PCULTURAUXN1EC PCULTURAUXN2EC INTERCULTURE DATESEMIS TRAVAILSOL ANNEEPLANTATION INTERRANG PRAIRIETEMPORAIRE AGEPRAIRIE ESEMEERGA ESEMEERGI ESEMEEDACTYLE ESEMEEFETUQUE ESEMEELEG ESEMEEAUTRE UPATURE UPATURENBUGB UFAUCHE DATEDEBUTFAUCHE NBFAUCHESPARAN ANNEECONVERSION NBPASSAGE_INSECTICIDE NBPASSAGE_HERBICIDE NBPASSAGE_FONGICIDE NBPASSAGE_MOLLUCIDE NBPASSAGE_AUTRE NBPASSAGE_MINERALE NBPASSAGE_F_ORGANIQUE NBPASSAGE_A_ORGANIQUE NBPASSAGE_CALCIQUE CODE_EXPLOITATION NOM_EXPLOITATION INSEE COMMUNE NUM_DEPARTEMENT DEPARTEMENT CODE_RESEAU NOM_RESEAU NOM_RESEAU2 BORDURE_LISIERE BORDURE_HAIE BORDURE_BE BORDURE_ROUTE BORDURE_FOSSE BORDURE_AUCUNE BORDURE_BANDEFLEURIE BORDURE_AUTRE MA_AUTRECULTURE MA_PRAIRIE MA_BOIS MA_ZURBAINE MA_ETANG MA_AUTRE DISTANCE_PARCOURUE NR NR +0000041_SQ7JB_0034048 LA_FAISANDERIE 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 3.8 19 1.33333333333333 2 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3.4 0.4 0 0 0 0 0 5 48.851323 1.92986 0 TRITICALE BLE COLZA LUZERNE 0 06_09_2011__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 1 0 1 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 1 0 1 0 0 0 0 0 0 0 0 1 200 NR NR +0000041_SQ7JB_0034048 LA_FAISANDERIE 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 3.5 14 2 6 4 0 0 0 0 0 0 0 0.25 0 0 0 0.75 0 0 0 0.75 0.25 0 1 0 0 0 0 0 0.5 5 48.851323 1.92986 0 TRITICALE BLE COLZA LUZERNE 0 06_09_2011__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 1 0 1 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 1 0 1 0 0 0 0 0 0 0 0 1 200 NR NR +0000081_GP8M7_0034048 COIN_DU_MUR 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 2.4 12 1.75 4 5 0 0 0 0 0 0 0 0.2 0 0 0 0 0 0 0 0.2 0 0 1.8 0 0 0 0 0 0.2 18 48.842794 1.952176 1 BLE BLE MA?S TRITICALE 0 21_10_2011__00:00:00 TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 2 0 1 1 1 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000081_GP8M7_0034048 COIN_DU_MUR 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 1.25 5 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1.25 0 0 0 0 0 0 18 48.842794 1.952176 1 BLE BLE MA?S TRITICALE 0 21_10_2011__00:00:00 TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 2 0 1 1 1 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000102_GZZ77_0034048 PONTS_CAILLOUX 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 7.6 38 1.75 5 5 0 0 0 0 0 0 0 5.6 0 0 0.2 0.4 1.2 0 0 0 0 0 0.2 0 0 0 0 0 0 15 48.838493 1.92956 1 LUZERNE BLE LUZERNE LUZERNE 0 22_07_2009__00:00:00 TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000102_GZZ77_0034048 PONTS_CAILLOUX 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 7.5 30 3 6 4 0 0 0 0 0.25 0 0 1.75 0 0 0 0 0.5 0 0 0 0 0.25 1.25 0 0 3.5 0 0 0 15 48.838493 1.92956 1 LUZERNE BLE LUZERNE LUZERNE 0 22_07_2009__00:00:00 TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000161_AAWHJ_0020323 PLUMECOQ 2012 VITICULTURE AUTRE CHAMPAGNE_ARDENNE 14 42 2 4 3 0 0.333333333333333 0.333333333333333 0 0 0 0 1 0 0 0.333333333333333 0 0 0 0 0 0 0 12 0 0 0 0 0 0 10 49.016707 3.983231 1 VIGNE NR NR NR NR NR NR 0 ENHERBE NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 8 0 0 0 1 0 NR 361 CIVC 51230 EPERNRY 51 MARNE 81 AOC_CHAMPAGNE NR 0 1 1 1 0 1 0 0 1 0 0 0 0 0 500 NR NR +0000161_AAWHJ_0020323 PLUMECOQ 2013 VITICULTURE AUTRE CHAMPAGNE_ARDENNE 6.33333333333333 19 1.66666666666667 2 3 0 0.666666666666667 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2.66666666666667 3 0 0 0 0 0 10 49.016707 3.983231 1 VIGNE NR NR NR NR NR NR 0 ENHERBE NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 8 0 0 0 1 0 NR 361 CIVC 51230 EPERNRY 51 MARNE 81 AOC_CHAMPAGNE NR 0 0 1 1 0 1 0 0 1 0 0 0 0 0 500 NR NR +0000221_KP6JJ_0020518 LE_TOURNRNT 2012 VITICULTURE AUTRE CHAMPAGNE_ARDENNE 8.66666666666667 26 1.33333333333333 3 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.333333333333333 0 8 0 0 0 0 0 0.333333333333333 1 48.806863 3.339844 1 VIGNE NR NR NR NR NR NR 0 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 1 0 8 0 0 0 1 0 NR 501 EARL_THEVENET_DELOUVIN 51425 PASSY_GRIGNY 51 MARNE 81 AOC_CHAMPAGNE NR 0 0 1 1 0 0 0 0 1 0 0 0 0 0 400 NR NR +0000221_KP6JJ_0020518 LE_TOURNRNT 2013 VITICULTURE AUTRE CHAMPAGNE_ARDENNE 1.33333333333333 4 1 2 3 0 0 0 0 0 0 0 0 0 0 0.666666666666667 0 0 0 0 0 0 0 0.666666666666667 0 0 0 0 0 0 1 48.806863 3.339844 1 VIGNE NR NR NR NR NR NR 0 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 1 0 8 0 0 0 1 0 NR 501 EARL_THEVENET_DELOUVIN 51425 PASSY_GRIGNY 51 MARNE 81 AOC_CHAMPAGNE NR 0 0 1 1 0 0 0 0 1 0 0 0 0 0 400 NR NR +0000281_9HB1L_0034048 PRE_BOIS 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 11 55 3.2 6 5 0 0 0 0 0 0 0 3.6 0 0 0 0 2.2 0 0 0.2 0 0.2 3.6 1.2 0 0 0 0 0 5 48.841758 1.932056 0 LUZERNE BLE LUZERNE LUZERNE 0 16_03_2009__00:00:00 TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000281_9HB1L_0034048 PRE_BOIS 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 5.5 22 2 6 4 0 0 0 0 0 0 0 2 0 0 0 0 0 0 0 1.5 0.25 0 0.5 0.75 0 0.5 0 0 0 5 48.841758 1.932056 0 LUZERNE BLE LUZERNE LUZERNE 0 16_03_2009__00:00:00 TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000321_DEYUU_0034048 ALLEE_DE_THIVERVAL 2012 PRAIRIE CONVENTIONNELLE ILE_DE_FRANCE 1.4 7 1.5 2 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.6 0 0 0.8 0 0 0 0 0 0 4 48.847963 1.935482 0 NR NR NR NR NR NR NR NR NR 0 NR 0 0 0 0 0 0 1 0 0 NR NR NR 0 0 0 0 0 1 2 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 1 0 0 1 0 0 0 1 0 1 0 0 0 0 150 NR NR +0000341_P3BDJ_0034048 DIVISION_DU_BAS 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 1.2 6 1 2 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.4 0 0.8 0 0 0 0 0 0 9 48.848612 1.947284 0 ORGE_ESCOURGEON_D_HIVER BLE BETTERAVE BETTERAVE 0 01_03_2012__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 2 2 0 2 1 1 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000341_P3BDJ_0034048 DIVISION_DU_BAS 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 4 16 1.5 5 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.25 0.25 2.25 0 0 1 0 0 0.25 9 48.848612 1.947284 0 ORGE_ESCOURGEON_D_HIVER BLE BETTERAVE BETTERAVE 0 01_03_2012__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 2 2 0 2 1 1 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000401_GAI73_0034048 CENT_ARPENTS_OUEST 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 5.6 28 2 6 5 0 0 0 0 0 0 0.4 0.2 0 0 0 0 0 0 0 0 0.2 0.2 4.2 0 0 0 0 0 0.4 5 48.839998 1.954622 1 MAIS BLE BLE BETTERAVE 0 22_04_2012__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 0 0 0 0 1 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000401_GAI73_0034048 CENT_ARPENTS_OUEST 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 0.5 2 2 2 4 0 0 0 0 0.25 0 0 0.25 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 48.839998 1.954622 1 MAIS BLE BLE BETTERAVE 0 22_04_2012__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 0 0 0 0 1 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000421_1RUNV_0034048 ORME_OUEST 2012 PRAIRIE CONVENTIONNELLE ILE_DE_FRANCE 1.2 6 1.5 2 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0.2 0 0 0 0 0 7 48.838011 1.950846 1 NR NR NR NR NR NR NR NR NR 1 1 1 0 1 1 1 0 1 0 0 NR NR NR 0 0 0 0 0 1 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 0 0 1 0 0 0 1 0 0 0 0 200 NR NR +0000421_1RUNV_0034048 ORME_OUEST 2013 PRAIRIE CONVENTIONNELLE ILE_DE_FRANCE 2.25 9 3.5 4 4 0 0 0 0 0 0 0 0 0 0 0 0.25 0.5 0 0 0 0 0 0.5 0 0 1 0 0 0 7 48.838011 1.950846 1 NR NR NR NR NR NR NR NR NR 1 1 1 0 1 1 1 0 1 0 0 NR NR NR 0 0 0 0 0 1 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 0 0 1 0 0 1 0 0 0 0 0 150 NR NR +0000441_UPAWL_0034048 LES_MAISONS 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 2.6 13 2.33333333333333 3 5 0 0 0 0 0 0 0 1.4 0 0 0 0 0.4 0 0 0 0 0 0.8 0 0 0 0 0 0 3 48.843275 1.942391 1 BETTERAVE BETTERAVE BETTERAVE BETTERAVE 0 NR TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 1 0 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000441_UPAWL_0034048 LES_MAISONS 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 1.75 7 1.33333333333333 4 4 0 0.25 0 0 0 0 0 0.25 0 0 0 0.25 0.25 0 0 0 0 0 0.75 0 0 0 0 0 0 3 48.843275 1.942391 1 BETTERAVE BETTERAVE BETTERAVE BETTERAVE 0 NR TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 1 0 0 0 0 0 1 0 0 0 0 0 150 NR NR +0000461_KRVHA_0034048 TERRES_DE_L_EGLISE 2012 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 2.8 14 1.75 7 5 0 0 0 0 0.2 0 0 0.6 0 0 0 0.2 0.6 0 0 0.2 0.2 0 0.8 0 0 0 0 0 0 10 48.839687 1.930933 1 BLE BLE MA?S NR 0 12_10_2011__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 2 3 0 1 3 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000461_KRVHA_0034048 TERRES_DE_L_EGLISE 2013 GRANDE_CULTURE CONVENTIONNELLE ILE_DE_FRANCE 1.5 6 1.33333333333333 3 4 0 0 0 0 0 0 0 0.25 0 0 0 0 0 0 0 0 0 0 1 0 0 0.25 0 0 0 10 48.839687 1.930933 1 BLE BLE MA?S NR 0 12_10_2011__00:00:00 LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 2 3 0 1 3 0 0 NR 141 FERME_EXPERIMENTALE_DE_GRIGNON 78615 THIVERVAL_GRIGNON 78 YVELINES 102 BIODIVERSITE_EN_PLAINE_DE_VERSAILLES_ET_SUR_LE_PLATEAU_DES_ALLUETS NR 0 0 0 1 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000481_RWJBA_0034316 LYCEE 2012 PRAIRIE AUTRE POITOU_CHARENTES 35 105 5.33333333333333 9 3 6.66666666666667 0 0 5 0 0 0 0 0.333333333333333 0.333333333333333 0 0 1.33333333333333 0 5.66666666666667 0.333333333333333 0 0 11.6666666666667 2 0 0 0 0 1.66666666666667 NR NR NR 1 NR NR NR NR NR NR NR NR NR 0 NR 0 0 0 0 0 0 0 NR 1 NR NR NR 0 0 0 0 0 0 0 0 NR 821 LPH_NIORT_GASTON_CHAISSAC 79191 NIORT 79 DEUX_SEVRES 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 1 0 1 0 1 0 0 1 0 1 1 1 0 1 200 NR NR +0000483_T9XYO_0034316 EXPLOITATION 2012 AUTRE_CULTURE_PERENNE AUTRE POITOU_CHARENTES 7.33333333333333 22 1.5 2 3 5 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1.33333333333333 0 0 0 0 0 NR NR NR 0 AUTRE_CULTURE_PERENNE NR NR NR NR NR NR 2006 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 821 LPH_NIORT_GASTON_CHAISSAC 79191 NIORT 79 DEUX_SEVRES 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 0 1 1 1 0 0 0 0 1 1 1 1 0 0 200 NR NR +0000741_CAHNJ_0008239 PRE_VAUCHER 2012 GRANDE_CULTURE CONVENTIONNELLE BOURGOGNE 12 36 1.66666666666667 3 3 0 0 0 0 0 0 0 0 0 0 0 0 0.333333333333333 0 0 0 0 0 11.3333333333333 0 0 0.333333333333333 0 0 0 9 NR NR 1 ORGE_ESCOURGEON_D_HIVER LUZERNE AUTRE_GRANDE_CULTURE AUTRE_GRANDE_CULTURE 0 NR LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 1 0 0 2 0 0 NR 741 FERME_DE_L_EPLEFPA_DE_DIJON_QUETIGNY 21622 TART_LE_BAS 21 COTE_D_OR 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 0 0 1 0 1 0 0 0 1 0 0 0 0 0 200 NR NR +0000741_CAHNJ_0008239 PRE_VAUCHER 2012 GRANDE_CULTURE CONVENTIONNELLE BOURGOGNE 12 36 1.66666666666667 3 3 0 0 0 0 0 0 0 0 0 0 0 0 0.333333333333333 0 0 0 0 0 11.3333333333333 0 0 0.333333333333333 0 0 0 9 NR NR 1 BETTERAVE LUZERNE AUTRE_GRANDE_CULTURE AUTRE_GRANDE_CULTURE 0 NR LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 1 0 0 2 0 0 NR 741 FERME_DE_L_EPLEFPA_DE_DIJON_QUETIGNY 21622 TART_LE_BAS 21 COTE_D_OR 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 0 0 1 0 1 0 0 0 1 0 0 0 0 0 200 NR NR +0000741_CAHNJ_0008239 PRE_VAUCHER 2013 GRANDE_CULTURE CONVENTIONNELLE BOURGOGNE 6 12 1 1 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0 0 9 NR NR 1 BETTERAVE LUZERNE AUTRE_GRANDE_CULTURE AUTRE_GRANDE_CULTURE 0 NR LABOUR_PROFOND NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 1 1 0 0 2 0 0 NR 741 FERME_DE_L_EPLEFPA_DE_DIJON_QUETIGNY 21622 TART_LE_BAS 21 COTE_D_OR 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 0 0 1 0 1 0 0 0 0 0 0 0 0 1 200 NR NR +0000762_GXPFC_0008239 VAL_DES_CHOUX 2012 GRANDE_CULTURE AUTRE BOURGOGNE 8 24 1.66666666666667 3 3 0 0.666666666666667 0 0 0 0 0 0 0 0 0 0.333333333333333 0 0 0 0 0 0 6.66666666666667 0 0 0 0 0 0.333333333333333 9 NR NR 1 BLE LUZERNE POIS AUTRE_GRANDE_CULTURE 0 NR TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 1 0 0 3 0 0 NR 741 FERME_DE_L_EPLEFPA_DE_DIJON_QUETIGNY 21622 TART_LE_BAS 21 COTE_D_OR 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 0 1 1 0 0 0 0 1 1 0 0 0 0 0 500 NR NR +0000762_GXPFC_0008239 VAL_DES_CHOUX 2013 GRANDE_CULTURE AUTRE BOURGOGNE 4 8 1 1 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 9 NR NR 1 BETTERAVE LUZERNE POIS AUTRE_GRANDE_CULTURE 0 NR TRAVAIL_SUPERFICIEL NR NR NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 1 0 0 3 0 0 NR 741 FERME_DE_L_EPLEFPA_DE_DIJON_QUETIGNY 21622 TART_LE_BAS 21 COTE_D_OR 161 RESEAU_BIODIVERSITE_DE_L_ENSEIGNEMENT_AGRICOLE NR 0 1 1 0 1 0 0 0 0 0 0 0 0 1 260 NR NR +0000801_XW4CV_0020212 ROMMES 2012 VITICULTURE CONVENTIONNELLE CHAMPAGNE_ARDENNE 0.5 2 1 1 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.5 0 0 0 0 0 0 0 0 1 49.079959 3.980602 0 VIGNE NR NR NR NR NR NR 0 ENHERBE NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 1 0 15 0 0 0 0 0 NR 1181 CHAMPAGNE_PASCAL_AUTREAU 51119 CHAMPILLON 51 MARNE 81 AOC_CHAMPAGNE NR 0 0 1 0 0 0 0 0 0 0 1 0 0 0 400 NR NR +0000821_Z68LT_0020705 BOUVERIES 2012 VITICULTURE BIOLOGIQUE CHAMPAGNE_ARDENNE 0 0 0 0 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 48.907622 3.997006 0 VIGNE NR NR NR NR NR NR 0 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 21 0 0 0 1 0 NR 1221 SARL_ST_GEORGES 51612 VERTUS 51 MARNE 81 AOC_CHAMPAGNE NR 0 0 1 0 0 0 0 0 0 0 0 0 0 1 200 NR NR +0000821_Z68LT_0020705 BOUVERIES 2013 VITICULTURE BIOLOGIQUE CHAMPAGNE_ARDENNE 0 0 0 0 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 48.907622 3.997006 0 VIGNE NR NR NR NR NR NR 0 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 21 0 0 0 1 0 NR 1221 SARL_ST_GEORGES 51612 VERTUS 51 MARNE 81 AOC_CHAMPAGNE NR 0 0 0 1 0 0 1 0 1 0 0 0 0 0 200 NR NR +0000861_YLFNP_0003662 SIMORGES 2012 VITICULTURE CONVENTIONNELLE CHAMPAGNE_ARDENNE 4.66666666666667 14 3 5 3 0 0 0 0 0 0.666666666666667 1 0 0 0 0 0 0.666666666666667 0 0 0 0.333333333333333 0 2 0 0 0 0 0 0 1 48.043963 4.387783 1 VIGNE NR NR NR NR NR NR 0 SOL_NU NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 11 0 0 0 1 0 NR 1281 VALENTIN_BOEUF 10262 NEUVILLE_SUR_SEINE 10 AUBE 81 AOC_CHAMPAGNE NR 1 0 0 1 0 0 0 0 0 1 1 0 0 0 300 NR NR +0000861_YLFNP_0003662 SIMORGES 2013 VITICULTURE CONVENTIONNELLE CHAMPAGNE_ARDENNE 9 27 3 6 3 0 0 0 0 0.333333333333333 1.66666666666667 0 0 0 0 1.33333333333333 0 3.33333333333333 0 0 0 0.333333333333333 0 2 0 0 0 0 0 0 1 48.043963 4.387783 1 VIGNE NR NR NR NR NR NR 0 SOL_NU NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 11 0 0 0 1 0 NR 1281 VALENTIN_BOEUF 10262 NEUVILLE_SUR_SEINE 10 AUBE 81 AOC_CHAMPAGNE NR 1 0 0 0 0 1 0 0 1 0 1 0 0 0 400 NR NR +0000861_YLFNP_0003662 SIMORGES 2014 VITICULTURE CONVENTIONNELLE CHAMPAGNE_ARDENNE 5.33333333333333 32 6 7 6 0 0 0 0 0 1.66666666666667 0 1.33333333333333 0 0 0.333333333333333 0.333333333333333 1 0 0 0 0.333333333333333 0 0.333333333333333 0 0 0 0 0 0 1 48.043963 4.387783 1 VIGNE NR NR NR NR NR NR 1990 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 NR NR NR NR NR NR 0 0 8 0 0 0 0 1 0 1281 VALENTIN_BOEUF 10262 NEUVILLE_SUR_SEINE 10 AUBE 81 AOC_CHAMPAGNE NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR +0000861_YLFNP_0003662 SIMORGES 2015 VITICULTURE CONVENTIONNELLE CHAMPAGNE_ARDENNE 9 54 6.66666666666667 6 6 0 0 0 0 0 1 0 0.666666666666667 0 0 3.66666666666667 0 2.66666666666667 0 0 0 0 0 0 0 0 0 0.333333333333333 0 0.666666666666667 1 48.043963 4.387783 1 VIGNE NR NR NR NR NR NR 1990 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 NR NR NR NR NR NR 0 0 8 0 0 0 0 1 0 1281 VALENTIN_BOEUF 10262 NEUVILLE_SUR_SEINE 10 AUBE 81 AOC_CHAMPAGNE NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR +0000861_YLFNP_0003662 SIMORGES 2016 VITICULTURE CONVENTIONNELLE CHAMPAGNE_ARDENNE 7.75 62 7 6 8 0 0 0 0 0 0.5 1 0.75 0 0 1 0 0 0 0 0 0 0 3.5 0 0 0 1 0 0 1 48.043963 4.387783 1 VIGNE NR NR NR NR NR NR 1990 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 NR NR NR NR NR NR 0 0 8 0 0 0 0 1 0 1281 VALENTIN_BOEUF 10262 NEUVILLE_SUR_SEINE 10 AUBE 81 AOC_CHAMPAGNE NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR +0000961_SVT8E_0032212 DUFOUR___BANDE_ENHERBEE 2012 AUTRE_CULTURE_PERENNE CONVENTIONNELLE HAUTE_NORMANDIE 1.33333333333333 4 1.5 2 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.333333333333333 0 1 0 0 0 0 0 0 NR 49.710629 1.001451 1 AUTRE_CULTURE_PERENNE NR NR NR NR NR NR 2010 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 1301 EXPLOITATION_DUFOUR 76072 BELLEVILLE_EN_CAUX 76 SEINE_MARITIME NR NR NR 0 0 1 0 0 0 0 0 1 0 0 0 0 0 300 NR NR +0000961_SVT8E_0032212 DUFOUR___BANDE_ENHERBEE 2013 AUTRE_CULTURE_PERENNE CONVENTIONNELLE HAUTE_NORMANDIE 4.25 17 2 4 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1.75 2 0 0 0.25 0 0 0.25 NR 49.710629 1.001451 1 AUTRE_CULTURE_PERENNE NR NR NR NR NR NR 2010 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 0 0 0 0 0 0 0 0 NR 1301 EXPLOITATION_DUFOUR 76072 BELLEVILLE_EN_CAUX 76 SEINE_MARITIME NR NR NR 0 0 1 0 0 0 0 0 1 0 0 0 0 0 200 NR NR +0000981_1NR7R_0022897 NR 2012 NR NR BRETAGNE 0.285714285714286 2 2 2 7 0 0 0.142857142857143 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.142857142857143 NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR 1321 PHILIPPE_LECOMTE 56127 MAURON 56 MORBIHAN NR NR NR 0 0 0 1 0 1 0 0 1 0 0 0 0 0 250 NR NR +0000981_1NR7R_0022897 NR 2013 NR NR BRETAGNE 3.14285714285714 22 2.5 7 7 0 0 0.285714285714286 0 0.142857142857143 0 0 0 0 0 0 0 0 0 0.142857142857143 0.857142857142857 0.285714285714286 0 1.14285714285714 0 0 0.285714285714286 0 0 0 NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR 1321 PHILIPPE_LECOMTE 56127 MAURON 56 MORBIHAN NR NR NR 0 0 0 1 0 1 0 0 1 0 0 0 0 0 200 NR NR +0001001_APLV0_0032212 DUFOUR___SAULE 2013 AUTRE_CULTURE_PERENNE CONVENTIONNELLE HAUTE_NORMANDIE 2 8 1.33333333333333 2 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0.25 1.75 0 0 0 0 0 0 NR 49.709951 0.994563 1 NR NR NR NR NR NR NR 2011 ENHERBE NR NR 0 0 0 0 0 0 NR NR NR NR NR NR 0 0 0 0 0 0 0 0 NR 1301 EXPLOITATION_DUFOUR 76072 BELLEVILLE_EN_CAUX 76 SEINE_MARITIME NR NR NR 0 1 0 0 0 0 0 0 1 0 0 0 0 0 200 NR NR +0001081_K0M8I_0022897 PRAIRIE_BOCAGERE 2012 PRAIRIE BIOLOGIQUE BRETAGNE 12.1428571428571 85 2 6 7 0 0 0.285714285714286 0 0 0.571428571428571 0 0.142857142857143 0 0 0 0 0.142857142857143 0 0 8.71428571428571 0 0 0 2.28571428571429 0 0 0 0 0 1 48.049693 _2.253292 0 NR NR NR NR NR NR NR NR NR 1 NR 0 0 1 0 0 1 1 0 0 NR NR NR 0 0 0 0 0 0 0 0 NR 1401 SEBASTIEN_SALMON 56127 MAURON 56 MORBIHAN NR NR NR 0 1 0 1 0 0 0 0 1 1 1 0 0 0 250 NR NR +0001081_K0M8I_0022897 PRAIRIE_BOCAGERE 2013 PRAIRIE BIOLOGIQUE BRETAGNE 6.14285714285714 43 2 6 7 0 0.142857142857143 0.285714285714286 0 0 0.285714285714286 0 0 0 0 0 0 0 0 0.142857142857143 4.71428571428571 0 0 0.428571428571429 0.142857142857143 0 0 0 0 0 1 48.049693 _2.253292 0 NR NR NR NR NR NR NR NR NR 1 NR 0 0 1 0 0 1 1 0 0 NR NR NR 0 0 0 0 0 0 0 0 NR 1401 SEBASTIEN_SALMON 56127 MAURON 56 MORBIHAN NR NR NR 0 0 1 0 0 0 0 0 1 0 0 0 0 0 200 NR NR +0001201_V8E17_0001207 COURCELLES 2012 VITICULTURE AUTRE PICARDIE 11.25 45 2 4 4 0 0 0 0 0 0.5 0 0 0 0 0 0 0 0 0 0.5 1.5 0 8.75 0 0 0 0 0 0 1 49.065745 3.59084 0 VIGNE NR NR NR NR NR NR 0 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 1 3 8 0 0 0 1 0 NR 881 EARL_CHAMPAGNE_JAMES_KOHLER 2748 TRELOU_SUR_MARNE 2 AISNE 81 AOC_CHAMPAGNE NR 0 0 1 1 0 0 0 0 0 0 0 1 0 0 400 NR NR +0001201_V8E17_0001207 COURCELLES 2013 VITICULTURE AUTRE PICARDIE 4 16 2.33333333333333 5 4 0 0.25 0 0 0 0 0 0 0 0 0 0 0 0 0 0.5 0.5 0.25 2.25 0 0 0.25 0 0 0 1 49.065745 3.59084 0 VIGNE NR NR NR NR NR NR 0 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 0 NR 0 NR NR NR 1 3 8 0 0 0 1 0 NR 881 EARL_CHAMPAGNE_JAMES_KOHLER 2748 TRELOU_SUR_MARNE 2 AISNE 81 AOC_CHAMPAGNE NR 0 0 1 1 0 0 0 0 1 0 0 0 0 0 500 NR NR +0001201_V8E17_0001207 COURCELLES 2014 VITICULTURE AUTRE PICARDIE 4.2 42 3 4 10 0 0.2 0 0 0 0 0 0.2 0 0 0 0 0 0 0 0.2 0 1.2 2.4 0 0 0 0 0 0 0.25 49.065745 3.59084 1 VIGNE NR NR NR NR NR NR 1989 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 NR NR NR NR NR NR 1 3 7 0 0 0 0 1 0 881 EARL_CHAMPAGNE_JAMES_KOHLER 2748 TRELOU_SUR_MARNE 2 AISNE 81 AOC_CHAMPAGNE NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR +0001201_V8E17_0001207 COURCELLES 2015 VITICULTURE AUTRE PICARDIE 2.5 20 3 4 8 0 0 0 0 0 0 0 0.5 0 0 0 0 0 0 0.5 0.75 0 0 0.75 0 0 0 0 0 0 0.25 49.065745 3.59084 1 VIGNE NR NR NR NR NR NR 1989 ENHERBE_PARTIELLEMENT NR NR 0 0 0 0 0 0 NR NR NR NR NR NR 1 3 6 0 0 0 0 1 0 881 EARL_CHAMPAGNE_JAMES_KOHLER 2748 TRELOU_SUR_MARNE 2 AISNE 81 AOC_CHAMPAGNE NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR NR
--- a/butterfly_crossplot.R Mon Aug 13 10:06:35 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,556 +0,0 @@ -################################################################## -#### Script generique pour realiser les figures en croix ###### -#### a partir des donnees brut ###### -################################################################## - -### Version V1.2 _ 2018-07-31 - -library(ggplot2) -library(RColorBrewer) - -args <- commandArgs(trailingOnly = TRUE) - -### importation code -sourcefunctions<-args[1] -source(sourcefunctions) - -## fonction d'importation des fichier des donnes -### fonction d'importation, de concatenation des fichiers -### verification des nom de colonnes -### verification des doublon de ligne -read.data <- function(file=NULL,decimalSigne=".") { -# cat("1) IMPORTATION \n--------------\n") -# cat("<--",file,"\n") - data <- read.table(file,sep="\t",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) - ## verification qu'il y a plusieur colonnes et essaye different separateur - if(ncol(data)==1) { - data <- read.table(file,sep=";",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) - if(ncol(data)==1) { - data <- read.table(file,sep=",",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) - if(ncol(data)==1) { - data <- read.table(file,sep=" ",stringsAsFactors=FALSE,header=TRUE,dec=decimalSigne) - if(ncol(data)==1) { - stop("!!!! L'importation a echoue\n les seperatateurs de colonne utilise ne sont pas parmi ([tabulation], ';' ',' [espace])\n -> veuillez verifier votre fichier de donnees\n") - } - } - } - } - return(data) -} - - - - - -filtre1niveau <- function(func, - nom_fichier = filename, - dec=".", - nom_fichierCouleur= color_filename, - col_abscisse = "AB_MOYENNE", - figure_abscisse = "Abondance", - col_ordonnee = "DIVERSITE_MOYENNE", - figure_ordonnee = "Diversite", - nomGenerique="GLOBAL", - vec_figure_titre = c("Les Papillons"), - colourProtocole = TRUE, - nomProtocole = "Papillons", - vec_col_filtre = vec_col_filtre_usr, - col_sousGroup = NULL,# - val_filtre = NULL,# - figure_nom_filtre = NULL,# - bagplot = TRUE, - bagProp=c(.05,.5,.95), - seuilSegment=30, - segmentSousSeuil=TRUE, - forcageMajusculeFiltre=TRUE, - forcageMajusculeSousGroupe=TRUE){ - - dCouleur <- read.data(file=nom_fichierCouleur) - d <- read.data(file=nom_fichier,decimalSigne=dec) - if(colourProtocole & !is.null(nomProtocole)) colourProtocole_p <- as.character(dCouleur[dCouleur[,2]==nomProtocole,3]) else colourProtocole_p <- NULL - - for(f in 1:length(vec_col_filtre)) { - if(length(vec_figure_titre)==1){ - figure_titre_f <- vec_figure_titre - }else{ - figure_titre_f <- vec_figure_titre[f] - } - col_filtre_f <- vec_col_filtre[f] - #cat(col_sousGroup) #Just to check - if(func=="ggfiltre1niveau"){ - #cat("ggfiltre1niveau") - ggfiltre1niveau(d, - col_abscisse, - figure_abscisse, - col_ordonnee, - figure_ordonnee, - figure_titre = figure_titre_f, - col_filtre = col_filtre_f, - nomGenerique, - val_filtre = NULL, - figure_nom_filtre = NULL, - tab_figure_couleur= subset(dCouleur,Filtre==col_filtre_f), - colourProtocole = colourProtocole_p, - nomProtocole, - bagplot, - bagProp=c(.05,.5,.95), - seuilSegment, - segmentSousSeuil, - forcageMajusculeFiltre) - }else if(func=="gglocal"){ - #cat("gglocal") - gglocal(d, - col_abscisse, - figure_abscisse, - col_ordonnee, - figure_ordonnee, - figure_titre = figure_titre_f, - col_filtre = col_filtre_f, - nomGenerique = nomGenerique, - col_sousGroup = col_sousGroup, - val_filtre = NULL, - figure_nom_filtre = NULL, - tab_figure_couleur= subset(dCouleur,Filtre==col_filtre_f), - colourProtocole = colourProtocole_p, - nomProtocole, - couleurLocal="#f609c1", - bagplot, - bagProp, - seuilSegment, - segmentSousSeuil, - forcageMajusculeFiltre, - forcageMajusculeSousGroupe) - }else{ - #cat("ggCompareLevel") - ggCompareLevel(d, - col_abscisse, - figure_abscisse, - col_ordonnee, - figure_ordonnee, - figure_titre = figure_titre_f, - col_filtre = col_filtre_f, - nomGenerique = nomGenerique, - val_filtre = NULL, - figure_nom_filtre = NULL, - tab_figure_couleur= subset(dCouleur,Filtre==col_filtre_f), - colourProtocole = colourProtocole_p, - nomProtocole, - bagplot, - bagProp, - seuilSegment, - segmentSousSeuil, - forcageMajusculeFiltre) - } - } -} - -ggfiltre1niveau <- function(d, - col_abscisse = "AB_MOYENNE", - figure_abscisse = "Abondance", - col_ordonnee = "DIVERSITE_MOYENNE", - figure_ordonnee = "Diversite", - figure_titre = "Referentiel papillon", - col_filtre = "nom_reseau", - nomGenerique = "Global", - val_filtre = NULL, - figure_nom_filtre = NULL, - tab_figure_couleur= NULL, - colourProtocole = NULL, - nomProtocole = NULL, - bagplot = TRUE, - bagProp=c(.05,.5,.95), - seuilSegment=30, - segmentSousSeuil=TRUE, - forcageMajusculeFiltre=TRUE, - result_dir="resultats/") { - - d$groupe <- as.character(d[,col_filtre]) - d$abscisse <- d[,col_abscisse] - d$ordonnee <- d[,col_ordonnee] - d$groupe <-gsub("/","_",d$groupe) - d$groupe <-gsub("!","",d$groupe) - - if(forcageMajusculeFiltre){ - d$groupe <- toupper(d$groupe)} - - d <- subset(d,!(is.na(groupe)) & !(is.na(abscisse)) & !(is.na(ordonnee)) & groupe != "") - - if(is.null(val_filtre)){ - lesModalites <- unique(d$groupe) - }else{ - lesModalites <- val_filtre - } - -# repResult <- dir(result_dir) -# current_dir<-getwd() -# dir.create(file.path(current_dir,result_dir)) -# -# if(!(col_filtre %in% repResult)){ -# dir.create(file.path(".",paste(result_dir,col_filtre,sep="")))} -# -# nomRep1 <- paste(result_dir,col_filtre,"/",sep="") - - d.autre <- d - d.autre$groupe <- nomGenerique - - for(m in lesModalites) { - d.reseau <- subset(d,groupe==m) - d.reseau$groupe <- m - ggTable <- rbind(d.autre,d.reseau) - - seuilResum <- nrow(d.reseau) >= seuilSegment - - ggTableResum <- aggregate(cbind(ordonnee, abscisse) ~ groupe, data = ggTable,quantile, c(.25,.5,.75)) - ggTableResum <- data.frame(ggTableResum[,1],ggTableResum[,2][,1:3],ggTableResum[,3][,1:3]) - colnames(ggTableResum) <- c("groupe","ordonnee.inf","ordonnee.med","ordonnee.sup","abscisse.inf","abscisse.med","abscisse.sup") - - if(ggTableResum$groupe[2]==nomGenerique){ - ggTableResum <- ggTableResum[c(2,1),]} - - if(!(is.null(tab_figure_couleur))) { - if(m %in% tab_figure_couleur$Modalite) { - figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), - as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == m])), - c(nomGenerique,m)) - }else{ - figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), - as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == ""])), - c(nomGenerique,m)) - } - } - -# repResult <- dir(nomRep1) -# if(!(m %in% repResult)){ -# dir.create(paste(nomRep1,m,sep=""))} -# nomRep <- paste(nomRep1,m,"/",sep="") -# -# -# if(!is.null(nomProtocole)){ -# repResult <- dir(nomRep) -# if(!(nomProtocole %in% repResult)){ -# dir.create(paste(nomRep,nomProtocole,sep=""))} -# nomRep <- paste(nomRep,nomProtocole,"/",sep="") -# } - - - gg <- ggplot(ggTable,aes(x=abscisse,y=ordonnee,colour=groupe,fill=groupe)) - if(bagplot){ - gg <- gg + stat_bag(data=d.autre,prop=bagProp[1],colour=NA,alpha=.7) + stat_bag(data=d.autre,prop=bagProp[2],colour=NA,alpha=.4) + stat_bag(data=d.autre,prop=bagProp[3],colour=NA,alpha=.2) } - else { - gg <- gg + geom_point(alpha=.2) - } - gg <- gg + geom_hline(data=subset(ggTableResum,groupe== nomGenerique),aes(yintercept = ordonnee.med,colour=groupe),size=.5,linetype="dashed") + geom_vline(data=subset(ggTableResum,groupe==nomGenerique),aes(xintercept = abscisse.med,colour=groupe),size=.5,linetype="dashed") - if(segmentSousSeuil) { - gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size=2.5) - gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size=2.5) - if(!(seuilResum)) { - gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.5,size = 1.5,colour="white") - gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.5,size = 1.5,colour="white") - } - } else { - gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size = 2.5) - gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size = 2.5) - } - - gg <- gg + geom_point(data=d.reseau,size=2) - gg <- gg + labs(list(title=figure_titre,x=figure_abscisse,y=figure_ordonnee)) - - if(!is.null(colourProtocole)){ - gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA), axis.ticks = element_line(colour = colourProtocole, size = 1), axis.ticks.length = unit(0.3, "cm"),plot.title = element_text(colour = colourProtocole)) - }else{ - gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA)) - } - - if(!(is.null(tab_figure_couleur))){ - gg <- gg + scale_colour_manual(values = figure_couleur,name = "") + scale_fill_manual(values = figure_couleur,name = "",guide=FALSE)} - - ggfile <- paste(nomRep,nomProtocole,"_",m,".png",sep="") - #cat("Check",ggfile,":") - ggsave(ggfile,gg) - #cat("\n") - flush.console() - } -} - - -############################################################## -gglocal <- function(d, - col_abscisse = "AB_MOYENNE", - figure_abscisse = "Abondance", - col_ordonnee = "DIVERSITE_MOYENNE", - figure_ordonnee = "Diversite", - figure_titre = "Graphe referentiel", - col_filtre = "NOM_RESEAU", - nomGenerique = "GLOBAL", - col_sousGroup = "PARCELLEID", - val_filtre = NULL, - figure_nom_filtre = NULL, - tab_figure_couleur= NULL, - colourProtocole = NULL, - nomProtocole = NULL, - couleurLocal="#f609c1", - bagplot = TRUE, - bagProp=c(.05,.5,.95), - seuilSegment=30, - segmentSousSeuil=TRUE, - forcageMajusculeFiltre=TRUE, - forcageMajusculeSousGroupe=TRUE) { - - d$groupe <- d[,col_filtre] - d$abscisse <- d[,col_abscisse] - d$ordonnee <- d[,col_ordonnee] - d$sousGroup <- d[,col_sousGroup] - d$groupe <-gsub("/","_",d$groupe) - d$groupe <-gsub("!","",d$groupe) - d$sousGroup <-gsub("/","_",d$sousGroup) - d$sousGroup <-gsub("!","",d$sousGroup) - if(forcageMajusculeFiltre){ - d$groupe <- toupper(d$groupe)} - if(forcageMajusculeSousGroupe){ - d$sousGroup <- toupper(d$sousGroup)} - d <- subset(d,!(is.na(groupe)) & !(is.na(sousGroup)) & !(is.na(abscisse)) & !(is.na(ordonnee)) & groupe != "") - vecSousGroup <- as.character(unique(d$sousGroup)) - if(is.null(val_filtre)){ - lesModalites <- unique(d$groupe)} - else{ lesModalites <- val_filtre} - repResult <- dir("resultats/") -# if(!(col_filtre %in% repResult)){ -# dir.create(paste("resultats/",col_filtre,sep=""))} -# nomRep1 <- paste("resultats/",col_filtre,"/",sep="") - d.autre <- d - d.autre$groupe <- nomGenerique - for(m in lesModalites) { - d.reseau <- subset(d,groupe==m) - d.reseau$groupe <- m - ggTable <- rbind(d.autre,d.reseau) - seuilResum <- nrow(d.reseau) >= seuilSegment - ggTableResum <- aggregate(cbind(ordonnee, abscisse) ~ groupe, data = ggTable,quantile, c(.25,.5,.75)) - ggTableResum <- data.frame(ggTableResum[,1],ggTableResum[,2][,1:3],ggTableResum[,3][,1:3]) - colnames(ggTableResum) <- c("groupe","ordonnee.inf","ordonnee.med","ordonnee.sup","abscisse.inf","abscisse.med","abscisse.sup") - if(ggTableResum$groupe[2]==nomGenerique){ - ggTableResum <- ggTableResum[c(2,1),]} - if(!(is.null(tab_figure_couleur))) { - if(m %in% tab_figure_couleur$Modalite) { - figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), - as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == m]),couleurLocal), - c(nomGenerique,m,"")) - } else { - figure_couleur <- setNames(c(as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == nomGenerique]), - as.character(tab_figure_couleur$couleur[tab_figure_couleur$Modalite == ""]),couleurLocal), - c(nomGenerique,m,"")) - } - } -# repResult <- dir(nomRep1) -# if(!(m %in% repResult)){ -# dir.create(paste(nomRep1,m,sep=""))} -# nomRep <- paste(nomRep1,m,"/",sep="") -# if(!is.null(nomProtocole)) { -# repResult <- dir(nomRep) -# if(!(nomProtocole %in% repResult)){ -# dir.create(paste(nomRep,nomProtocole,sep=""))} -# nomRep <- paste(nomRep,nomProtocole,"/",sep="") -# } - d.reseau <- subset(d.reseau, !(is.na(sousGroup))) - figure_size<- setNames(c(1,3,2.5), c(nomGenerique,m,"")) - figure_shape<- setNames(c(16,16,20), c(nomGenerique,m,"")) - vecSousGroup <- as.character(unique(d.reseau$sousGroup)) - for(p in vecSousGroup) { - dp <- subset(d.reseau,sousGroup == p) - dp$groupe <- dp$sousGroup - ggTableSous <- rbind(d.reseau,dp) - ggTableSous <- rbind(d.autre,d.reseau,dp) - names(figure_couleur)[3] <- p - names(figure_shape)[3] <- p - names(figure_size)[3] <- p - gg <- ggplot(ggTableSous,aes(x=abscisse,y=ordonnee,colour=groupe,fill=groupe,shape=groupe,size=groupe)) - if(bagplot){ - gg <- gg + stat_bag(data=d.autre,prop=bagProp[1],colour=NA,alpha=.7) + stat_bag(data=d.autre,prop=bagProp[2],colour=NA,alpha=.4) + stat_bag(data=d.autre,prop=bagProp[3],colour=NA,alpha=.2) - }else{ - gg <- gg + geom_point(alpha=.2)} - gg <- gg + geom_hline(data=subset(ggTableResum,groupe == nomGenerique),aes(yintercept = ordonnee.med,colour=groupe),size=.5,linetype="dashed") - gg <- gg + geom_vline(data=subset(ggTableResum,groupe == nomGenerique),aes(xintercept = abscisse.med,colour=groupe),size=.5,linetype="dashed") - if(segmentSousSeuil) { - gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size=2.5) - gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size=2.5) - if(!(seuilResum)) { - gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.5,size = 1.5,colour="white") - gg <- gg + geom_segment(data=subset(ggTableResum,groupe!=nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.5,size = 1.5,colour="white") - } - } else { - gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.8,size = 2.5) - gg <- gg + geom_segment(data=subset(ggTableResum,groupe==nomGenerique),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.8,size = 2.5) - } - gg <- gg + geom_point(data=subset(ggTableSous,groupe != nomGenerique)) - if(!(is.null(tab_figure_couleur))){ - gg <- gg + scale_colour_manual(values = figure_couleur,name = "") + scale_fill_manual(values = figure_couleur,name = "",guide=FALSE)} - gg <- gg + scale_shape_manual(values = figure_shape,name = "",guide=FALSE) + scale_size_manual(values = figure_size,guide=FALSE) - gg <- gg + labs(list(title=figure_titre,x=figure_abscisse,y=figure_ordonnee)) - if(!is.null(colourProtocole)){ - gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA), axis.ticks = element_line(colour = colourProtocole, size = 1), axis.ticks.length = unit(0.3, "cm"),plot.title = element_text(colour = colourProtocole)) } - else{ - gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA))} - ggfile <- paste(nomRep,nomProtocole,"_",m,"-",p,".png",sep="") - #cat("Check",ggfile,":") - ggsave(ggfile,gg) - #cat("\n") - flush.console() - } - } -} - - - -##################################################### -ggCompareLevel <- function(d, - col_abscisse = "abond_moyenne", - figure_abscisse = "Abondance", - col_ordonnee = "diversite_moyenne", - figure_ordonnee = "Diversite", - figure_titre = "Rhooo il dechire ce graphe", - col_filtre = "nom_reseau", - nomGenerique = "Global", - val_filtre = NULL, - figure_nom_filtre = NULL, - tab_figure_couleur= NULL, - colourProtocole = NULL, - nomProtocole = NULL, - bagplot = TRUE, - bagProp=c(.05,.5,.95), - seuilSegment=30, - segmentSousSeuil=FALSE, - forcageMajusculeFiltre=TRUE){ - - d$groupe <- d[,col_filtre] - d$abscisse <- d[,col_abscisse] - d$ordonnee <- d[,col_ordonnee] - d$groupe <-gsub("/","_",d$groupe) - d$groupe <-gsub("!","",d$groupe) - - if(forcageMajusculeFiltre){ - d$groupe <- toupper(d$groupe)} - d <- subset(d,!(is.na(groupe)) & !(is.na(abscisse)) & !(is.na(ordonnee)) & groupe != "") - if(is.null(val_filtre)){ - lesModalites <- unique(d$groupe) - }else{ - lesModalites <- val_filtre - } -# repResult <- dir("resultats/") -# if(!(col_filtre %in% repResult)){ -# dir.create(paste("resultats/",col_filtre,sep="")) -# } -# if(!is.null(nomProtocole)){ -# repResult <- dir(paste("resultats/",col_filtre,sep="")) -# if(!(nomProtocole %in% repResult)){ -# dir.create(paste("resultats/",col_filtre,"/",nomProtocole,sep=""))} -# nomRep <- paste("resultats/",col_filtre,"/",nomProtocole,"/",sep="") -# }else{ -# nomRep <- paste("resultats/",col_filtre,"/",sep="") -# } - d.autre <- d - d.autre$groupe <- nomGenerique - d.reseau <- subset(d,groupe %in% lesModalites) - ggTable <- rbind(d.autre,d.reseau) - ggTableResum <- aggregate(cbind(ordonnee, abscisse) ~ groupe, data = ggTable,quantile, c(.25,.5,.75)) - ggTableResum <- data.frame(ggTableResum[,1],ggTableResum[,2][,1:3],ggTableResum[,3][,1:3]) - colnames(ggTableResum) <- c("groupe","ordonnee.inf","ordonnee.med","ordonnee.sup","abscisse.inf","abscisse.med","abscisse.sup") - ggSeuil <- aggregate(ordonnee ~ groupe, data=ggTable,length) - ggSeuil$seuilResum <- ggSeuil$ordonnee >= seuilSegment - colnames(ggSeuil)[ncol(ggSeuil)] <- "seuil" - ggTableResum <- merge(ggTableResum,ggSeuil,by="groupe") - t_figure_couleur <- subset(tab_figure_couleur,Modalite %in% c(nomGenerique,lesModalites)) - modaliteSansCouleur <- lesModalites[(!(lesModalites %in% t_figure_couleur$Modalite))] - nbNxCol <- length(modaliteSansCouleur) - mypalette<-brewer.pal(nbNxCol,"YlGnBu") - figure_couleur <- setNames(c(as.character(t_figure_couleur$couleur),mypalette),c(as.character(t_figure_couleur$Modalite),modaliteSansCouleur)) - tab_coul <- data.frame(groupe=names(figure_couleur),couleur=figure_couleur) - tab_coul <- merge(tab_coul,ggTableResum,"groupe") - tab_coul$nom <- paste(tab_coul$groupe," (",tab_coul$ordonnee,")",sep="") - figure_couleur <- setNames(as.character(tab_coul$couleur),tab_coul$groupe) - figure_couleur_nom<- tab_coul$nom - gg <- ggplot(ggTable,aes(x=abscisse,y=ordonnee,colour=groupe,fill=groupe)) - if(bagplot){ - gg <- gg + stat_bag(data=d.autre,prop=bagProp[1],colour=NA,alpha=.7) + stat_bag(data=d.autre,prop=bagProp[2],colour=NA,alpha=.4) + stat_bag(data=d.autre,prop=bagProp[3],colour=NA,alpha=.2) - }else{ - gg <- gg + geom_point(alpha=.2) - } - gg <- gg + geom_hline(data=subset(ggTableResum,groupe=="Autre"),aes(yintercept = ordonnee.med,colour=groupe),size=.5,linetype="dashed") + geom_vline(data=subset(ggTableResum,groupe=="Autre"),aes(xintercept = abscisse.med,colour=groupe),size=.5,linetype="dashed") - gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.7,size = 2.5) - gg <- gg + geom_segment(data=ggTableResum,aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.7,size = 2.5) - if(any(ggTableResum$seuil)){ - gg <- gg + geom_segment(data=subset(ggTableResum,!(seuil)),aes(x = abscisse.med, y = ordonnee.inf, xend = abscisse.med, yend = ordonnee.sup),alpha=.5,size = 1.5,colour="white") - gg <- gg + geom_segment(data=subset(ggTableResum,!(seuil)),aes(x = abscisse.inf, y = ordonnee.med, xend = abscisse.sup, yend = ordonnee.med),alpha=.5,size = 1.5,colour="white") - } - - #browser() # gg <- gg + geom_point(data=d.reseau,size=2) - gg <- gg + scale_colour_manual(values = figure_couleur,name = "",labels = figure_couleur_nom) + scale_fill_manual(values = figure_couleur,name = "",guide=FALSE) - gg <- gg + labs(list(title=figure_titre,x=figure_abscisse,y=figure_ordonnee)) - if(!is.null(colourProtocole)){ - gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA), axis.ticks = element_line(colour = colourProtocole, size = 1), axis.ticks.length = unit(0.3, "cm"),plot.title = element_text(colour = colourProtocole)) - }else{ - gg <- gg + theme(legend.justification=c(1,0), legend.position=c(1,0),legend.text = element_text(size = 7),legend.background = element_rect(fill=NA)) - } - ggfile <- paste(nomRep,nomProtocole,"_",col_filtre,"_","comparaison.png",sep="") - #cat("Check",ggfile,":") - ggsave(ggfile,gg) - #cat("\n") -flush.console() -} - - -######################################### - -#Lancement des fonctions : - - #Variables a definir : - -#filename="BDD_PAPILLONS_2016.txt" -#color_filename<-"code_couleurs.csv" - - #func -#func="ggCompareLevel" -#func="ggfiltre1niveau" -#func="gglocal" - - #colSousGroupe -#col_sousGroup_usr = NULL #ggfiltre #ggCompareLevel -#col_sousGroup_usr = "PARCELLENOM" #gglocal - - #vec_col_filtre_usr -#vec_col_filtre_usr = c("CONDUITEPARCELLE") #ggCompareLevel -#vec_col_filtre_usr = c("REGION") #ggfiltre -#vec_col_filtre_usr = c("NOM_RESEAU") #gglocal - - - -#Exe fonction : - -#filtre1niveau(func=func,nom_fichier=filename,nom_fichierCouleur=color_filename,col_sousGroup=NULL) #ggfiltre ou ggCompareLevel, depend de func et de vec_col_filtre_usr -#filtre1niveau(func=func,nom_fichier=filename,nom_fichierCouleur=color_filename,col_sousGroup = col_sousGroup_usr,vec_col_filtre=vec_col_filtre_usr) ## ==local - -######################################################## - -filename=args[2] -color_filename=args[3] -func=args[4] - -if(func=="ggCompareLevel"){ -col_sousGroup_usr=NULL -vec_col_filtre_usr=c("CONDUITEPARCELLE") -}else if(func=="ggfiltre1niveau"){ -col_sousGroup_usr=NULL -vec_col_filtre_usr=c("REGION") -}else if(func=="gglocal"){ -col_sousGroup_usr="PARCELLENOM" -vec_col_filtre_usr=c("NOM_RESEAU") -}else{ -#sortie erreur -write("Error, unknown function. Exit(1).", stderr()) -q('no') -} - -#create result dir -nomRep="resultats/" -dir.create(file.path(".", nomRep), showWarnings = FALSE) - - -filtre1niveau(func=func,nom_fichier=filename,nom_fichierCouleur=color_filename,col_sousGroup=col_sousGroup_usr,vec_col_filtre=vec_col_filtre_usr)
--- a/butterfly_crossplot.xml Mon Aug 13 10:06:35 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -<tool id="Butterfly_crossplot" name="Butterfly data analysis" version="0.1.0"> - <requirements> - <requirement type="package" version="2.2.1">r-ggplot2</requirement> - <requirement type="package" version="1.1_2">r-rcolorbrewer</requirement> - <requirement type="package" version="0.9.10">xorg-libxrender</requirement> - <requirement type="package" version="0.9.10">xorg-libsm</requirement> - <requirement type="package" version="1.5">libconfig</requirement> - <requirement type="package" version="1.5_9">r-cairo</requirement> - </requirements> - <command detect_errors="exit_code"><![CDATA[ - Rscript '$__tool_directory__/butterfly_crossplot.R' '$__tool_directory__/stat_bag.r' '$butterfly_db' '$__tool_directory__/code_couleurs.csv' '$function' - ##'$__tool_directory__/BDD_PAPILLONS_2016.txt' - ]]></command> - <inputs> - <param name="function" type="select" label="Chose your analyse"> - <option value="ggCompareLevel">Compare production methods</option> - <option value="ggfiltre1niveau">Compare regions</option> - <option value="gglocal">Compare local networks</option> - </param> - <param name="butterfly_db" type="data" format="csv,tabular" label="Butterfly datafile"/> - </inputs> - <outputs> - <data format="png" name="ggCompareLevel" label="Compare production methods" from_work_dir="resultats/Papillons_CONDUITEPARCELLE_comparaison.png"> - <filter>function=='ggCompareLevel'</filter> - </data> - <collection type="list" name="output_ggfiltre" label="Compare regions"> - <discover_datasets pattern="__designation_and_ext__" visible="false" format="png" directory="resultats"/> - <filter>function=='ggfiltre1niveau'</filter> - </collection> - <collection type="list" name="output_gglocal" label="Compare local network"> - <discover_datasets pattern="__designation_and_ext__" visible="false" format="png" directory="resultats"/> - <filter>function=='gglocal'</filter> - </collection> - </outputs> - <help><![CDATA[ - TODO: Fill in help. - ]]></help> -</tool>
--- a/code_couleurs.csv Mon Aug 13 10:06:35 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -Filtre;Modalite;couleur -TYPECULTURE;ARBORICULTURE;"#006600" -TYPECULTURE;AUTRE_CULTURE_PERENNE;"#FF5050" -TYPECULTURE;GRANDE_CULTURE;"#FFC000" -TYPECULTURE;MARAICHAGE;"#FF6600" -TYPECULTURE;PRAIRIE;"#97B314" -TYPECULTURE;VITICULTURE;"#660066" -NOM_RESEAU;;"#31849B" -Protocole;Abeilles;"#EE7F00" -Protocole;Invertebres;"#97B314" -Protocole;Papillons;"#009EE0" -Protocole;Vers de terre;"#666666" -TYPECULTURE;GLOBAL;"#9f0d0d" -NOM_RESEAU;GLOBAL;"#9f0d0d" -REGIONNAME;;"#31849B" -REGIONNAME;GLOBAL;"#9f0d0d" -ANNEE;;"#31849B" -ANNEE;GLOBAL;"#9f0d0d" -REGION;GLOBAL;"#9f0d0d" -REGION;;"#666666" -CONDUITEPARCELLE;;"#31849B" -CONDUITEPARCELLE;GLOBAL;"#9f0d0d" -TRAVAILSOL;;"#31849B" -TRAVAILSOL;GLOBAL;"#9f0d0d" \ No newline at end of file
--- a/stat_bag.r Mon Aug 13 10:06:35 2018 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,145 +0,0 @@ -library(ggplot2) -StatBag <- ggproto("Statbag", Stat, - compute_group = function(data, scales, prop = 0.5) { - - ################################# - ################################# - # originally from aplpack package, plotting functions removed - plothulls_ <- function(x, y, fraction, n.hull = 1, - col.hull, lty.hull, lwd.hull, density=0, ...){ - # function for data peeling: - # x,y : data - # fraction.in.inner.hull : max percentage of points within the hull to be drawn - # n.hull : number of hulls to be plotted (if there is no fractiion argument) - # col.hull, lty.hull, lwd.hull : style of hull line - # plotting bits have been removed, BM 160321 - # pw 130524 - if(ncol(x) == 2){ y <- x[,2]; x <- x[,1] } - n <- length(x) - if(!missing(fraction)) { # find special hull - n.hull <- 1 - if(missing(col.hull)) col.hull <- 1 - if(missing(lty.hull)) lty.hull <- 1 - if(missing(lwd.hull)) lwd.hull <- 1 - x.old <- x; y.old <- y - idx <- chull(x,y); x.hull <- x[idx]; y.hull <- y[idx] - for( i in 1:(length(x)/3)){ - x <- x[-idx]; y <- y[-idx] - if( (length(x)/n) < fraction ){ - return(cbind(x.hull,y.hull)) - } - idx <- chull(x,y); x.hull <- x[idx]; y.hull <- y[idx]; - } - } - if(missing(col.hull)) col.hull <- 1:n.hull - if(length(col.hull)) col.hull <- rep(col.hull,n.hull) - if(missing(lty.hull)) lty.hull <- 1:n.hull - if(length(lty.hull)) lty.hull <- rep(lty.hull,n.hull) - if(missing(lwd.hull)) lwd.hull <- 1 - if(length(lwd.hull)) lwd.hull <- rep(lwd.hull,n.hull) - result <- NULL - for( i in 1:n.hull){ - idx <- chull(x,y); x.hull <- x[idx]; y.hull <- y[idx] - result <- c(result, list( cbind(x.hull,y.hull) )) - x <- x[-idx]; y <- y[-idx] - if(0 == length(x)) return(result) - } - result - } # end of definition of plothulls - ################################# - - - # prepare data to go into function below - the_matrix <- matrix(data = c(data$x, data$y), ncol = 2) - - # get data out of function as df with names - setNames(data.frame(plothulls_(the_matrix, fraction = prop)), nm = c("x", "y")) - # how can we get the hull and loop vertices passed on also? - }, - - required_aes = c("x", "y") -) - -#' @inheritParams ggplot2::stat_identity -#' @param prop Proportion of all the points to be included in the bag (default is 0.5) -stat_bag <- function(mapping = NULL, data = NULL, geom = "polygon", - position = "identity", na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE, prop = 0.5, alpha = 0.3, ...) { - layer( - stat = StatBag, data = data, mapping = mapping, geom = geom, - position = position, show.legend = show.legend, inherit.aes = inherit.aes, - params = list(na.rm = na.rm, prop = prop, alpha = alpha, ...) - ) -} - - -geom_bag <- function(mapping = NULL, data = NULL, - stat = "identity", position = "identity", - prop = 0.5, - alpha = 0.3, - ..., - na.rm = FALSE, - show.legend = NA, - inherit.aes = TRUE) { - layer( - data = data, - mapping = mapping, - stat = StatBag, - geom = GeomBag, - position = position, - show.legend = show.legend, - inherit.aes = inherit.aes, - params = list( - na.rm = na.rm, - alpha = alpha, - prop = prop, - ... - ) - ) -} - -#' @rdname ggplot2-ggproto -#' @format NULL -#' @usage NULL -#' @export -GeomBag <- ggproto("GeomBag", Geom, - draw_group = function(data, panel_scales, coord) { - n <- nrow(data) - if (n == 1) return(zeroGrob()) - - munched <- coord_munch(coord, data, panel_scales) - # Sort by group to make sure that colors, fill, etc. come in same order - munched <- munched[order(munched$group), ] - - # For gpar(), there is one entry per polygon (not one entry per point). - # We'll pull the first value from each group, and assume all these values - # are the same within each group. - first_idx <- !duplicated(munched$group) - first_rows <- munched[first_idx, ] - - ggplot2:::ggname("geom_bag", - grid:::polygonGrob(munched$x, munched$y, default.units = "native", - id = munched$group, - gp = grid::gpar( - col = first_rows$colour, - fill = alpha(first_rows$fill, first_rows$alpha), - lwd = first_rows$size * .pt, - lty = first_rows$linetype - ) - ) - ) - - - }, - - default_aes = aes(colour = "NA", fill = "grey20", size = 0.5, linetype = 1, - alpha = NA, prop = 0.5), - - handle_na = function(data, params) { - data - }, - - required_aes = c("x", "y"), - - draw_key = draw_key_polygon -)