[Stacomir-commits] r354 - in pkg/stacomir: R inst/config inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 12 18:11:27 CEST 2017
Author: briand
Date: 2017-04-12 18:11:26 +0200 (Wed, 12 Apr 2017)
New Revision: 354
Modified:
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/fungraph.r
pkg/stacomir/R/fungraph_civelle.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R
Log:
Modified: pkg/stacomir/R/BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMult.r 2017-04-12 06:17:19 UTC (rev 353)
+++ pkg/stacomir/R/BilanMigrationMult.r 2017-04-12 16:11:26 UTC (rev 354)
@@ -380,6 +380,10 @@
#' @param plot.type One of "standard","step","multiple". Defaut to \code{standard} the standard BilanMigration with dc and operation displayed, can also be \code{step} or
#' \code{multiple}
#' @param silent Stops most messages from being displayed
+#' @param color Default NULL, argument passed for the plot.type="standard" method. A vector of color in the following order, numbers, weight, working, stopped, 1...5 types of operation
+#' for the fishway, if null will be set to brewer.pal(12,"Paired")[c(8,10,4,6,1,2,3,5,7)]
+#' @param color_ope Default NULL, argument passed for the plot.type="standard" method. A vector of color for the operations. Default to brewer.pal(4,"Paired")
+
#' @param ... Additional arguments, see \code{plot}, \code{plot.default} and \code{par}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
@@ -387,7 +391,7 @@
# getGeneric("plot")
# showMethods("plot")
# methods("plot")
-setMethod("plot",signature(x = "BilanMigrationMult", y = "missing"),definition=function(x, plot.type="standard",silent=FALSE,...){
+setMethod("plot",signature(x = "BilanMigrationMult", y = "missing"),definition=function(x, plot.type="standard",color=NULL, color_ope=NULL,silent=FALSE,...){
#browser()
#print("entering plot function")
#bilanMigrationMult<-bMM_Arzal
@@ -450,7 +454,9 @@
taxon=taxon,
stade=stade,
dc=dc,
- silent,
+ color=color,
+ color_ope=color_ope,
+ silent,
...)
} else {
@@ -465,7 +471,10 @@
taxon,
stade,
dc,
- silent)
+ color=color,
+ color_ope=color_ope,
+ silent,
+ ...)
}
} # end nrow(data)>0
# ecriture du bilan journalier, ecrit aussi le bilan mensuel
Modified: pkg/stacomir/R/fungraph.r
===================================================================
--- pkg/stacomir/R/fungraph.r 2017-04-12 06:17:19 UTC (rev 353)
+++ pkg/stacomir/R/fungraph.r 2017-04-12 16:11:26 UTC (rev 354)
@@ -13,14 +13,65 @@
#' @param taxon The species
#' @param stade The stage
#' @param dc The DC
+#' @param color Default NULL, a vector of color in the following order, working, stopped, 1...5 types of operation
+#' for the fishway or DC, numbers, weight. If null will be set to brewer.pal(12,"Paired")[c(8,10,4,6,1,2,3,5,7)]
+#' @param color_ope Default NULL, a vector of color for the operations. Default to brewer.pal(4,"Paired")
+
#' @param silent Message displayed or not
#' @param ... other parameters passed from the plot method to the matplot function
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-fungraph=function(bilanMigration,tableau,time.sequence,taxon,stade,dc=NULL,silent,...){
+fungraph=function(bilanMigration,tableau,time.sequence,taxon,stade,dc=NULL,silent,color=NULL,color_ope=NULL,...){
#mat <- matrix(1:6,3,2)
#layout(mat)
#browser()
#cat("fungraph")
+ # color=null
+ # color calculation
+
+ if (is.null(color)) {
+ tp<-RColorBrewer::brewer.pal(12,"Paired")
+ mypalette=c(
+ "working"=tp[4],
+ "stopped"=tp[6],
+ "listeperiode1"=tp[1],
+ "listeperiode2"=tp[2],
+ "listeperiode3"=tp[3],
+ "listeperiode4"=tp[5],
+ "listeperiode5"=tp[7],
+ "ponctuel"="indianred",
+ "expert"="chartreuse2",
+ "calcule"="deepskyblue",
+ "mesure"="black"
+ )
+ } else {
+ if(length(color)!=11) stop("The length of color must be 11")
+ mypalette=c(
+ "working"= color[1],
+ "stopped"= color[2],
+ "listeperiode1"=color[3],
+ "listeperiode2"=color[4],
+ "listeperiode3"=color[5],
+ "listeperiode4"=color[6],
+ "listeperiode5"=color[7],
+ "mesure"= color[8],
+ "calcule"= color[9],
+ "expert"= color[10],
+ "ponctuel"= color[11]
+ )
+ }
+
+ if (is.null(color_ope)) {
+ # check if "brew" is in the ... list
+ myargs <- list(...)
+ existbrew <- "brew" %in% names(myargs)
+ if (!existbrew){
+ if(stacomirtools::is.odd(dc)) brew="Paired" else brew="Accent"
+ } else {
+ brew<-myargs[["brew"]]
+ }
+ color_ope=RColorBrewer::brewer.pal(8,brew)
+ }
+
if (is.null(dc)) dc=bilanMigration at dc@dc_selectionne[1]
annee=unique(strftime(as.POSIXlt(time.sequence),"%Y"))[1]
mois= months(time.sequence)
@@ -39,7 +90,7 @@
vec<-c(rep(1,15),rep(2,2),rep(3,2),4,rep(5,6))
mat <- matrix(vec,length(vec),1)
layout(mat)
- mypalette<-rev(c("black","deepskyblue","chartreuse2","indianred"))
+
#par("bg"=grDevices::gray(0.8))
graphics::par("mar"=c(3, 4, 3, 2) + 0.1)
###################################
@@ -49,7 +100,7 @@
tableau$MESURE+tableau$CALCULE+tableau$EXPERT,
tableau$MESURE+tableau$CALCULE,
tableau$MESURE),
- col=mypalette[1:4],
+ col=mypalette[c("ponctuel","expert","calcule","mesure")],
type=c("h","h","h","h"),
pch=16,
lty=1,
@@ -58,7 +109,7 @@
ylab=gettext("Number",domain="R-stacomiR"),
xlab=gettext("Date",domain="R-stacomiR"),
main=gettextf("estimated number, %s, %s, %s, %s",dis_commentaire,taxon,stade,annee,domain="R-stacomiR"),
- cex.main=1)
+ cex.main=1,...)
if(bilanMigration at pasDeTemps@stepDuration=="86400"){ # pas de temps journalier
index=as.vector(x[jmois==15])
axis(side=1,at=index,tick=TRUE,labels=mois)
@@ -77,27 +128,27 @@
y=max(tableau$MESURE,tableau$CALCULE,tableau$EXPERT,tableau$PONCTUEL,na.rm=TRUE),
legend=gettext("measured","calculated","expert","direct",domain="R-stacomiR"),
pch=c(16),
- col=rev(c(mypalette[1:4])))
+ col=mypalette[c("mesure","calcule","expert","ponctuel")])
bilanOperation<-get("bilanOperation",envir=envir_stacomi)
t_operation_ope<-bilanOperation at data[bilanOperation at data$ope_dic_identifiant==dc,]
dif=difftime(t_operation_ope$ope_date_fin,t_operation_ope$ope_date_debut, units ="days")
if (!silent){
- funout(ngettext(nrow(t_operation_ope),"%d operation \n", "%d operations \n",domain="R-stacomiR"))
+ funout(ngettext(nrow(t_operation_ope),"%d operation \n", "%d operations \n",domain="R-stacomiR"))
funout(gettextf("average trapping time = %s days\n",round(mean(as.numeric(dif)),2),domain="R-stacomiR"))
funout(gettextf("maximum term = %s",round(max(as.numeric(dif)),2),domain="R-stacomiR"))
funout(gettextf("minimum term = %s",round(min(as.numeric(dif)),2),domain="R-stacomiR"))
}
-
+
df<-bilanMigration at dc@data$df[bilanMigration at dc@data$dc==dc]
bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
bilanFonctionnementDC<-get("bilanFonctionnementDC", envir=envir_stacomi)
bilanFonctionnementDF at data<-bilanFonctionnementDF at data[bilanFonctionnementDF at data$per_dis_identifiant==df,]
bilanFonctionnementDC at data<-bilanFonctionnementDC at data[bilanFonctionnementDC at data$per_dis_identifiant==dc,]
-
+
graphdate<-function(vectordate){
attributes(vectordate)<-NULL
vectordate=unclass(vectordate)
@@ -110,7 +161,6 @@
###################################
# creation d'un graphique vide (2)
###################################
- mypalette<-RColorBrewer::brewer.pal(12,"Paired")
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.POSIXct(time.sequence),
seq(0,3,length.out=nrow(tableau)),
@@ -133,20 +183,20 @@
ybottom=2.1,
xright=fin,
ytop=3,
- col = mypalette[4],
+ col = "grey",
border = NA,
lwd = 1)
rect( xleft=debut,
ybottom=1.1,
xright=fin,
ytop=2,
- col = mypalette[1],
+ col = "grey40",
border = NA,
lwd = 1)
legend( x= "bottom",
- legend= gettext("working","stopped","normal operation",domain="R-stacomiR"),
+ legend= gettext("Unknown working","Unknow operation type",domain="R-stacomiR"),
pch=c(16,16),
- col=c(mypalette[4],mypalette[6],mypalette[1]),
+ col=c("grey","grey40"),
horiz=TRUE,
bty="n"
)
@@ -162,7 +212,7 @@
xright=graphdate(as.POSIXct(bilanFonctionnementDF at data$per_date_fin[
bilanFonctionnementDF at data$per_etat_fonctionnement==1])),
ytop=3,
- col = mypalette[4],
+ col = mypalette["working"],
border = NA,
lwd = 1) }
if (sum(bilanFonctionnementDF at data$per_etat_fonctionnement==0)>0){
@@ -172,7 +222,7 @@
xright=graphdate(as.POSIXct(bilanFonctionnementDF at data$per_date_fin[
bilanFonctionnementDF at data$per_etat_fonctionnement==0])),
ytop=3,
- col = mypalette[6],
+ col = mypalette["stopped"],
border = NA,
lwd = 1) }
#creation d'une liste par categorie d'arret contenant vecteurs dates
@@ -183,24 +233,27 @@
libelle=bilanFonctionnementDF at data$libelle,
date=FALSE)
nomperiode<-vector()
+ color_periodes<-vector() # a vector of colors, one per period type in listeperiode
for (j in 1 : length(listeperiode)){
#recuperation du vecteur de noms (dans l'ordre) e partir de la liste
nomperiode[j]<-substr(listeperiode[[j]]$nom,1,17)
- #ecriture pour chaque type de periode
+ #ecriture pour chaque type de periode
+ color_periode=stringr::str_c("listeperiode",j)
rect( xleft=graphdate(listeperiode[[j]]$debut),
ybottom=1.1,
xright=graphdate(listeperiode[[j]]$fin),
ytop=2,
- col = mypalette[j],
+ col = mypalette[color_periode],
border = NA,
lwd = 1)
+ color_periodes<-c(color_periodes,color_periode)
}
legend (x= debut,
y=1.2,
legend= c(gettext("stop",domain="R-stacomiR"),nomperiode),
pch=c(15,15),
- col=c(mypalette[4],mypalette[6],mypalette[1:length(listeperiode)]),
+ col=c(mypalette["working"],mypalette["stopped"],mypalette[color_periodes]),
bty="n",
ncol=7,
text.width=(fin-debut)/10)
@@ -232,7 +285,7 @@
ybottom=2.1,
xright=fin,
ytop=3,
- col = mypalette[4],
+ col = "grey",
border = NA,
lwd = 1)
@@ -240,13 +293,13 @@
ybottom=1.1,
xright=fin,
ytop=2,
- col = mypalette[1],
+ col = "grey40",
border = NA,
lwd = 1)
legend( x= "bottom",
- legend= gettext("working","stopped","normal operation",domain="R-stacomiR"),
+ legend= gettext("Unknown working","Unknow operation type",domain="R-stacomiR"),
pch=c(16,16),
- col=c(mypalette[4],mypalette[6],mypalette[1]),
+ col=c("grey","grey40"),
#horiz=TRUE,
ncol=5,
bty="n")
@@ -261,7 +314,7 @@
xright=graphdate(as.POSIXct(bilanFonctionnementDC at data$per_date_fin[
bilanFonctionnementDC at data$per_etat_fonctionnement==1])),
ytop=3,
- col = mypalette[4],
+ col = mypalette["working"],
border = NA,
lwd = 1) }
if (sum(bilanFonctionnementDC at data$per_etat_fonctionnement==0)>0)
@@ -272,7 +325,7 @@
xright=graphdate(as.POSIXct(bilanFonctionnementDC at data$per_date_fin[
bilanFonctionnementDC at data$per_etat_fonctionnement==0])),
ytop=3,
- col = mypalette[6],
+ col = mypalette["stopped"],
border = NA,
lwd = 1) }
listeperiode<-
@@ -282,25 +335,26 @@
libelle=bilanFonctionnementDC at data$libelle,
date=FALSE)
nomperiode<-vector()
-
+ color_periodes<-vector()
for (j in 1 : length(listeperiode)){
nomperiode[j]<-substr(listeperiode[[j]]$nom,1,17)
+ color_periode=stringr::str_c("listeperiode",j)
rect( xleft=graphdate(listeperiode[[j]]$debut),
ybottom=1.1,
xright=graphdate(listeperiode[[j]]$fin),
ytop=2,
- col = mypalette[j],
+ col = mypalette[color_periode],
border = NA,
lwd = 1)
}
legend (x= debut,
y=1.2,
- legend= c(gettext("stop",domain="R-stacomiR"),nomperiode),
+ legend= gettext("working","stopped",nomperiode,domain="R-stacomiR"),
pch=c(15,15),
- col=c(mypalette[4],mypalette[6],mypalette[1:length(listeperiode)]),
+ col=c(mypalette["working"],mypalette["stopped"],mypalette[color_periodes]),
bty="n",
- ncol=7,
+ ncol=length(listeperiode)+2,
text.width=(fin-debut)/10)
}
@@ -323,12 +377,12 @@
###################################
# operations
###################################
- if(stacomirtools::is.odd(dc)) brew="Paired" else brew="Accent"
+
rect( xleft =graphdate(as.POSIXct(t_operation_ope$ope_date_debut)),
ybottom=0,
xright=graphdate(as.POSIXct(t_operation_ope$ope_date_fin)),
ytop=1,
- col = RColorBrewer::brewer.pal(8,brew),
+ col = color_ope,
border = NA,
lwd = 1)
@@ -346,7 +400,7 @@
value.name="number")
levels(tableaum$type)<-gettext("measured","calculated","expert","direct",domain="R-stacomiR")
superpose.polygon<-lattice::trellis.par.get("plot.polygon")
- superpose.polygon$col= c("black","deepskyblue","chartreuse2","indianred")
+ superpose.polygon$col= mypalette[c("mesure","calcule","expert","ponctuel")]
superpose.polygon$border=rep("transparent",6)
lattice::trellis.par.set("superpose.polygon",superpose.polygon)
fontsize<-lattice::trellis.par.get("fontsize")
Modified: pkg/stacomir/R/fungraph_civelle.r
===================================================================
--- pkg/stacomir/R/fungraph_civelle.r 2017-04-12 06:17:19 UTC (rev 353)
+++ pkg/stacomir/R/fungraph_civelle.r 2017-04-12 16:11:26 UTC (rev 354)
@@ -5,20 +5,67 @@
#' eel have been counted through weight or numbers
#'
#'
-#' @param bilanMigration an object of class \code{\linkS4class{BilanMigration}} or an
-#' #' object of class \code{\linkS4class{BilanMigrationMult}}
+#' @param bilanMigration an object of class \link{BilanMigration-class} or an
+#' object of class \link{BilanMigrationMult-class}
#' @param table a data frame with the results
#' @param time.sequence a vector POSIXt
#' @param taxon the species
#' @param stade the stage
-#' @param dc the counting device, default to null, only necessary for \code{\linkS4class{BilanMigrationMult}}
+#' @param dc the counting device, default to null, only necessary for \link{BilanMigrationMult-class}
#' @param silent Message displayed or not
+#' @param color Default NULL, a vector of length 11 of color in the following order, numbers, weight, working, stopped, 1...5 types of operation,
+#' the 2 latest colors are not used but keeped for consistency with fungraph
+#' for the fishway, if null will be set to brewer.pal(12,"Paired")[c(4,6,1,2,3,5,7,8,10,11,12)]
+#' @param color_ope Default NULL, a vector of color for the operations. Default to brewer.pal(4,"Paired")
#' @param ... additional parameters passed from the plot method to plot
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-fungraph_civelle=function(bilanMigration,table,time.sequence,taxon,stade,dc=null,silent,...){
-# calcul des variables
- # pour adapter aux bilanMigrationMult, ligne par defaut...
- #cat("fungraph_civelle")
+fungraph_civelle=function(bilanMigration,table,time.sequence,taxon,stade,dc=null,silent,color=NULL,color_ope=NULL,...){
+ # color=null
+ # color calculation
+ if (is.null(color)) {
+ tp<-RColorBrewer::brewer.pal(12,"Paired")
+ mypalette=c(
+ "working"=tp[4], # green
+ "stopped"=tp[6], # red
+ "listeperiode1"=tp[1],
+ "listeperiode2"=tp[2],
+ "listeperiode3"=tp[3],
+ "listeperiode4"=tp[5],
+ "listeperiode5"=tp[7],
+ "eff"=tp[8], #orange
+ "weight"=tp[10], #purple
+ "unused1"=tp[11],
+ "unused1"=tp[12]
+ )
+ } else {
+ if(length(color)!=11) stop("The length of color must be 11")
+ mypalette=c(
+ "working"=color[1],
+ "stopped"=color[2],
+ "listeperiode1"=color[3],
+ "listeperiode2"=color[4],
+ "listeperiode3"=color[5],
+ "listeperiode4"=color[6],
+ "listeperiode5"=color[7],
+ "eff"=color[8],
+ "weight"=color[9],
+ "unused1"=color[10],
+ "unused2"=color[11]
+ )
+ }
+
+ if (is.null(color_ope)) {
+ # check if "brew" is in the ... list
+ myargs <- list(...)
+ existbrew <- "brew" %in% names(myargs)
+ if (!existbrew){
+ if(stacomirtools::is.odd(dc)) brew="Paired" else brew="Accent"
+ } else {
+ brew<-myargs[["brew"]]
+ }
+ color_ope=RColorBrewer::brewer.pal(8,brew)
+ }
+
if (is.null(dc)) dc=bilanMigration at dc@dc_selectionne[1]
annee=paste(unique(strftime(as.POSIXlt(time.sequence),"%Y")),collapse=",")
mois= months(time.sequence)
@@ -39,12 +86,10 @@
vec<-c(rep(1,15),rep(2,2),rep(3,2),4,rep(5,6))
mat <- matrix(vec,length(vec),1)
layout(mat)
- mypalette<-RColorBrewer::brewer.pal(12,"Paired")
#par("bg"=grDevices::gray(0.8))
- graphics::par("mar"=c(3, 4, 3, 2) + 0.1)
- #mypalette<-grDevices::rainbow(20)
+ graphics::par("mar"=c(3, 4, 3, 2) + 0.1)
plot(as.Date(time.sequence,"Europe/Paris"),eff/1000,
- col=mypalette[8],
+ col=mypalette["eff"],
type="h",
xlim=c(debut,fin),
ylim=c(0,max(eff/1000,na.rm=TRUE))*1.2 ,
@@ -54,7 +99,8 @@
#xlab="date",
cex.main=1,
font.main=1,
- main=gettextf("Glass eels graph %s, %s, %s, %s,...",dis_commentaire,taxon,stade,annee))
+ main=gettextf("Glass eels graph %s, %s, %s, %s",dis_commentaire,taxon,stade,annee,domain="R-stacomiR"),
+ ...)
#print(plot,position = c(0, .3, 1, .9), more = TRUE)
r <- as.Date(round(range(time.sequence), "day"))
axis.Date(1, at=seq(r[1], r[2], by="weeks"),format="%d-%b")
@@ -62,33 +108,35 @@
points(as.Date(time.sequence,"Europe/Paris"),eff.p/1000,
type="h",
lty=1,
- col=mypalette[10])
+ col=mypalette["weight"])
legend(x="topright",
inset=0.01,
legend= gettext("weight of the daily number","daily number counted",domain="R-stacomiR"),
pch=c(16,16),
- col=mypalette[c(10,8)])
-
+ col=mypalette[c("weight","eff")])
+ ######################################
+ # text labels for numbers and weights
+ ######################################
text( x=debut+(fin-debut)/8,
y=max(eff/1000,na.rm=TRUE)*1.15,
labels=paste(round(sum(table$poids_depuis_effectifs,na.rm=TRUE)/1000,2)," kg"),
- col=mypalette[8],
+ col=mypalette["eff"],
adj=1)
text( x=debut+3*(fin-debut)/8 ,
y=max(eff/1000,na.rm=TRUE)*1.15,
labels= paste("N=",round(sum(table$Effectif_total.e,na.rm=TRUE))),
- col=mypalette[8],
+ col=mypalette["eff"],
adj=1)
text( x=debut+(fin-debut)/8,
y=max(eff/1000,na.rm=TRUE)*1.2,
labels=paste(round(sum(table$Poids_total,na.rm=TRUE)/1000,2)," kg"),
- col=mypalette[10],
+ col=mypalette["weight"],
adj=1)
text( x=debut+3*(fin-debut)/8,
y=max(eff/1000,na.rm=TRUE)*1.2,
labels= paste("N=",round(sum(eff.p,na.rm=TRUE))),
- col=mypalette[10],
+ col=mypalette["weight"],
adj=1)
text( x=debut+3+(fin-debut)/8,
y=max(eff/1000,na.rm=TRUE)*1.1,
@@ -109,10 +157,10 @@
dif=difftime(t_operation_ope$ope_date_fin,t_operation_ope$ope_date_debut, units ="days")
if (!silent){
- funout(gettextf("number of operations =%s\n",nrow(t_operation_ope)))
- funout(gettextf("average trapping time = %sdays\n",round(mean(as.numeric(dif)),2)))
- funout(gettextf("maximum term = %sdays\n",round(max(as.numeric(dif)),2)))
- funout(gettextf("minimum term = %sdays\n",round(min(as.numeric(dif)),2)))
+ funout(gettextf("number of operations =%s\n",nrow(t_operation_ope),domain="R-stacomiR"))
+ funout(gettextf("average trapping time = %sdays\n",round(mean(as.numeric(dif)),2),domain="R-stacomiR"))
+ funout(gettextf("maximum term = %sdays\n",round(max(as.numeric(dif)),2),domain="R-stacomiR"))
+ funout(gettextf("minimum term = %sdays\n",round(min(as.numeric(dif)),2),domain="R-stacomiR"))
}
df<-bilanMigration at dc@data$df[bilanMigration at dc@data$dc==dc]
@@ -140,7 +188,7 @@
xlab="",
xaxt="n",
yaxt="n",
- ylab="Fishway",
+ ylab=gettext("Fishway",domain="R-stacomiR"),
bty="n",
cex=1.2)
@@ -154,20 +202,20 @@
ybottom=2.1,
xright=fin,
ytop=3,
- col = mypalette[4],
+ col = "grey",
border = NA,
lwd = 1)
rect( xleft=debut,
ybottom=1.1,
xright=fin,
ytop=2,
- col = mypalette[1],
+ col = "grey40",
border = NA,
lwd = 1)
legend( x= "bottom",
- legend= c(gettext("working","stopped","normal operation",domain="R-stacomiR")),
+ legend= gettext("Unknown working","Unknow operation type",domain="R-stacomiR"),
pch=c(16,16),
- col=c(mypalette[4],mypalette[6],mypalette[1]),
+ col=c(grey,grey40),
horiz=TRUE,
bty="n"
)
@@ -184,7 +232,7 @@
xright=graphdate(as.Date(bilanFonctionnementDF at data$per_date_fin[
bilanFonctionnementDF at data$per_etat_fonctionnement==1])),
ytop=3,
- col = mypalette[4],
+ col = mypalette["working"],
border = NA,
lwd = 1) }
if (sum(bilanFonctionnementDF at data$per_etat_fonctionnement==0)>0){
@@ -194,7 +242,7 @@
xright=graphdate(as.Date(bilanFonctionnementDF at data$per_date_fin[
bilanFonctionnementDF at data$per_etat_fonctionnement==0])),
ytop=3,
- col = mypalette[6],
+ col = mypalette["stopped"],
border = NA,
lwd = 1) }
#creation d'une liste par categorie d'arret contenant vecteurs dates
@@ -204,26 +252,29 @@
tempsfin=bilanFonctionnementDF at data$per_date_fin,
libelle=bilanFonctionnementDF at data$libelle)
nomperiode<-vector()
+ color_periodes<-vector() # a vector of colors, one per period type in listeperiode
for (j in 1 : length(listeperiode)){
#recuperation du vecteur de noms (dans l'ordre) e partir de la liste
nomperiode[j]<-substr(listeperiode[[j]]$nom,1,17)
- #ecriture pour chaque type de periode
+ #ecriture pour chaque type de periode
+ color_periode=stringr::str_c("listeperiode",j)
rect( xleft=graphdate(listeperiode[[j]]$debut),
ybottom=1.1,
xright=graphdate(listeperiode[[j]]$fin),
ytop=2,
- col = mypalette[j],
+ col = mypalette[color_periode],
border = NA,
- lwd = 1)
+ lwd = 1)
+ color_periodes<-c(color_periodes,color_periode)
}
-
+ # below the colors for operation are from 4 to 3+ntypeoperation
legend (x= debut,
y=1.2,
- legend= c(gettext("work","stop",domain="R-stacomiR"),nomperiode),
+ legend= gettext("working","stopped",nomperiode,domain="R-stacomiR"),
pch=c(15,15),
- col=c(mypalette[4],mypalette[6],mypalette[1:length(listeperiode)]),
+ col=c(mypalette["working"],mypalette["stopped"],mypalette[color_periodes]),
bty="n",
- ncol=7,
+ ncol=length(listeperiode)+2,
text.width=(fin-debut)/10)
}
@@ -250,27 +301,27 @@
if (dim(bilanFonctionnementDC at data)[1]==0 ) {
- rect( xleft=debut,
+ rect(xleft=debut,
ybottom=2.1,
xright=fin,
ytop=3,
- col = mypalette[4],
+ col = "grey",
border = NA,
lwd = 1)
- rect( xleft=debut,
+ rect(xleft=debut,
ybottom=1.1,
xright=fin,
ytop=2,
- col = mypalette[1],
+ col = "grey40",
border = NA,
lwd = 1)
legend( x= "bottom",
- legend=c(gettext("working"),gettext("stopped"),gettext("normal operation",domain="R-stacomiR")),
+ legend=gettext("Unknown working","Unknow operation type",domain="R-stacomiR"),
pch=c(16,16),
- col=c(mypalette[4],mypalette[6],mypalette[1]),
- #horiz=TRUE,
- ncol=5,
+ col=c("grey","grey40"),
+ horiz=TRUE,
+ #ncol=5,
bty="n")
@@ -283,7 +334,7 @@
xright=graphdate(as.Date(bilanFonctionnementDC at data$per_date_fin[
bilanFonctionnementDC at data$per_etat_fonctionnement==1])),
ytop=3,
- col = mypalette[4],
+ col = mypalette["working"],
border = NA,
lwd = 1) }
if (sum(bilanFonctionnementDC at data$per_etat_fonctionnement==0)>0)
@@ -294,7 +345,7 @@
xright=graphdate(as.Date(bilanFonctionnementDC at data$per_date_fin[
bilanFonctionnementDC at data$per_etat_fonctionnement==0])),
ytop=3,
- col = mypalette[6],
+ col = mypalette["stopped"],
border = NA,
lwd = 1) }
listeperiode<-
@@ -303,25 +354,27 @@
tempsfin=bilanFonctionnementDC at data$per_date_fin,
libelle=bilanFonctionnementDC at data$libelle)
nomperiode<-vector()
-
+ color_periodes<-vector()
for (j in 1 : length(listeperiode)){
- nomperiode[j]<-substr(listeperiode[[j]]$nom,1,17)
+ nomperiode[j]<-substr(listeperiode[[j]]$nom,1,17)
+ color_periode=stringr::str_c("listeperiode",j)
rect( xleft=graphdate(listeperiode[[j]]$debut),
ybottom=1.1,
xright=graphdate(listeperiode[[j]]$fin),
ytop=2,
- col = mypalette[j],
+ col = mypalette[color_periode],
border = NA,
- lwd = 1)
+ lwd = 1)
+ color_periodes<-c(color_periodes,color_periode)
}
legend (x= debut,
y=1.2,
legend= c("working","stopped",nomperiode),
pch=c(15,15),
- col=c(mypalette[4],mypalette[6],mypalette[1:length(listeperiode)]),
+ col=c(mypalette["working"],mypalette["stopped"],mypalette[color_periodes]),
bty="n",
- ncol=7,
+ ncol=length(listeperiode)+2,
text.width=(fin-debut)/10)
}
@@ -348,7 +401,7 @@
ybottom=0,
xright=graphdate(as.Date(t_operation_ope$ope_date_fin)),
ytop=1,
- col = RColorBrewer::brewer.pal(4,"Paired"),
+ col = color_ope,
border = NA,
lwd = 1)
@@ -367,7 +420,7 @@
superpose.polygon<-lattice::trellis.par.get("superpose.polygon")
- superpose.polygon$col= mypalette[c(10,8)]
+ superpose.polygon$col= mypalette[c("weight","eff")]
superpose.polygon$border=rep("transparent",6)
lattice::trellis.par.set("superpose.polygon",superpose.polygon)
fontsize<-lattice::trellis.par.get("fontsize")
Modified: pkg/stacomir/R/stacomi.r
===================================================================
--- pkg/stacomir/R/stacomi.r 2017-04-12 06:17:19 UTC (rev 353)
+++ pkg/stacomir/R/stacomi.r 2017-04-12 16:11:26 UTC (rev 354)
@@ -351,7 +351,7 @@
# loginWindow, will call the husr handler
# user login
if (gr_interface&login_window&database_expected){
- logw <- gWidgets::gwindow(msg$interface_graphique_log.1,
+ logw <- gWidgets::gwindow(gettext("Connection",domain="R-stacomiR"),
name="log",
parent=c(0,0),
width=100,height=100)
@@ -369,8 +369,8 @@
border=TRUE,
handler = husr,
container = logly)
- logly[1,1]<-gettext("User")
- logly[2,1]<-gettext("Password")
+ logly[1,1]<-gettext("User",domain="R-stacomiR")
+ logly[2,1]<-gettext("Password",domain="R-stacomiR")
logly[1,2]<-usrname
logly[2,2]<-usrpwd
logly[3,2]<-but
Modified: pkg/stacomir/inst/config/stacomi_manual_launch.r
===================================================================
--- pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-04-12 06:17:19 UTC (rev 353)
+++ pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-04-12 16:11:26 UTC (rev 354)
@@ -23,12 +23,11 @@
# pour voir apparaitre toutes les requetes dans R
# assign("showmerequest",1,envir=envir_stacomi)
source ("F:/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
-source ("C:/Users/logrami/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
+#source ("C:/Users/logrami/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
libraries()
source("utilitaires.r") # contient funout (pour ecrire dans la console) et filechoose
-source("messages.R")
source("fn_table_per_dis.r")
#source("vector_to_listsql.r")
source("funstatJournalier.r")
Modified: pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R 2017-04-12 06:17:19 UTC (rev 353)
+++ pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R 2017-04-12 16:11:26 UTC (rev 354)
@@ -41,7 +41,21 @@
# not run because of multiple graphical devices
plot(bMM_Arzal,plot.type="standard",silent=TRUE)
+# colors in the following order (glass eel)
+# working, stopped, 1...5 types of operation,numbers, weight, 2 unused colors
+# for yellow eel and other taxa
+# stopped, 1...5 types of operation, ponctuel, expert, calcule,mesure,working,
+plot(bMM_Arzal,plot.type="standard",
+ color=c("#DEF76B","#B950B5","#9ABDDA","#781A74","#BF9D6E","#FFC26E","#A66F24","#012746","#6C3E00","#DC7ED8","#8AA123"),
+ color_ope=c("#5589B5","#FFDB6E","#FF996E","#1C4D76"),
+ silent=TRUE)
+# below we pass a palette instead of color_ope with argument "brew"
+plot(bMM_Arzal,plot.type="standard",
+ color=c("#DEF76B","#B62D2D","#9ABDDA","#781A74","#BF9D6E","#FFC26E","#A66F24","#012746","#6C3E00","black","black"),
+ brew="Blues",
+ silent=TRUE)
+
#cumulated migration at the station (all stages and DC grouped)
plot(bMM_Arzal,plot.type="step")
More information about the Stacomir-commits
mailing list