# HG changeset patch
# User mnhn65mo
# Date 1534150077 14400
# Node ID c5a10acd34e3b7cbc87c2df226cf808f4e4c96b0
# Parent af2cdd97a434149bbe8b15ec0b2f105f02c6f0f4
Uploaded
diff -r af2cdd97a434 -r c5a10acd34e3 butterfly_crossplot.R
--- a/butterfly_crossplot.R Mon Aug 13 04:21:56 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)
diff -r af2cdd97a434 -r c5a10acd34e3 butterfly_crossplot.xml
--- a/butterfly_crossplot.xml Mon Aug 13 04:21:56 2018 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,34 +0,0 @@
-
-
- r-ggplot2
- r-rcolorbrewer
-
-
-
-
-
-
-
-
-
-
-
-
- function=='ggCompareLevel'
-
-
-
- function=='ggfiltre1niveau'
-
-
-
- function=='gglocal'
-
-
-
-
diff -r af2cdd97a434 -r c5a10acd34e3 clim_data.R
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/clim_data.R Mon Aug 13 04:47:57 2018 -0400
@@ -0,0 +1,136 @@
+#!/usr/bin/env Rscript
+
+
+args <- commandArgs(trailingOnly = TRUE)
+
+#Rscript clim_data.R 'worldclim' 'var' 'resolution' 'OutputFormat' #'FRA' #'prec1'
+if (length(args)==0 | args[1]=="-h" | args[1]=="--help"){
+ print ("general script execution : Rscript clim_data.R \'worldclim\' \'var\' resolution \'OutputFormat\' #\'variable-to-plot\' #\'region_code\'")
+ print ("eg : Rscript clim_data.R \'worldclim\' \'prec\' 10 \'raster\' #\'prec1' #\'FRA\'")
+ q('no')
+}
+
+
+#Climatic variables dictionaries
+months<-c("January","February","March","April","May","June","July","August","September","October","November","December")
+bioclimatic_vars<-c("Annual Mean Temperature", "Mean Diurnal Range (Mean of monthly (max temp - min temp))", "Isothermality (BIO2/BIO7) (x 100)","Temperature Seasonality (standard deviation x100)","Max Temperature of Warmest Month","Min Temperature of Coldest Month","Temperature Annual Range (BIO5-BIO6)","Mean Temperature of Wettest Quarter","Mean Temperature of Driest Quarter","Mean Temperature of Warmest Quarter","Mean Temperature of Coldest Quarter","Annual Precipitation","Precipitation of Wettest Month","Precipitation of Driest Month","Precipitation Seasonality (Coefficient of Variation)","Precipitation of Wettest Quarter","Precipitation of Driest Quarter","Precipitation of Warmest Quarter","Precipitation of Coldest Quarter")
+
+#Function to create custom plot title
+get_plot_title<-function(usr_var,usr_var_to_plot){
+ match<-str_extract(usr_var_to_plot,"[0-9]+")
+ if(usr_var %in% c("prec","tmin","tmax")){
+ printable_var<-(months[as.integer(match)])
+ if(usr_var=="prec"){
+ printable_var<-paste(printable_var," precipitations (mm)",sep="")
+ }else if(usr_var=="tmin"){
+ printable_var<-paste(printable_var," minimum temperature (°C *10)",sep="")
+ }else{
+ printable_var<-paste(printable_var," maximum temperature (°C *10)",sep="")
+ }
+ }else if(usr_var=="bio"){
+ printable_var<-(bioclimatic_vars[as.integer(match)])
+ printable_var<-paste("Bioclimatic variable - ",printable_var,sep="")
+ }
+ title<-paste("Worldclim data - ",printable_var,".",sep="")
+ return(title)
+}
+
+
+#Call libraries
+library('raster',quietly=TRUE)
+library(sp,quietly = TRUE, warn.conflicts = FALSE)
+library(ncdf4,quietly = TRUE, warn.conflicts = FALSE)
+#library(rgdal,quietly = TRUE, warn.conflicts = FALSE) #To save as geotif
+library(stringr)
+
+
+#Get args
+usr_data=args[1]
+usr_var=args[2]
+usr_res=as.numeric(args[3])
+usr_of=args[4]
+
+
+# Retrieve 'var' data from WorldClim
+global.var <- getData(usr_data, download = TRUE, var = usr_var, res = usr_res)
+
+# Check if we actualy get some
+if (length(global.var)==0){
+ cat("No data found.")
+}else{
+ writeRaster(global.var, "output_writeRaster", format=usr_of,overwrite=TRUE)
+ final_msg<-paste("WorldClim data for ", usr_var, " at resolution ", usr_res, " in ", usr_of, " format\n", sep="")
+ cat(final_msg)
+}
+
+
+
+
+
+
+#################
+##Visualisation##
+#################
+
+#Get args
+if(length(args[5])>=0 && length(args[6])>=0){
+ usr_var_to_plot=args[5]
+ usr_plot_region=args[6]
+}else{q('no')}
+
+list_region_mask<-c("FRA","DEU","GBR","ESP","ITA")
+
+if(usr_plot_region %in% list_region_mask){
+#Country mask
+ region <- getData("GADM",country=usr_plot_region,level=0)
+ region_mask <- mask(global.var, region)
+ region_var_to_plot_expression<-paste("region_mask$",usr_var_to_plot,sep="")
+}else{ #All map and resize manualy
+ region_var_to_plot_expression<-paste("global.var$",usr_var_to_plot,sep="")
+}
+
+
+region_var_to_plot<-eval(parse(text=region_var_to_plot_expression))
+
+#PLotmap
+jpeg(file="worldclim_plot_usr_region.jpeg",bg="white")
+
+title<-get_plot_title(usr_var,usr_var_to_plot)
+
+
+if(usr_plot_region=="FRA"){
+ #FRA
+ plot(region_var_to_plot, xlim = c(-7, 12), ylim = c(40, 52), axes=TRUE,xlab="Longitude",ylab="Latitude",main=title)
+}else if(usr_plot_region=="GBR"){
+ #GBR
+ plot(region_var_to_plot, xlim = c(-10, 5), ylim = c(46, 63), axes=TRUE,xlab="Longitude",ylab="Latitude",main=title)
+}else if(usr_plot_region=="NA"){
+ #North America :
+ plot(region_ar_to_plot,xlim=c(-180,-50),ylim=c(10,75),xlab="Longitude",ylab="Latitude",main=title)
+}else if(usr_plot_region=="EU"){
+ #Europe
+ plot(region_var_to_plot,xlim=c(-28,48),ylim=c(34,72),xlab="Longitude",ylab="Latitude",main=title)
+}else if(usr_plot_region=="DEU"){
+ #DEU
+ plot(region_var_to_plot, xlim = c(5, 15), ylim = c(45, 57),axes=TRUE,xlab="Longitude",ylab="Latitude",main=title)
+}else if(usr_plot_region=="ESP"){
+ #ESP
+ plot(region_var_to_plot, xlim = c(-10, 6), ylim = c(35, 45), axes=TRUE,xlab="Longitude",ylab="Latitude", main=title)
+}else if(usr_plot_region=="ITA"){
+ #ITA
+ plot(region_var_to_plot, xlim = c(4, 20), ylim = c(35, 48), axes=TRUE,xlab="Longitude",ylab="Latitude", main=title)
+}else if(usr_plot_region=="WM"){
+ #Worldmap
+ plot(region_var_to_plot,xlab="Longitude",ylab="Latitude",main=title)
+}else if(usr_plot_region=="AUS"){
+ #AUS
+ plot(region_var_to_plot,xlim=c(110,155),ylim=c(-45,-10),xlab="Longitude",ylab="Latitude",axes=TRUE,main=title)
+}else{
+ write("Error with country code.", stderr())
+ q('no')
+}
+
+garbage_output<-dev.off
+
+#Exit
+q('no')
diff -r af2cdd97a434 -r c5a10acd34e3 raster_getdata.xml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/raster_getdata.xml Mon Aug 13 04:47:57 2018 -0400
@@ -0,0 +1,208 @@
+
+
+
+
+
+ r-getopt
+ r-ncdf4
+ r-raster
+ r-stringr
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ usr_of=='CDF'
+
+
+ usr_of=='raster'
+
+
+ usr_of=='raster'
+
+
+ plot=='yes_plot'
+
+
+
+