Mercurial > repos > mnhn65mo > butterfly_analysis
changeset 0:af2cdd97a434 draft
Uploaded
| author | mnhn65mo |
|---|---|
| date | Mon, 13 Aug 2018 04:21:56 -0400 |
| parents | |
| children | c5a10acd34e3 |
| files | butterfly_crossplot.R butterfly_crossplot.xml |
| diffstat | 2 files changed, 590 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_crossplot.R Mon Aug 13 04:21:56 2018 -0400 @@ -0,0 +1,556 @@ +################################################################## +#### 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/butterfly_crossplot.xml Mon Aug 13 04:21:56 2018 -0400 @@ -0,0 +1,34 @@ +<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> + </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>