[Stacomir-commits] r231 - in pkg/stacomir: . R data inst/config inst/examples inst/tests/testthat man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 28 11:58:56 CEST 2016
Author: briand
Date: 2016-10-28 11:58:55 +0200 (Fri, 28 Oct 2016)
New Revision: 231
Added:
pkg/stacomir/data/bmi.rda
pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R
pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R
pkg/stacomir/man/bmi.Rd
pkg/stacomir/man/choice_c-BilanMigrationInterAnnuelle-method.Rd
pkg/stacomir/man/choice_c-RefAnnee-method.Rd
pkg/stacomir/man/hbilanMigrationgraph.Rd
pkg/stacomir/man/hsummaryBilanMigrationInterannuelle.Rd
pkg/stacomir/man/plot-BilanMigrationInterAnnuelle-missing-method.Rd
pkg/stacomir/man/summary-BilanMigrationInterAnnuelle-method.Rd
pkg/stacomir/man/write_database.Rd
Removed:
pkg/stacomir/man/htableBilanMigrationInterAnnuelle.Rd
Modified:
pkg/stacomir/DESCRIPTION
pkg/stacomir/NAMESPACE
pkg/stacomir/R/BilanFonctionnementDC.r
pkg/stacomir/R/BilanFonctionnementDF.r
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/BilanMigrationInterAnnuelle.r
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/Bilan_carlot.r
pkg/stacomir/R/RefAnnee.r
pkg/stacomir/R/data.r
pkg/stacomir/R/fn_EcritBilanJournalier.r
pkg/stacomir/R/funtable.r
pkg/stacomir/R/interface_BilanMigrationInterannuelle.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/data/b_carlot.rda
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/config/testthat.R
pkg/stacomir/inst/examples/bilanMigration_Arzal.R
pkg/stacomir/inst/examples/bilancarlot_example.R
pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R
pkg/stacomir/man/BilanEspeces-class.Rd
pkg/stacomir/man/BilanFonctionnementDC-class.Rd
pkg/stacomir/man/BilanFonctionnementDF-class.Rd
pkg/stacomir/man/BilanMigration-class.Rd
pkg/stacomir/man/BilanMigrationConditionEnv-class.Rd
pkg/stacomir/man/BilanMigrationInterAnnuelle-class.Rd
pkg/stacomir/man/BilanMigrationMult-class.Rd
pkg/stacomir/man/Bilan_carlot-class.Rd
pkg/stacomir/man/Bilan_poids_moyen-class.Rd
pkg/stacomir/man/Bilan_stades_pigm-class.Rd
pkg/stacomir/man/Bilan_taille-class.Rd
pkg/stacomir/man/RefAnnee-class.Rd
pkg/stacomir/man/RefCheckBox-class.Rd
pkg/stacomir/man/RefChoix-class.Rd
pkg/stacomir/man/RefCoe-class.Rd
pkg/stacomir/man/RefDC-class.Rd
pkg/stacomir/man/RefDF-class.Rd
pkg/stacomir/man/RefHorodate-class.Rd
pkg/stacomir/man/RefListe-class.Rd
pkg/stacomir/man/RefStades-class.Rd
pkg/stacomir/man/RefTaxon-class.Rd
pkg/stacomir/man/Refpar-class.Rd
pkg/stacomir/man/Refparqual-class.Rd
pkg/stacomir/man/Refparquan-class.Rd
pkg/stacomir/man/Refperiode-class.Rd
pkg/stacomir/man/charge-BilanMigrationInterAnnuelle-method.Rd
pkg/stacomir/man/charge-RefAnnee-method.Rd
pkg/stacomir/man/charge-RefChoix-method.Rd
pkg/stacomir/man/charge-RefMsg-method.Rd
pkg/stacomir/man/connect-BilanMigrationInterAnnuelle-method.Rd
pkg/stacomir/man/fn_EcritBilanJournalier.Rd
pkg/stacomir/man/fundat.Rd
pkg/stacomir/man/hbilanMigrationgraph2.Rd
pkg/stacomir/man/hbilanMigrationwrite.Rd
pkg/stacomir/man/plot-BilanFonctionnementDC-ANY-method.Rd
pkg/stacomir/man/plot-BilanFonctionnementDF-ANY-method.Rd
pkg/stacomir/man/plot-BilanMigration-ANY-method.Rd
pkg/stacomir/man/plot-Bilan_carlot-missing-method.Rd
pkg/stacomir/man/print-BilanMigration-method.Rd
Log:
BilanMigrationInterAnnuelle integrated to 0.5
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2016-10-23 15:09:33 UTC (rev 230)
+++ pkg/stacomir/DESCRIPTION 2016-10-28 09:58:55 UTC (rev 231)
@@ -102,7 +102,8 @@
lubridate,
dplyr
Suggests:
- testthat
+ testthat,
+ viridis
Author: Cedric Briand [aut, cre],
Marion Legrand [aut]
Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
Modified: pkg/stacomir/NAMESPACE
===================================================================
--- pkg/stacomir/NAMESPACE 2016-10-23 15:09:33 UTC (rev 230)
+++ pkg/stacomir/NAMESPACE 2016-10-28 09:58:55 UTC (rev 231)
@@ -8,6 +8,7 @@
export(fun_bilanMigrationMult_Overlaps)
export(fun_char_spe)
export(funboxplotBilan_carlot)
+export(fundat)
export(fundensityBilan_carlot)
export(funout)
export(funpointBilan_carlot)
Modified: pkg/stacomir/R/BilanFonctionnementDC.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDC.r 2016-10-23 15:09:33 UTC (rev 230)
+++ pkg/stacomir/R/BilanFonctionnementDC.r 2016-10-28 09:58:55 UTC (rev 231)
@@ -150,6 +150,7 @@
#' with the number of the DF
#' @return Nothing but prints the different plots
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @aliases plot.BilanFonctionnementDC plot.bilanFonctionnementDC plot.bfDC
#' @export
setMethod("plot",signature(x = "BilanFonctionnementDC", y = "ANY"), definition=
function(x,
Modified: pkg/stacomir/R/BilanFonctionnementDF.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDF.r 2016-10-23 15:09:33 UTC (rev 230)
+++ pkg/stacomir/R/BilanFonctionnementDF.r 2016-10-28 09:58:55 UTC (rev 231)
@@ -161,6 +161,7 @@
#' @param main The title of the graph, if NULL a default title will be plotted with the number of the DF
#' @return Nothing but prints the different plots
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @aliases plot.BilanFonctionnementDF plot.bilanFonctionnementDF plot.bfDF
#' @export
setMethod("plot",signature(x = "BilanFonctionnementDF", y = "ANY"),definition=function(x, y,plot.type=1,silent=FALSE,main=NULL){
#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2016-10-23 15:09:33 UTC (rev 230)
+++ pkg/stacomir/R/BilanMigration.r 2016-10-28 09:58:55 UTC (rev 231)
@@ -272,13 +272,14 @@
funout(get("msg",envir_stacomi)$BilanMigration.3)
funout(get("msg",envir_stacomi)$BilanMigration.4)
}
- return(bilanMigration)
+
} else {
# no fish...
funout(get("msg",envir_stacomi)$BilanMigration.10)
}
+ return(bilanMigration)
})
@@ -320,7 +321,7 @@
-#' Plots of various type for BilanMigration, and performs writing to the database of daily values.
+#' Plots of various type for BilanMigration.
#'
#' \itemize{
#' \item{plot.type="standard"}{calls \code{\link{fungraph}} and \code{\link{fungraph_civelle}} functions to plot as many "bilanmigration"
Modified: pkg/stacomir/R/BilanMigrationInterAnnuelle.r
===================================================================
--- pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2016-10-23 15:09:33 UTC (rev 230)
+++ pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2016-10-28 09:58:55 UTC (rev 231)
@@ -1,11 +1,12 @@
-#' Class "BilanMigrationConditionEnv"
+#' Class "BilanMigrationInterAnnuelle"
#'
-#' Enables to compute an annual overview of fish migration and environmental
-#' conditions in the same chart
+#' When daily bilan are written in the t_bilanjournalier_bjo table by the
+#' \link{BilanMigration-class} they can be used by this class to display
+#' interannual comparisons of migration. Different charts are produced with different
+#' period grouping. See \link{fn_EcritBilanJournalier} for details about the writing to the
+#' t_bilanjournalier_bjo table.
#'
-#'
#' @include RefAnnee.r
-
#' @slot dc Object of class \code{\link{RefDC-class}}, the counting device
#' @slot data Object of class \code{"data.frame"} data for bilan lot
#' @slot taxons An object of class \code{\link{RefTaxon-class}}
@@ -17,6 +18,7 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @family Bilan Objects
#' @keywords classes
+#' @example inst/examples/bilanMigrationInterAnnuelle_example.R
#' @export
setClass(Class="BilanMigrationInterAnnuelle",representation=
representation(
@@ -39,7 +41,7 @@
#' connect method for BilanMigrationInterannuelle class
#' @param object An object of class \link{BilanMigrationInterAnnuelle-class}
#' @param silent Stops messages from being displayed if silent=TRUE, default FALSE
-#' @return bilanMigrationInterannuelle an instantianted object with values filled with user choice
+#' @return bilanMigrationInterAnnuelle an instantianted object with values filled with user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("connect",signature=signature("BilanMigrationInterAnnuelle"),
@@ -114,78 +116,472 @@
#' loading method for BilanMigrationInterannuelle class
#' @param object An object of class \link{BilanMigrationInterAnnuelle-class}
+#' @param silent Boolean, if TRUE, information messages are not displayed
#' @return An object of class \link{BilanMigrationInterAnnuelle-class}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("charge",signature=signature("BilanMigrationInterAnnuelle"),
- definition=function(object)
+ definition=function(object,silent)
{
+ bilanMigrationInterAnnuelle<-object
if (exists("refDC",envir_stacomi)) {
- object at dc<-get("refDC",envir_stacomi)
+ bilanMigrationInterAnnuelle at dc<-get("refDC",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.1,arret=TRUE)
}
if (exists("refTaxon",envir_stacomi)) {
- object at taxons<-get("refTaxon",envir_stacomi)
+ bilanMigrationInterAnnuelle at taxons<-get("refTaxon",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.2,arret=TRUE)
}
if (exists("refStades",envir_stacomi)){
- object at stades<-get("refStades",envir_stacomi)
+ bilanMigrationInterAnnuelle at stades<-get("refStades",envir_stacomi)
} else
{
funout(get("msg",envir_stacomi)$ref.3,arret=TRUE)
}
if (exists("anneeDebut",envir_stacomi)) {
- object at anneeDebut<-get("anneeDebut",envir_stacomi)
+ bilanMigrationInterAnnuelle at anneeDebut<-get("anneeDebut",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.10,arret=TRUE)
}
if (exists("anneeFin",envir_stacomi)) {
- object at anneeFin<-get("anneeFin",envir_stacomi)
+ bilanMigrationInterAnnuelle at anneeFin<-get("anneeFin",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.11,arret=TRUE)
}
- object<-connect(object)
- assign("bilanMigrationInterannuelle",object,envir_stacomi)
+ assign("bilanMigrationInterAnnuelle",bilanMigrationInterAnnuelle,envir_stacomi)
funout(get("msg",envir_stacomi)$BilanMigrationInterannuelle.11)
- return(object)
+ return(bilanMigrationInterAnnuelle)
}
)
+
+#' command line interface for BilanMigrationInterAnnuelle class
+#' @param object An object of class \link{BilanMigrationInterAnnuelle-class}
+#' @param dc A numeric or integer, the code of the dc, coerced to integer,see \link{choice_c,RefDC-method}
+#' @param taxons Either a species name in latin or the SANDRE code for species (ie 2038=Anguilla anguilla),
+#' it should match the ref.tr_taxon_tax referential table in the stacomi database, see \link{choice_c,RefTaxon-method}
+#' @param stades A stage code matching the ref.tr_stadedeveloppement_std table in the stacomi database, see \link{choice_c,RefStades-method}
+#' @param anneedebut The starting the first year, passed as charcter or integer
+#' @param anneefin the finishing year
+#' @param silent Boolean, if TRUE, information messages are not displayed
+#' @return An object of class \link{BilanMigrationInterAnnuelle-class}
+#' The choice_c method fills in the data slot for classes \link{RefDC-class}, \link{RefTaxon-class}, \link{RefStades-class} and two slots of \link{RefAnnee-class}
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("choice_c",signature=signature("BilanMigrationInterAnnuelle"),definition=function(object,
+ dc,
+ taxons,
+ stades,
+ anneedebut,
+ anneefin,
+ silent=FALSE){
+ # code for debug using example
+ #bilanMigrationInterAnnuelle<-bmi;dc=c(16);taxons="Anguilla anguilla";stades=c("AGJ");anneedebut="1984";anneefin="2016"
+ bilanMigrationInterAnnuelle<-object
+ bilanMigrationInterAnnuelle at dc=charge(bilanMigrationInterAnnuelle at dc)
+ # loads and verifies the dc
+ # this will set dc_selectionne slot
+ bilanMigrationInterAnnuelle at dc<-choice_c(object=bilanMigrationInterAnnuelle at dc,dc)
+ # only taxa present in the bilanMigration are used
+ bilanMigrationInterAnnuelle at taxons<-charge_avec_filtre(object=bilanMigrationInterAnnuelle at taxons,bilanMigrationInterAnnuelle at dc@dc_selectionne)
+ bilanMigrationInterAnnuelle at taxons<-choice_c(bilanMigrationInterAnnuelle at taxons,taxons)
+ bilanMigrationInterAnnuelle at stades<-charge_avec_filtre(object=bilanMigrationInterAnnuelle at stades,bilanMigrationInterAnnuelle at dc@dc_selectionne,bilanMigrationInterAnnuelle at taxons@data$tax_code)
+ bilanMigrationInterAnnuelle at stades<-choice_c(bilanMigrationInterAnnuelle at stades,stades)
+
+ bilanMigrationInterAnnuelle at anneeDebut<-charge(object=bilanMigrationInterAnnuelle at anneeDebut,
+ objectBilan="BilanMigrationInterAnnuelle")
+ bilanMigrationInterAnnuelle at anneeDebut<-choice_c(object=bilanMigrationInterAnnuelle at anneeDebut,
+ nomassign="anneeDebut",
+ annee=anneedebut,
+ silent=silent)
+ bilanMigrationInterAnnuelle at anneeFin@data<-bilanMigrationInterAnnuelle at anneeDebut@data
+ bilanMigrationInterAnnuelle at anneeFin<-choice_c(object=bilanMigrationInterAnnuelle at anneeFin,
+ nomassign="anneeFin",
+ annee=anneefin,
+ silent=silent)
+ assign("bilanMigrationInterAnnuelle",bilanMigrationInterAnnuelle,envir=envir_stacomi)
+ return(bilanMigrationInterAnnuelle)
+ })
+
+
+#' Plot method for BilanMigrationInterannuelle
+#'
+#' @param x An object of class BilanMigrationInterannuelle
+#' @param plot.type Default standard
+#' @param timesplit Used for plot.type barchart or dotplot, Default mois (month) other possible values are semaine (week), quinzaine (2 weeks),
+#' english values within parenthesis are also accepted.
+#' @param silent Stops displaying the messages.
+#' \itemize{
+#' \item{plot.type="line": one line per daily bilanmigration}
+#' \item{plot.type="standard": the current year is displayed against a ribbon of historical values"}
+#' \item{plot.type="density": creates density plot to compare seasonality, data computed by 15 days period}
+#' \item{plot.type="step" : creates step plots to compare seasonality, the year chosen in the interface is the
+#' latest if silent=TRUE, or it can be selected in the droplist. It is highlighted against the other with a dotted line}
+#' \item{plot.type="barchart": comparison of daily migration of one year against periodic migration for the other years available in the chronicle,
+#' different periods can be chosen with argument timesplit}
+#' \item{plot.type="pointrange": Pointrange graphs, different periods can be chosen with argument timesplit}
+#' }
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @aliases plot.BilanMigrationInterAnnuelle plot.bilanMigrationInterAnnuelle plot.bmi
+#' @seealso \link{BilanMigrationInterAnnuelle-class} for examples
+#' @export
+setMethod("plot",signature(x = "BilanMigrationInterAnnuelle", y = "missing"),definition=function(x, plot.type="standard",timesplit="mois",silent=FALSE){
+ #bilanMigrationInterAnnuelle<-bmi
+ bilanMigrationInterAnnuelle<-x
+ if (!timesplit%in%c("month","mois","week","semaine","month","mois","quinzaine","2 weeks")) stop (
+ stringr::str_c("timesplit should be one of :","month","mois","week","semaine","month","mois","quinzaine","2 weeks"))
+ # back to french labels for consistency with fundat code
+ timesplit<-switch(timesplit,"week"="semaine","month"="mois","2 weeks"="quinzaine",timesplit)
+ # plot.type="line";require(ggplot2)
+ if(nrow(bilanMigrationInterAnnuelle at data)>0){
+ if (plot.type=="line"){
+ # TODO traitement des poids
+ dat=bilanMigrationInterAnnuelle at data
+ dat<-dat[dat$bjo_labelquantite=="Effectif_total",]
+ dat<-stacomirtools::chnames(dat,c("bjo_annee","bjo_jour","bjo_labelquantite","bjo_valeur"), c("annee","jour","labelquantite","valeur"))
+ # we need to choose a date, every year brought back to 2000
+ dat$jour = as.POSIXct(strptime(strftime(dat$jour,'2000-%m-%d %H:%M:%S'),format='%Y-%m-%d %H:%M:%S'),tz="GMT")
+ dat$annee=as.factor(dat$annee)
+ dat=stacomirtools::killfactor(dat)
+ titre=paste(get("msg",envir_stacomi)$BilanMigrationInterannuelle.4,
+ paste(min(dat$annee),max(dat$annee), collapse=":"),
+ ", ",
+ bilanMigrationInterAnnuelle at dc@data$dis_commentaires[bilanMigrationInterAnnuelle at dc@data$dc==bilanMigrationInterAnnuelle at dc@dc_selectionne])
+ soustitre=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin, ", ", bilanMigrationInterAnnuelle at stades@data$std_libelle, sep="")
+ g<-ggplot(dat,aes(x=jour,y=valeur))
+ g<-g+geom_line(aes(color=annee))+ labs(title=paste(titre, "\n", soustitre))+
+ scale_x_datetime(name="date")
+ print(g)
+ assign("g",g,envir=envir_stacomi)
+ funout(get("msg",envir_stacomi)$BilanMigrationPar.6)
+ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ } else if (plot.type=="standard"){
+ dat=bilanMigrationInterAnnuelle at data
+ if (silent==FALSE){
+ the_choice=as.numeric(select.list(choices=as.character(unique(dat$bjo_annee )[order(unique(dat$bjo_annee ))]),
+ preselect=as.character(max(dat$bjo_annee )),
+ "choice annee",multiple=FALSE))
+ } else {
+ the_choice=max(dat$bjo_annee)
+ }
+ # dataset for current year
+ dat0=fundat(dat,annee=NULL,timesplit=NULL)
+ dat=fundat(dat,annee=the_choice,timesplit=NULL)
+ dat=dat[dat$moyenne!=0,] # pour des raisons graphiques on ne garde pas les effectifs nuls generes par fundat
+ newdat=dat[match(unique(as.character(dat$jour)),as.character(dat$jour)),]
+ newdat=newdat[order(newdat$jour),] # pour avoir les range sur l'ensemble des valeurs dispo et pas seult l'annee en cours
+ amplitude=paste(min(as.numeric(as.character(dat$annee))),"-",max(as.numeric(as.character(dat$annee))),sep="")
+ if (length(the_choice)>0) {
+ # le layout pour l'affichage des graphiques
+ vplayout <- function(x, y) { grid::viewport(layout.pos.row = x, layout.pos.col = y) }
+ grid::grid.newpage()
+ grid::pushViewport(grid::viewport(layout = grid::grid.layout(length(the_choice),1,just="center")))
+ amplitudechoice<-paste(the_choice,'/',amplitude)
+ tmp <- dat0[as.numeric(as.character(dat0$annee))==the_choice,]
+ tmp$annee=as.character(tmp$annee)
+ g <- ggplot(newdat,aes(x=jour))
+ g <- g+geom_ribbon(aes(ymin=mintab, ymax=maxtab,fill="amplitude"),color="grey20",alpha=0.5)
+ g <- g+geom_bar(aes(y=valeur,fill=I("orange")),position="dodge",stat="identity",color="grey20",alpha=0.8,data=tmp)
+ g<- g+ scale_fill_manual(name=eval(amplitudechoice), values=c("#35789C","orange"),
+ labels = c("amplitude historique",the_choice))
+ #g <- g+geom_point(aes(y=valeur,col=annee),data=tmp,pch=16,size=1)
+ # moyenne interannuelle
+
+ g <- g+ geom_line(aes(y=moyenne,col=I("#002743")),data=newdat)
+ g <- g+ geom_point(aes(y=moyenne,col=I("#002743")),size=1.2,data=newdat)
+ g <- g+ scale_colour_manual(name=eval(amplitudechoice),values=c("#002743"),
+ labels=c(stringr::str_c("Moyenne interannuelle\n",amplitude)))+
+ guides(fill = guide_legend(reverse=TRUE))
+ g <- g+labs(title=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin,",",bilanMigrationInterAnnuelle at stades@data$std_libelle,unique(as.character(tmp$annee)),"/",amplitude))
+ g <- g+scale_x_datetime(name="date",date_breaks="months",date_minor_breaks="weeks", date_labels="%d-%m")
+ g<-g+theme_bw()+ theme(legend.key = element_blank())
+ print(g, vp=vplayout(1,1))
+ assign(paste("g",1,sep=""),g,envir_stacomi)
+ funout(paste(get("msg",envir_stacomi)$BilanMigrationInterannuelle.10,"i=",paste(1:length(the_choice),collapse=","),"\n"))
+
+
+ } # end if
+ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ } else if (plot.type=="step"){
+ dat=bilanMigrationInterAnnuelle at data
+ dat=fundat(dat)
+ #dat=dat[order(dat$annee,dat$jour),]
+ dat$valeur[is.na(dat$valeur)]<-0 # sinon si il ne reste qu'une ligne peut planter
+ if (silent==FALSE){
+ the_choice=select.list(choices=as.character(unique(dat$annee)),preselect=as.character(max(dat$annee)),"choice annee",multiple=FALSE)
+ } else {
+ the_choice=max(as.numeric(as.character(dat$annee)))
+ }
+ amplitude=paste(min(as.numeric(as.character(dat$annee))),"-",max(as.numeric(as.character(dat$annee))),sep="")
+ #################
+ # Calcul des cumsum
+ ###################
+
+ #dat$valeur[dat$valeur<0]<-0
+ for (an in unique(dat$annee)){
+ # an=as.character(unique(dat$annee)) ;an<-an[1]
+ dat[dat$annee==an,"cumsum"]<-cumsum(dat[dat$annee==an,"valeur"])
+ dat[dat$annee==an,"total_annuel"]<-max(dat[dat$annee==an,"cumsum"])
+ }
+ dat$cumsum=dat$cumsum/dat$total_annuel
+ dat$jour=as.Date(dat$jour)
+ dat$annee=as.factor(dat$annee)
+ # bug, enleve les annees avec seulement une ligne
+
+ #################
+ # Graphique
+ ###################
+
+ g <- ggplot(dat,aes(x=jour,y=cumsum))
+ tmp<-dat[as.numeric(as.character(dat$annee))==as.numeric(the_choice),]
+ g <- g+geom_step(aes(col=annee,size=total_annuel))
+ g <- g+geom_step(data=tmp,col="black",lty=2)
+ g<-g+labs(title=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin,",",bilanMigrationInterAnnuelle at stades@data$std_libelle,get("msg",envir_stacomi)$BilanMigrationInterannuelle.9,amplitude))
+ g<-g+scale_y_continuous(name=get("msg",envir_stacomi)$BilanMigrationInterannuelle.8)
+ g<-g+scale_x_date(name=get("msg",envir_stacomi)$BilanMigrationInterannuelle.7,date_breaks="months",
+ date_minor_breaks="weeks",
+ date_labels="%b",
+ limits=range(dat[dat$valeur>0&dat$cumsum!=1,"jour"]))# date
+ g<-g+scale_colour_hue(name=get("msg",envir_stacomi)$BilanMigrationInterannuelle.6,l=70, c=150)# annee
+ print(g)
+ assign("g",g,envir_stacomi)
+ funout(get("msg",envir_stacomi)$BilanMigrationPar.6)
+ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ } else if (plot.type=="barchart"){
+ dat=bilanMigrationInterAnnuelle at data
+ if (silent==FALSE){
+ the_choice=select.list(choices=as.character(unique(dat$bjo_annee)),preselect=as.character(max(dat$bjo_annee)),"choice annee",multiple=FALSE)
+ } else {
+ the_choice=max(as.numeric(as.character(dat$bjo_annee)))
+ }
+ dat0=fundat(dat,timesplit=timesplit)
+ dat=fundat(dat,annee=the_choice,timesplit=timesplit)
+ prepare_dat<-function(dat){
+ dat=dat[order(dat$annee,dat[,timesplit]),]
+ dat$annee=as.factor(dat$annee)
+ dat$keeptimesplit<-dat[,timesplit]
+ if(timesplit=="mois") {
+ dat[,timesplit]<-strftime(dat[,timesplit],format="%m")
+ } else if (timesplit=="quinzaine") {
+ dat[,timesplit]<-strftime(dat[,timesplit],format="%m/%d")
+ } else {
+ dat[,timesplit]<-strftime(dat[,timesplit],format="%W")
+ }
+ dat[,timesplit]<-as.factor(dat[,timesplit])
+ # we only keep one per week
+ newdat=dat[match(unique(dat[,timesplit]),dat[,timesplit]),]
+ newdat=newdat[order(newdat[,"keeptimesplit"]),] # pour avoir les range sur l'ensemble des valeurs dispo et pas seult l'annee en cours
+ # here change 12/2012 the geom_crossbar now needs a factor, label change according to timesplit
+ newdat[,timesplit]<-as.factor(newdat[,timesplit])
+ levels(newdat[,timesplit])<-newdat[,timesplit] # to have the factor in the right order from january to dec
+ return(newdat)
+ }
+ amplitude=paste(min(as.numeric(as.character(dat$annee))),"-",max(as.numeric(as.character(dat$annee))),sep="")
+
+ newdat<-prepare_dat(dat)
+ newdat0<-prepare_dat(dat0)
+ if (length(the_choice)>0) {
+ # le layout pour l'affichage des graphiques
+ vplayout <- function(x, y) { grid::viewport(layout.pos.row = x, layout.pos.col = y) }
+ grid::grid.newpage()
+ grid::pushViewport(grid::viewport(layout = grid::grid.layout(length(the_choice),1,just="center")))
+
+ selection=as.numeric(as.character(dat0$annee))==as.numeric(the_choice)
+ tmp <- dat0[selection,]
+ tmp[tmp$valeur>=tmp$moyenne,"comp"]<-">=moy"
+ tmp[tmp$valeur<tmp$moyenne,"comp"]<-"<moy"
+ options(warn = -1)
+ tmp[tmp$valeur==tmp$maxtab,"comp"]<-"max"
+ tmp[tmp$valeur==tmp$mintab,"comp"]<-"min"
+ options(warn = 0)
+ tmp[tmp$moyenne==0,"comp"]<-"0"
+
+ tmp$annee=as.factor(as.numeric(as.character(tmp$annee)))
+ if(timesplit=="mois") {
+ tmp[,timesplit]<-strftime(tmp[,timesplit],format="%m")
+ } else if (timesplit=="quinzaine") {
+ tmp[,timesplit]<-strftime(tmp[,timesplit],format="%m/%d")
+ } else {
+ tmp[,timesplit]<-strftime(tmp[,timesplit],format="%W")
+ }
+ tmp[,timesplit]<-as.factor(tmp[,timesplit])
+ tmp[!tmp[,timesplit]%in%newdat[,timesplit],"comp"]<-"?"
+ newdat$comp<-NA
+
+ g <- ggplot(tmp,aes_string(x=timesplit,y="valeur"))
+ g <- g+geom_crossbar(data=newdat,aes_string(x=timesplit,
+ y="moyenne",
+ ymin="mintab",ymax="maxtab"),fill="grey60",alpha=0.5,size=0.5,fatten=3,col="grey60")
+ g <- g+geom_bar(stat="identity",aes_string(ymin="valeur",ymax="valeur",col="comp"),fill=NA,width=0.6)
+ g <- g+geom_bar(stat="identity",aes_string(ymin="valeur",ymax="valeur",fill="comp"),alpha=0.5,width=0.6)
+ #g <- g+scale_x_date(name=paste("mois"),breaks="month",minor_breaks=getvalue(new("Refperiode"),label=date_format("%b"),timesplit))
+ #lim=as.POSIXct(c(Hmisc::trunc.POSIXt((min(tmp[tmp$com!="0",timesplit])),"month")-delai,
+ # Hmisc::ceil.POSIXt((max(tmp[tmp$com!="0",timesplit])),"month")+delai))
+ # pb the limit truncs the value
+ g <- g+ylab("effectif")
+ cols <- c("max" = "#000080","min" = "#BF0000",">=moy" = "darkgreen", "<moy" = "darkorange","hist_mean"="black","hist_range"="grey","?"="darkviolet")
+ fills <- c("max" = "blue","min" = "red",">=moy" = "green", "<moy" = "orange","hist_mean"="black","hist_range"="grey","?"="violet")
+
+ g <- g+scale_colour_manual(name=the_choice,values=cols,limits=c("min","max","<moy",">=moy","hist_mean","hist_range","?"))
+ g <- g+scale_fill_manual(name=the_choice,values=fills,limits=c("min","max","<moy",">=moy","hist_mean","hist_range","?"))
+
+ g<-g+labs(title=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin,",",
+ bilanMigrationInterAnnuelle at stades@data$std_libelle,
+ ", bilan par",timesplit,unique(as.character(tmp$annee)),"/",amplitude))
+ g<-g+ theme_minimal()
+ print(g, vp=vplayout(1,1))
+ assign(paste("g",1,sep=""),g,envir_stacomi)
+ funout(paste(get("msg",envir_stacomi)$BilanMigrationInterannuelle.10,"i=",paste(1:length(the_choice),collapse=","),"\n"))
+
+ } # end if
+
+ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ } else if (plot.type=="pointrange"){
+ # below before several plots could be made, it's no longer the case
+ # as I remove the chosen year from the observation (reference) set
+ dat=bilanMigrationInterAnnuelle at data
+
+ if (silent==FALSE){
+ the_choice=select.list(choices=as.character(unique(dat$bjo_annee)),preselect=as.character(max(dat$bjo_annee)),"choice annee",multiple=FALSE)
+ } else {
+ the_choice=max(dat$bjo_annee)
+ }
+ dat0=fundat(dat,timesplit=timesplit)
+ dat=fundat(dat,annee=the_choice,timesplit=timesplit)
+ dat$annee=as.factor(dat$annee)
+ dat=dat[order(dat$annee,dat[,timesplit]),]
+ dat$keeptimesplit<-dat[,timesplit]
+ if(timesplit=="mois") {
+ dat[,timesplit]<-strftime(dat[,timesplit],format="%m")
+ } else if (timesplit=="quinzaine") {
+ dat[,timesplit]<-strftime(dat[,timesplit],format="%m/%d")
+ } else {
+ dat[,timesplit]<-strftime(dat[,timesplit],format="%W")
+ }
+ dat[,timesplit]<-as.factor(dat[,timesplit])
+
+ # dat=dat[dat$moyenne!=0,] # pour des raisons graphiques on ne garde pas les effectifs nuls generes par fundat
+ newdat=dat[match(unique(dat[,timesplit]),dat[,timesplit]),]
+ newdat=newdat[order(newdat[,"keeptimesplit"]),] # il peut y avoir des annees pour le calcul de range qui s'ajoutent
+ # et viennent d'autres annees, il faut donc reordonner.
+
+
+ amplitude=paste(min(as.numeric(as.character(dat$annee))),"-",max(as.numeric(as.character(dat$annee))),sep="")
+
+
+ if (length(the_choice)>0) {
+ # le layout pour l'affichage des graphiques
+ vplayout <- function(x, y) { grid::viewport(layout.pos.row = x, layout.pos.col = y) }
+ grid::grid.newpage()
+ grid::pushViewport(grid::viewport(layout = grid::grid.layout(length(the_choice),1,just="center")))
+
+ selection=as.numeric(as.character(dat0$annee))==as.numeric(the_choice)
+ tmp <- dat0[selection,]
+ tmp[tmp$valeur>=tmp$moyenne,"comp"]<-">=moy"
+ tmp[tmp$valeur<tmp$moyenne,"comp"]<-"<moy"
+ options(warn = -1)
+ tmp[tmp$valeur==tmp$maxtab,"comp"]<-"max"
+ tmp[tmp$valeur==tmp$mintab,"comp"]<-"min"
+ options(warn = 0)
+ tmp[tmp$moyenne==0,"comp"]<-"0"
+ tmp$annee=as.factor(as.numeric(as.character(tmp$annee)))
+ if(timesplit=="mois") {
+ tmp[,timesplit]<-strftime(tmp[,timesplit],format="%m")
+ } else if (timesplit=="quinzaine") {
+ tmp[,timesplit]<-strftime(tmp[,timesplit],format="%m/%d")
+ } else {
+ tmp[,timesplit]<-strftime(tmp[,timesplit],format="%W")
+ }
+ tmp[,timesplit]<-as.factor(tmp[,timesplit])
+ tmp[!tmp[,timesplit]%in%newdat[,timesplit],"comp"]<-"?"
+ newdat$comp<-NA
+ g <- ggplot(tmp,aes_string(x=timesplit,y="valeur"))
+ g<-g+geom_dotplot(aes_string(x=timesplit, y="valeur"),data=dat,stackdir = "center",binaxis = "y",position = "dodge",dotsize = 0.5,fill="wheat") #position = "dodge",dotsize = 0.4,alpha=0.5,binwidth = 1.5
+ g<-g+geom_pointrange(data=newdat,aes_string(x=timesplit, y="moyenne",ymin="mintab",ymax="maxtab"),alpha=1,size=0.8)
+ g<-g+geom_bar(stat="identity",aes_string(y="valeur",fill="comp"),alpha=0.6)
+ g <- g+scale_y_continuous(name="effectif")
+ cols <- c("max" = "blue","min" = "red",">=moy" = "darkgreen", "<moy" = "darkorange","0"="grey10","?"="darkviolet")
+ g <- g+scale_fill_manual(name=the_choice,values=cols)
+ g<-g+labs(title=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin,",",bilanMigrationInterAnnuelle at stades@data$std_libelle,", bilan par",timesplit,unique(as.character(tmp$annee)),"/",amplitude))
+ g<-g+ theme_minimal()
+ print(g, vp=vplayout(1,1))
+ assign(paste("g",1,sep=""),g,envir_stacomi)
+ funout(paste(get("msg",envir_stacomi)$BilanMigrationInterannuelle.10,"i=",paste(1:length(the_choice),collapse=","),"\n"))
+
+ } # end if
+ #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ } else if (plot.type=="density"){
+ if(nrow(bilanMigrationInterAnnuelle at data)>0)
+ {
+ timesplit="quinzaine"
+ dat=bilanMigrationInterAnnuelle at data
+ dat=fundat(dat,annee=NULL,timesplit)
+ dat$annee=as.factor(dat$annee)
+ sum_per_year<-tapply(dat$valeur,dat$annee,sum)
+ sum_per_year<-data.frame(annee=names(sum_per_year),sum_per_year=sum_per_year)
+ dat<-merge(dat,sum_per_year,by="annee")
+ dat$std_valeur<-dat$valeur/dat$sum_per_year
+ all_15<-unique(dat[,timesplit])
+ # below I'm adding 0 instead of nothing for 15 days without value
+ for (i in 1:length(unique(dat$annee))){#i=5
+ annee<-unique(dat$annee)[i]
+ this_year_15<-unique(dat[dat$annee==annee,timesplit])
+ missing<-all_15[!all_15%in%this_year_15]
+ if (length(missing>=1)){
+ missingdat<-data.frame("annee"=annee,
+ "quinzaine"=missing,
+ "valeur"=0,
+ "maxtab"=0,
+ "mintab"=0,
+ "moyenne"=0,
+ "sum_per_year"=0,
+ "std_valeur"=0)
+ dat<-rbind(dat,missingdat)
+ }
+ }
+ dat=dat[order(dat$annee,dat[,timesplit]),]
+ g <- ggplot(dat,aes_string(x=timesplit,y="std_valeur"))
+ g<-g+geom_area(aes_string(y="std_valeur",fill="annee"),position="stack")
+ g <- g+scale_x_datetime(name=paste("mois"),date_breaks="month",
+ date_minor_breaks=getvalue(new("Refperiode"),timesplit),
+ date_labels="%b",
+ limits=as.POSIXct(c(Hmisc::trunc.POSIXt((min(dat[dat$valeur!=0,timesplit])),"month"),Hmisc::ceil.POSIXt((max(dat[dat$valeur!="0",timesplit])),"month"))))
+ g <- g+scale_y_continuous(name="Somme des pourcentages annuels de migration par quinzaine")
+ cols <- grDevices::rainbow(length(levels(dat$annee)))
+ g <- g+scale_fill_manual(name="annee",values=cols)
+ g<-g+labs(title=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin,",",bilanMigrationInterAnnuelle at stades@data$std_libelle,
+ ", saisonnalite de la migration"))
+ g<-g+ theme_minimal()
+ print(g)
+ assign(paste("g",sep=""),g,envir_stacomi)
+ funout(get("msg",envir_stacomi)$BilanMigrationPar.6)
+
+ } else {
+ funout(get("msg",envir_stacomi)$BilanMigrationInterannuelle.5)
+ }
+
+ } else {
+ stop ("plot.type argument invalid")
+ }
+
+ } else {
+ funout(get("msg",envir_stacomi)$BilanMigrationInterannuelle.5)
+ }
+
+ })
+
+
#' Plot of all interannual from top to bottom
#' @param h handler
#' @param ... additional parameters
hgraphBilanMigrationInterAnnuelle = function(h,...)
{
- bilanMigrationInterAnnuelle = charge(bilanMigrationInterAnnuelle)
+ bilanMigrationInterAnnuelle <- get("bilanMigrationInterAnnuelle",envir=envir_stacomi)
+ bilanMigrationInterAnnuelle <- charge(bilanMigrationInterAnnuelle)
+ bilanMigrationInterAnnuelle <- connect(bilanMigrationInterAnnuelle)
+ plot(bilanMigrationInterAnnuelle,plot.type="line",silent=FALSE)
- if(nrow(bilanMigrationInterAnnuelle at data)>0)
- {
- # TODO traitement des poids
- dat=bilanMigrationInterAnnuelle at data
- dat<-dat[dat$bjo_labelquantite=="Effectif_total",]
- dat<-stacomirtools::chnames(dat,c("bjo_annee","bjo_jour","bjo_labelquantite","bjo_valeur"), c("annee","jour","labelquantite","valeur"))
- # il faut un champ date, on ramene tout les monde e
- dat$jour = as.POSIXct(strptime(strftime(dat$jour,'2000-%m-%d %H:%M:%S'),format='%Y-%m-%d %H:%M:%S'),tz="GMT")
- dat$annee=as.factor(dat$annee)
-
- dat=stacomirtools::killfactor(dat)
-
- titre=paste(get("msg",envir_stacomi)$BilanMigrationInterannuelle.4,
- paste(min(dat$annee),max(dat$annee), collapse=":"),
- ", ",
- bilanMigrationInterAnnuelle at dc@data$dis_commentaires[bilanMigrationInterAnnuelle at dc@data$dc==bilanMigrationInterAnnuelle at dc@dc_selectionne])
- soustitre=paste(bilanMigrationInterAnnuelle at taxons@data$tax_nom_latin, ", ", bilanMigrationInterAnnuelle at stades@data$std_libelle, sep="")
- g<-ggplot(dat,aes(x=jour,y=valeur))
- g<-g+geom_line(aes(color=annee),position="dodge")+ labs(title=paste(titre, "\n", soustitre))+
- scale_x_datetime(name="date")
- print(g)
- assign("g",g,envir=envir_stacomi)
- funout(get("msg",envir_stacomi)$BilanMigrationPar.6)
-
- } else {
- funout(get("msg",envir_stacomi)$BilanMigrationInterannuelle.5)
- }
}
#'Plot of daily migrations
@@ -193,67 +589,92 @@
#' @param ... additional parameters
hgraphBilanMigrationInterAnnuelle2 = function(h,...)
{
- bilanMigrationInterAnnuelle = charge(bilanMigrationInterAnnuelle)
+ bilanMigrationInterAnnuelle <- get("bilanMigrationInterAnnuelle",envir=envir_stacomi)
+ bilanMigrationInterAnnuelle <- charge(bilanMigrationInterAnnuelle)
+ bilanMigrationInterAnnuelle <- connect(bilanMigrationInterAnnuelle)
+ plot(bilanMigrationInterAnnuelle,plot.type="standard",silent=FALSE)
+} # end function
+
+
+
+
+
+
+
+
+#' Step plot with different years displayed on the same graph. One year
+#' can be highlighted against the others
+#' @param h handler
+#' @param ... additional parameters
+hgraphBilanMigrationInterAnnuelle3 = function(h,...)
+{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 231
More information about the Stacomir-commits
mailing list