[Stacomir-commits] r355 - in pkg/stacomir: R inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 13 13:32:31 CEST 2017
Author: briand
Date: 2017-04-13 13:32:30 +0200 (Thu, 13 Apr 2017)
New Revision: 355
Modified:
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/fungraph.r
pkg/stacomir/R/fungraph_civelle.r
pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R
Log:
change to main plot
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2017-04-12 16:11:26 UTC (rev 354)
+++ pkg/stacomir/R/BilanMigration.r 2017-04-13 11:32:30 UTC (rev 355)
@@ -337,7 +337,10 @@
#' @param plot.type One of "standard","step". Defaut to \code{standard} the standard BilanMigration with dc and operation displayed, can also be \code{step} or
#' \code{multiple}
#' @param silent Stops displaying the messages.
-#' @param ... Additional arguments, see \code{plot}, \code{plot.default} and \code{par}
+#' @param color Default NULL, argument passed for the plot.type="standard" method. A vector of color in the following order : (1) working, (2) stopped, (3:7) 1...5 types of operation,
+#' (8:11) numbers, weight, NULL, NULL (if glass eel), (8:11) measured, calculated, expert, direct observation for other taxa. 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 passed to matplot or plot if plot.type="standard", see ... in \link{fungraph_civelle} and \link{fungraph}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("plot",signature(x = "BilanMigration", y = "ANY"),definition=function(x, y,plot.type="standard",silent=FALSE,...){
@@ -394,6 +397,8 @@
stade=stade,
dc=dc,
silent,
+ color=color,
+ color_ope=color_ope,
...)
} else {
@@ -407,7 +412,10 @@
taxon,
stade,
dc,
- silent)
+ color=color,
+ color_ope=color_ope,
+ silent,
+ ...)
}
} # end nrow(data)>0
} # end is.null(data)
Modified: pkg/stacomir/R/BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMult.r 2017-04-12 16:11:26 UTC (rev 354)
+++ pkg/stacomir/R/BilanMigrationMult.r 2017-04-13 11:32:30 UTC (rev 355)
@@ -380,11 +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 Default NULL, argument passed for the plot.type="standard" method. A vector of color in the following order : (1) working, (2) stopped, (3:7) 1...5 types of operation,
+#' (8:11) numbers, weight, NULL, NULL (if glass eel), (8:11) measured, calculated, expert, direct observation for other taxa. 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}
+#' @param ... Additional arguments passed to matplot or plot if plot.type="standard", see ... in \link{fungraph_civelle} and \link{fungraph}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
#method.skeleton("plot", "BilanMigrationMult")
@@ -405,6 +404,7 @@
if (!silent) funout(gettext("Statistics about migration :\n",domain="R-stacomiR"))
#dcnum=1;taxonnum=1;stadenum=2
#&&&&&&&&&&&&&&&&&&&&&&&&&debut de boucle&&&&&&&&&&&&&&&&&&&&&&&&&&&
+ compte<-0
for (dcnum in 1:length(lesdc)){
for (taxonnum in 1:nrow(lestaxons)){
for (stadenum in 1:nrow(lesstades)){
@@ -440,6 +440,7 @@
data_without_hole$MESURE[is.na(data_without_hole$MESURE)]<-0
data_without_hole$EXPERT[is.na(data_without_hole$EXPERT)]<-0
data_without_hole$PONCTUEL[is.na(data_without_hole$PONCTUEL)]<-0
+ compte=compte+1
if (bilanMigrationMult at calcdata[[stringr::str_c("dc_",dc)]][["contient_poids"]]&
taxon=="Anguilla anguilla"&
(stade=="civelle"|stade=="Anguilla jaune")) {
@@ -447,7 +448,7 @@
#----------------------------------
# bilan migration avec poids (civelles
#-----------------------------------------
- dev.new()
+ if (compte!=1) dev.new()
fungraph_civelle(bilanMigration=bilanMigrationMult,
table=data_without_hole,
time.sequence=bilanMigrationMult at time.sequence,
@@ -463,7 +464,7 @@
#----------------------------------
# bilan migration standard
#-----------------------------------------
- dev.new()
+ if (compte!=1) dev.new()
#silent=TRUE
fungraph(bilanMigration=bilanMigrationMult,
tableau=data_without_hole,
@@ -485,8 +486,7 @@
}
}
#&&&&&&&&&&&&&&&&&&&&&&&&&fin de boucle&&&&&&&&&&&&&&&&&&&&&&&&&&&
- }
-
+ }
#==========================type=2=============================
if (plot.type=="step"){
lestaxons= paste(bilanMigrationMult at taxons@data$tax_nom_latin,collapse=",")
Modified: pkg/stacomir/R/fungraph.r
===================================================================
--- pkg/stacomir/R/fungraph.r 2017-04-12 16:11:26 UTC (rev 354)
+++ pkg/stacomir/R/fungraph.r 2017-04-13 11:32:30 UTC (rev 355)
@@ -14,11 +14,11 @@
#' @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)]
+#' for the fishway or DC, measured, calculated, expert, direct observation. 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
+#' @param ... additional parameters passed to matplot, main, ylab, ylim, lty, pch, bty, cex.main,
+#' it is currenly not a good idea to change xlim (numbers are wrong, the month plot covers all month, and legend placement is wrong
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
fungraph=function(bilanMigration,tableau,time.sequence,taxon,stade,dc=NULL,silent,color=NULL,color_ope=NULL,...){
#mat <- matrix(1:6,3,2)
@@ -28,6 +28,7 @@
# color=null
# color calculation
+
if (is.null(color)) {
tp<-RColorBrewer::brewer.pal(12,"Paired")
mypalette=c(
@@ -61,14 +62,7 @@
}
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"]]
- }
+ if(stacomirtools::is.odd(dc)) brew="Paired" else brew="Accent"
color_ope=RColorBrewer::brewer.pal(8,brew)
}
@@ -96,20 +90,45 @@
###################################
# Graph annuel couvrant sequence >0
####################################
- matplot(x,cbind(tableau$MESURE+tableau$CALCULE+tableau$EXPERT+tableau$PONCTUEL,
+ dots<-list(...)
+ if (!"main"%in%names(dots)) main=gettextf("Glass eels graph %s, %s, %s, %s",dis_commentaire,taxon,stade,annee,domain="R-stacomiR")
+ else main=dots[["main"]]
+ if (!"ylab"%in%names(dots)) ylab=gettext("Number of glass eels (x1000)",domain="R-stacomiR")
+ else ylab=dots[["ylab"]]
+ if (!"cex.main"%in%names(dots)) cex.main=1
+ else cex.main=dots[["cex.main"]]
+ if (!"font.main"%in%names(dots)) font.main=1
+ else font.main=dots[["font.main"]]
+ if (!"type"%in%names(dots)) type="h"
+ else type=dots[["type"]]
+ if (!"xlim"%in%names(dots)) xlim=c(debut,fin)
+ else xlim=c(debut,fin)#dots[["xlim"]] # currently this argument is ignored
+ if (!"ylim"%in%names(dots)) ylim=NULL
+ else ylim=dots[["ylim"]]
+ if (!"cex"%in%names(dots)) cex=1
+ else cex=dots[["cex"]]
+ if (!"lty"%in%names(dots)) lty=1
+ else lty=dots[["lty"]]
+ if (!"pch"%in%names(dots)) pch=16
+ else pch=dots[["pch"]]
+ if (!"bty"%in%names(dots)) bty="l"
+ else bty=dots[["bty"]]
+ matplot(time.sequence,cbind(tableau$MESURE+tableau$CALCULE+tableau$EXPERT+tableau$PONCTUEL,
tableau$MESURE+tableau$CALCULE+tableau$EXPERT,
tableau$MESURE+tableau$CALCULE,
tableau$MESURE),
col=mypalette[c("ponctuel","expert","calcule","mesure")],
- type=c("h","h","h","h"),
- pch=16,
- lty=1,
+ type=type,
+ pch=pch,
+ lty=lty,
xaxt="n",
- bty="l",
- 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,...)
+ bty=bty,
+ ylab=ylab,
+ xlab=NULL,
+ main=main,
+ xlim=c(debut,fin),
+ cex.main=cex.main,
+ font.main=font.main)
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)
@@ -121,7 +140,7 @@
mtext(text=gettextf("Sum of numbers =%s",
round(sum(tableau$MESURE,tableau$CALCULE,tableau$EXPERT,tableau$PONCTUEL,na.rm=TRUE)),domain="R-stacomiR"),
side=3,
- col=RColorBrewer::brewer.pal(5,"Paired")[5],
+ col=mypalette["expert"],
cex=0.8)
legend(x=0,
@@ -164,14 +183,14 @@
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.POSIXct(time.sequence),
seq(0,3,length.out=nrow(tableau)),
- xlim=c(debut,fin),
+ xlim=xlim,
type= "n",
xlab="",
xaxt="n",
yaxt="n",
ylab=gettext("Fishway",domain="R-stacomiR"),
bty="n",
- cex=1.2)
+ cex=cex+0.2)
###################################
# temps de fonctionnement du DF
@@ -266,14 +285,15 @@
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.POSIXct(time.sequence),
seq(0,3,length.out=nrow(tableau)),
- xlim=c(debut,fin),
+ xlim=xlim,
type= "n",
xlab="",
xaxt="n",
yaxt="n",
ylab=gettext("CD",domain="R-stacomiR"),
bty="n",
- cex=1.2)
+ cex=cex+0.2
+ )
###################################
# temps de fonctionnement du DC
###################################
@@ -366,14 +386,14 @@
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.POSIXct(time.sequence),
seq(0,1,length.out=nrow(tableau)),
- xlim=c(debut,fin),
+ xlim=xlim,
type= "n",
xlab="",
xaxt="n",
yaxt="n",
ylab=gettext("Op",domain="R-stacomiR"),
bty="n",
- cex=1.2)
+ cex=cex+0.2)
###################################
# operations
###################################
Modified: pkg/stacomir/R/fungraph_civelle.r
===================================================================
--- pkg/stacomir/R/fungraph_civelle.r 2017-04-12 16:11:26 UTC (rev 354)
+++ pkg/stacomir/R/fungraph_civelle.r 2017-04-13 11:32:30 UTC (rev 355)
@@ -17,7 +17,8 @@
#' 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
+#' @param ... additional parameters passed to plot, main, ylab, cex.main, font.main, type, xlim, ylim, lty, bty, pch
+#' it is not possible to change xlim
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
fungraph_civelle=function(bilanMigration,table,time.sequence,taxon,stade,dc=null,silent,color=NULL,color_ope=NULL,...){
# color=null
@@ -36,7 +37,7 @@
"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(
@@ -54,15 +55,9 @@
)
}
+
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"]]
- }
+ if(stacomirtools::is.odd(dc)) brew="Paired" else brew="Accent"
color_ope=RColorBrewer::brewer.pal(8,brew)
}
@@ -88,26 +83,52 @@
layout(mat)
#par("bg"=grDevices::gray(0.8))
graphics::par("mar"=c(3, 4, 3, 2) + 0.1)
- plot(as.Date(time.sequence,"Europe/Paris"),eff/1000,
+ dots<-list(...)
+ if (!"main"%in%names(dots)) main=gettextf("Glass eels graph %s, %s, %s, %s",dis_commentaire,taxon,stade,annee,domain="R-stacomiR")
+ else main=dots[["main"]]
+ if (!"ylab"%in%names(dots)) ylab=gettext("Number of glass eels (x1000)",domain="R-stacomiR")
+ else ylab=dots[["ylab"]]
+ if (!"cex.main"%in%names(dots)) cex.main=1
+ else cex.main=dots[["cex.main"]]
+ if (!"font.main"%in%names(dots)) font.main=1
+ else font.main=dots[["font.main"]]
+ if (!"type"%in%names(dots)) type="h"
+ else type=dots[["type"]]
+ if (!"xlim"%in%names(dots)) xlim=c(debut,fin)
+ else xlim=dots[["xlim"]]
+ if (!"ylim"%in%names(dots)) ylim=c(0,max(eff/1000,na.rm=TRUE))*1.2
+ else xlim=c(debut,fin)#dots[["xlim"]] # currently this argument is ignored
+ if (!"cex"%in%names(dots)) cex=1
+ else cex=dots[["cex"]]
+ if (!"lty"%in%names(dots)) lty=1
+ else lty=dots[["lty"]]
+ if (!"pch"%in%names(dots)) pch=16
+ else pch=dots[["pch"]]
+ if (!"bty"%in%names(dots)) bty="l"
+ else bty=dots[["bty"]]
+ plot(x=as.Date(time.sequence,"Europe/Paris"),
+ y=eff/1000,
col=mypalette["eff"],
- type="h",
- xlim=c(debut,fin),
- ylim=c(0,max(eff/1000,na.rm=TRUE))*1.2 ,
- lty=1,
+ type=type,
+ xlim=xlim,
+ ylim= ylim,
+ lty=lty,
xaxt="n",
- ylab=gettext("Number of glass eels (x1000)",domain="R-stacomiR"),
+ ylab=ylab,
#xlab="date",
- cex.main=1,
- font.main=1,
- main=gettextf("Glass eels graph %s, %s, %s, %s",dis_commentaire,taxon,stade,annee,domain="R-stacomiR"),
- ...)
+ cex.main=cex.main,
+ font.main=font.main,
+ main=main,
+ cex=cex,
+ pch=pch,
+ bty=bty)
#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")
points(as.Date(time.sequence,"Europe/Paris"),eff.p/1000,
- type="h",
- lty=1,
+ type=type,
+ lty=lty,
col=mypalette["weight"])
legend(x="topright",
@@ -122,32 +143,38 @@
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["eff"],
- adj=1)
+ adj=1,
+ cex=cex)
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["eff"],
- adj=1)
+ adj=1,
+ cex=cex)
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["weight"],
- adj=1)
+ adj=1,
+ cex=cex)
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["weight"],
- adj=1)
+ adj=1,
+ cex=cex)
text( x=debut+3+(fin-debut)/8,
y=max(eff/1000,na.rm=TRUE)*1.1,
labels=paste(round(sum(table$Poids_total,table$poids_depuis_effectifs,na.rm=TRUE)/1000,2)," kg"),
col="black",
- adj=1)
+ adj=1,
+ cex=cex)
text( x=debut+3*(fin-debut)/8,
y=max(eff/1000,na.rm=TRUE)*1.1,
labels= paste("N=",round(sum(eff,na.rm=TRUE))),
col="black",
- adj=1)
+ adj=1,
+ cex=cex)
segments(x0=debut,y0=max(eff/1000,na.rm=TRUE)*1.125,
x1=debut+3*(fin-debut)/8,y1=max(eff/1000,na.rm=TRUE)*1.125)
@@ -183,14 +210,14 @@
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.Date(time.sequence),
seq(0,3,length.out=length(eff)),
- xlim=c(debut,fin),
+ xlim=xlim,
type= "n",
xlab="",
xaxt="n",
yaxt="n",
ylab=gettext("Fishway",domain="R-stacomiR"),
bty="n",
- cex=1.2)
+ cex=cex+0.2)
###################################
# temps de fonctionnement du DF
@@ -286,14 +313,14 @@
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.Date(time.sequence),
seq(0,3,length.out=length(eff)),
- xlim=c(debut,fin),
+ xlim=xlim,
type= "n",
xlab="",
xaxt="n",
yaxt="n",
ylab=gettext("CD",domain="R-stacomiR"),
bty="n",
- cex=1.2)
+ cex=cex+0.2)
###################################
# temps de fonctionnement du DC
###################################
@@ -370,7 +397,7 @@
legend (x= debut,
y=1.2,
- legend= c("working","stopped",nomperiode),
+ legend= gettext("working","stopped",nomperiode,domain="R-stacomiR"),
pch=c(15,15),
col=c(mypalette["working"],mypalette["stopped"],mypalette[color_periodes]),
bty="n",
@@ -386,14 +413,14 @@
graphics::par("mar"=c(0, 4, 0, 2)+ 0.1)
plot( as.Date(time.sequence),
seq(0,1,length.out=length(eff)),
- xlim=c(debut,fin),
+ xlim=xlim,
type= "n",
xlab="",
xaxt="n",
yaxt="n",
ylab=gettext("Op",domain="R-stacomiR"),
bty="n",
- cex=1.2)
+ cex=cex+0.2)
###################################
# operations
###################################
@@ -427,16 +454,16 @@
fontsize$text=10
lattice::trellis.par.set("fontsize",fontsize)
par.main.text<-lattice::trellis.par.get("par.main.text")
- par.main.text$cex=1
+ par.main.text$cex=cex
par.main.text$font=1
lattice::trellis.par.set("par.main.text",par.main.text)
par.ylab.text<-lattice::trellis.par.get("par.ylab.text")
- par.ylab.text$cex=0.8
+ par.ylab.text$cex=cex-0.2
lattice::trellis.par.set("par.ylab.text",par.ylab.text)
par.xlab.text<-lattice::trellis.par.get("par.xlab.text")
- par.xlab.text$cex=0.8
+ par.xlab.text$cex=cex-0.2
lattice::trellis.par.set("par.xlab.text",par.xlab.text)
Modified: pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R 2017-04-12 16:11:26 UTC (rev 354)
+++ pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R 2017-04-13 11:32:30 UTC (rev 355)
@@ -50,10 +50,16 @@
color_ope=c("#5589B5","#FFDB6E","#FF996E","#1C4D76"),
silent=TRUE)
-# below we pass a palette instead of color_ope with argument "brew"
+# Other arguments can be passed to plot including xlim but the rendering might not
+# be that good
plot(bMM_Arzal,plot.type="standard",
- color=c("#DEF76B","#B62D2D","#9ABDDA","#781A74","#BF9D6E","#FFC26E","#A66F24","#012746","#6C3E00","black","black"),
- brew="Blues",
+ color=color,
+ color_ope=color_ope,
+ main="Effectif civelles piège Gabion (rive gauche) en 2016",
+ cex.main=1.1,
+ lty=2,
+ type="b",
+ xlim=
silent=TRUE)
#cumulated migration at the station (all stages and DC grouped)
More information about the Stacomir-commits
mailing list