[Stacomir-commits] r185 - in pkg: stacomir stacomir/R stacomir/data stacomir/examples/00_BilanMigration stacomir/examples/01_BilanMigrationMult stacomir/inst/config stacomir/man stacomirtools/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Aug 29 21:41:57 CEST 2016
Author: briand
Date: 2016-08-29 21:41:57 +0200 (Mon, 29 Aug 2016)
New Revision: 185
Added:
pkg/stacomir/R/BilanAnnuels.R
pkg/stacomir/R/interface_Bilan_carlot.r
pkg/stacomir/data/bM_Arzal.rda
pkg/stacomir/man/charge-BilanMigration-method.Rd
pkg/stacomir/man/connect-BilanMigration-method.Rd
pkg/stacomir/man/interface_Bilan_carlot.Rd
Removed:
pkg/stacomir/R/interface_Bilan_lot.r
pkg/stacomir/man/initialize-BilanMigrationMult-method.Rd
pkg/stacomir/man/interface_BilanLot.Rd
Modified:
pkg/stacomir/DESCRIPTION
pkg/stacomir/NAMESPACE
pkg/stacomir/R/BilanFonctionnementDF.r
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/Bilan_stades_pigm.r
pkg/stacomir/R/PasdeTemps.r
pkg/stacomir/R/RefAnnee.r
pkg/stacomir/R/RefCheckBox.r
pkg/stacomir/R/RefChoix.r
pkg/stacomir/R/RefDC.r
pkg/stacomir/R/data.r
pkg/stacomir/R/fn_EcritBilanJournalier.r
pkg/stacomir/R/funBilanMigrationAnnuel.r
pkg/stacomir/R/funSousListeBilanMigration.r
pkg/stacomir/R/funSousListeBilanMigrationPar.r
pkg/stacomir/R/fungraph.r
pkg/stacomir/R/fungraph_civelle.r
pkg/stacomir/R/funstat.r
pkg/stacomir/R/funtable.r
pkg/stacomir/R/interface_BilanConditionEnv.r
pkg/stacomir/R/interface_BilanFonctionnementDC.r
pkg/stacomir/R/interface_BilanFonctionnementDF.r
pkg/stacomir/R/interface_BilanMigration.r
pkg/stacomir/R/interface_BilanMigrationConditionEnv.r
pkg/stacomir/R/interface_BilanMigrationInterannuelle.r
pkg/stacomir/R/interface_BilanMigrationMult.r
pkg/stacomir/R/interface_BilanMigrationPar.r
pkg/stacomir/R/interface_Bilan_taille.r
pkg/stacomir/R/interface_bilan_poids_moyen.r
pkg/stacomir/R/interface_chooselang.r
pkg/stacomir/R/setAs.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/R/utilitaires.r
pkg/stacomir/data/msg.rda
pkg/stacomir/examples/00_BilanMigration/bilanMigration_Arzal.R
pkg/stacomir/examples/01_BilanMigrationMult/bilanMigrationMult_Arzal.R
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/man/BilanMigration-class.Rd
pkg/stacomir/man/BilanMigrationMult-class.Rd
pkg/stacomir/man/bMM_Arzal.Rd
pkg/stacomir/man/calcule-BilanMigration-method.Rd
pkg/stacomir/man/calcule-BilanMigrationMult-method.Rd
pkg/stacomir/man/fun_weight_conversion.Rd
pkg/stacomir/man/fungraph.Rd
pkg/stacomir/man/fungraph_civelle.Rd
pkg/stacomir/man/funstat.Rd
pkg/stacomir/man/mygtkProgressBar.Rd
pkg/stacomir/man/plot-BilanMigrationMult-ANY-method.Rd
pkg/stacomir/man/summary-BilanMigrationMult-method.Rd
pkg/stacomirtools/R/ConnectionODBC.r
pkg/stacomirtools/R/RequeteODBC.r
Log:
Development of BilanMigration. Bug fix in BilanMigrationMult
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2016-08-27 11:27:39 UTC (rev 184)
+++ pkg/stacomir/DESCRIPTION 2016-08-29 19:41:57 UTC (rev 185)
@@ -69,7 +69,7 @@
'interface_BilanMigrationInterannuelle.r'
'interface_BilanMigrationMult.r'
'interface_BilanMigrationPar.r'
- 'interface_Bilan_lot.r'
+ 'interface_Bilan_carlot.r'
'interface_Bilan_taille.r'
'interface_bilan_poids_moyen.r'
'interface_chooselang.r'
Modified: pkg/stacomir/NAMESPACE
===================================================================
--- pkg/stacomir/NAMESPACE 2016-08-27 11:27:39 UTC (rev 184)
+++ pkg/stacomir/NAMESPACE 2016-08-29 19:41:57 UTC (rev 185)
@@ -19,7 +19,6 @@
export(hbilanMigrationConditionEnvcalc)
export(interface_BilanEspeces)
export(messages)
-export(mygtkProgressBar)
export(stacomi)
export(vector_to_listsql)
exportClasses(BilanConditionEnv)
Added: pkg/stacomir/R/BilanAnnuels.R
===================================================================
--- pkg/stacomir/R/BilanAnnuels.R (rev 0)
+++ pkg/stacomir/R/BilanAnnuels.R 2016-08-29 19:41:57 UTC (rev 185)
@@ -0,0 +1,2 @@
+# see funBilanMigrationInterannuel pour modif
+
Modified: pkg/stacomir/R/BilanFonctionnementDF.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDF.r 2016-08-27 11:27:39 UTC (rev 184)
+++ pkg/stacomir/R/BilanFonctionnementDF.r 2016-08-29 19:41:57 UTC (rev 185)
@@ -129,20 +129,16 @@
############################
#progress bar
###########################
- progwin <- gtkWindow()
- progwin$setTitle(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.4)
- progress_bar <- gtkProgressBar()
- gtkWidgetSetSizeRequest(progress_bar,600,100)
- progwin$add(progress_bar)
- progress_bar$setText(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.5)
-
-
-
+ mygtkProgressBar(
+ title=get("msg",envir=envir_stacomi)$BilanFonctionnementDF.4,
+ progress_text=get("msg",envir=envir_stacomi)$BilanFonctionnementDF.5)
+ # this function assigns
z=0 # compteur tableau t_periodefonctdispositif_per_mois
for(j in 1:nrow(t_periodefonctdispositif_per)){
#cat( j
- progress_bar$setFraction(progres,j/nrow(t_periodefonctdispositif_per))
- gtkMainIterationDo(FALSE)
+ progress_bar$setFraction(j/nrow(t_periodefonctdispositif_per))
+ progress_bar$setText(sprintf("%d%% progression",round(100*j/nrow(t_periodefonctdispositif_per))))
+ RGtk2::gtkMainIterationDo(FALSE)
if (j>1) t_periodefonctdispositif_per_mois=rbind(t_periodefonctdispositif_per_mois, t_periodefonctdispositif_per[j,])
lemoissuivant=seqmois[seqmois>tempsdebut[j]][1] # le premier mois superieur a tempsdebut
while (tempsfin[j]>lemoissuivant){ # on est a cheval sur deux periodes
@@ -195,7 +191,7 @@
}
assign("periodeDF",t_periodefonctdispositif_per_mois,envir_stacomi)
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.8)
- close(progress_bar)
+ dispose(progres)
}
#' FunboxDF draws rectangles to describe the DF work for BilanFonctionnementDF class
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2016-08-27 11:27:39 UTC (rev 184)
+++ pkg/stacomir/R/BilanMigration.r 2016-08-29 19:41:57 UTC (rev 185)
@@ -8,9 +8,12 @@
#' @slot stades Object of class \link{RefStades-class} : the stage of the fish
#' @slot pasDeTemps Object of class \link{PasDeTempsJournalier-class} : the time step
#' constrained to daily value and 365 days
-#' @slot data Object of class \code{data.frame}
+#' @slot data Object of class \code{data.frame} with data filled in from the connect method
+#' @slot calcdata A "list" of calculated daily data, one per dc, filled in by the calcule method
+#' @slot coef_conversion A data.frame of daily weight to number conversion coefficients, filled in by the connect
+#' method if any weight are found in the data slot.
#' @slot time.sequence Object of class \code{POSIXct} : a time sequence of days generated by the calcule method
-#' @note TODO discuss the lenght of the bilan and how it is used to "write" in the database
+#' @note TODO discuss and how it is used to "write" in the database
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @seealso Other Bilan Class \code{\linkS4class{Bilan_carlot}},
#' \code{\linkS4class{Bilan_poids_moyen}},
@@ -26,12 +29,21 @@
#' @export
setClass(Class="BilanMigration",
representation=
- representation(dc="RefDC",taxons="RefTaxon",stades="RefStades",pasDeTemps="PasDeTempsJournalier",data="data.frame",time.sequence="POSIXct"),
+ representation(dc="RefDC",
+ taxons="RefTaxon",
+ stades="RefStades",
+ pasDeTemps="PasDeTempsJournalier",
+ data="data.frame",
+ calcdata="list",
+ coef_conversion="data.frame",
+ time.sequence="POSIXct"),
prototype=prototype(dc=new("RefDC"),
taxons=new("RefTaxon"),
stades=new("RefStades"),
pasDeTemps=new("PasDeTempsJournalier"),
data=data.frame(),
+ calcdata=list(),
+ coef_conversion=data.frame(),
time.sequence=as.POSIXct(Sys.time())
))
# bilanMigration= new("BilanMigration")
@@ -45,8 +57,8 @@
rep4=(object at pasDeTemps@nbStep==365) # contrainte : pendant 365j
rep5=as.numeric(strftime(object at pasDeTemps@dateDebut,'%d'))==1 # contrainte : depart = 1er janvier
rep6=as.numeric(strftime(object at pasDeTemps@dateDebut,'%m'))==1
-
- return(ifelse(rep1 & rep2 & rep3 & rep4 & rep5 & rep6, TRUE ,c(1:6)[!c(rep1, rep2, rep3, rep4, rep5, rep6)]))
+ rep7=length(calcdata)==1
+ return(ifelse(rep1 & rep2 & rep3 & rep4 & rep5 & rep6 & rep7, TRUE ,c(1:6)[!c(rep1, rep2, rep3, rep4, rep5, rep6, rep7)]))
}
)
@@ -57,9 +69,26 @@
#' @param ... additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
hbilanMigrationcalc=function(h,...){
- calcule( h$action)
+ bilanMigration<-get("bilanMigration",envir=envir_stacomi)
+ bilanMigration<-charge(bilanMigration)
+ bilanMigration<-connect(bilanMigration)
+ bilanMigration<-calcule(bilanMigration)
}
+#' connect method for BilanMigration
+#'
+#'
+#' uses the BilanMigrationMult method
+#' @param object An object of class \link{BilanMigration-class}
+#' @return BilanMigration with slot @data filled from the database
+#' @export
+setMethod("connect",signature=signature("BilanMigration"),definition=function(object,...){
+ bilanMigration<-object
+ bilanMigrationMult<-as(bilanMigration,"BilanMigrationMult")
+ bilanMigrationMult<-connect(bilanMigrationMult)
+ bilanMigration at data<-bilanMigrationMult at data
+ return(bilanMigration)
+ })
#' command line interface for BilanMigration class
#' @param object An object of class \link{BilanMigration-class}
#' @param dc A numeric or integer, the code of the dc, coerced to integer,see \link{choice_c-RefDC-method}
@@ -93,12 +122,12 @@
return(bilanMigration)
})
-#' calcule method for BilanMigration
+#' charge method for BilanMigration
#' @param object An object of class \code{\link{BilanMigration-class}}
-#' @return BilanMigration with slots filled by user choice
+#' @return An object of class \link{BilanMigration-class} with slots filled by user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("calcule",signature=signature("BilanMigration"),definition=function(object){
+setMethod("charge",signature=signature("BilanMigration"),definition=function(object){
bilanMigration<-object
#pour l'instant ne lancer que si les fenetre sont fermees
# funout("lancement updateplot \n")
@@ -129,81 +158,262 @@
}
stopifnot(validObject(bilanMigration, test=TRUE))
funout(get("msg",envir=envir_stacomi)$BilanMigration.2)
- sum<-funBilanMigrationAnnuel(bilanMigration=bilanMigration)
- if (!is.na(sum)){
- data<-funSousListeBilanMigration(bilanMigration=bilanMigration)
- tableau=data[,-c(2,3)]
- tableau$"Effectif_total"=rowSums(data[,c("MESURE","CALCULE","EXPERT","PONCTUEL")])
- if(sum!=sum(tableau$"Effectif_total")) warning(paste("attention probleme, le total",sum,"est different de la somme des effectifs",sum(tableau$"Effectif_total"),"ceci peut se produire lorsque des operations sont a cheval sur plusieurs annees") )
- tableau=tableau[,c(1:5,9,6:8)]
- dimnames(tableau)=list(1:nrow(tableau),c(
- "No.pas",
- "MESURE",
- "CALCULE",
- "EXPERT",
- "PONCTUEL",
- "Effectif_total",
- "type_de_quantite",
- "Taux_d_echappement",
- "coe_valeur_coefficient"
- ))
- tableau$coe_valeur_coefficient=as.numeric(tableau$coe_valeur_coefficient)
- tableau$coe_valeur_coefficient[is.na(tableau$coe_valeur_coefficient)]=0
- bilanMigration at time.sequence=seq.POSIXt(from=as.POSIXlt(min(data$debut_pas)),to=max(data$debut_pas),
- by=as.numeric(bilanMigration at pasDeTemps@stepDuration)) # il peut y avoir des lignes repetees poids effectif
- # traitement des coefficients de conversion poids effectif
-
- if (bilanMigration at taxons@data$tax_nom_latin=="Anguilla anguilla"& bilanMigration at stades@data$std_libelle=="civelle")
- {
- tableau <-funtraitement_poids(tableau,time.sequence=bilanMigration at time.sequence)
+ return(bilanMigrationMult)
+ })
+
+
+#' calcule method for BilanMigration
+#'
+#' does the calculation once data are filled,. It also performs conversion from weight to numbers
+#' in with the connect method
+#' @param object An object of class \code{\link{BilanMigration-class}}
+#' @param negative a boolean indicating if a separate sum must be done for positive and negative values, if true, positive and negative counts return
+#' different rows
+#' @param silent Boolean, if true, information messages are not displays, only warnings and errors
+#' @note The class BilanMigration does not handle escapement rates nor
+#' 'devenir' i.e. the destination of the fishes.
+#' @return BilanMigration with slots filled by user choice
+#' @export
+setMethod("calcule",signature=signature("BilanMigration"),definition=function(object,negative=FALSE,silent=FALSE){
+ #bilanMigration<-bM_Arzal
+ #negative=FALSE
+ if (!silent){
+ funout(get("msg",envir_stacomi)$BilanMigration.2)
+ }
+ bilanMigration<-object
+ bilanMigration=connect(bilanMigration)
+ if (!silent) cat(stringr::str_c("data collected from the database nrow=",nrow(bilanMigration at data),"\n"))
+ if (nrow(bilanMigration at data>0)){
+ bilanMigration at data$time.sequence=difftime(bilanMigration at data$ope_date_fin,
+ bilanMigration at data$ope_date_debut,
+ units="days")
+ debut=bilanMigration at pasDeTemps@dateDebut
+ fin=DateFin(bilanMigration at pasDeTemps)
+ time.sequence<-seq.POSIXt(from=debut,to=fin,
+ by=as.numeric(bilanMigration at pasDeTemps@stepDuration))
+ bilanMigration at time.sequence<-time.sequence
+ lestableaux<-list()
+ datasub<-bilanMigration at data
+ dic<-unique(bilanMigration at data$ope_dic_identifiant)
+ stopifnot(length(dic)==1)
+ if (any(datasub$time.sequence>(bilanMigration at pasDeTemps@stepDuration/86400))){
+ #----------------------
+ # bilans avec overlaps
+ #----------------------
+ data<-fun_bilanMigrationMult_Overlaps(time.sequence = time.sequence, datasub = datasub,negative=negative)
+ # pour compatibilite avec les bilanMigration
+ data$taux_d_echappement=-1
+ lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
+ lestableaux[[stringr::str_c("dc_",dic)]][["method"]]<-"overlaps"
+ contient_poids<-"poids"%in%datasub$type_de_quantite
+ lestableaux[[stringr::str_c("dc_",dic)]][["contient_poids"]]<-contient_poids
+ lestableaux[[stringr::str_c("dc_",dic)]][["negative"]]<-negative
+ if (contient_poids){
+ coe<-bilanMigration at coef_conversion[,c("coe_date_debut","coe_valeur_coefficient")]
+ data$coe_date_debut<-as.Date(data$debut_pas)
+ data<-merge(data,coe,by="coe_date_debut")
+ data<-data[,-1] # removing coe_date_debut
+ data <-fun_weight_conversion(tableau=data,time.sequence=bilanMigration at time.sequence,silent)
+ }
+
+ lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
+
+ } else {
+ #----------------------
+ #bilan simple
+ #----------------------
+ data<-fun_bilanMigrationMult(time.sequence = time.sequence,datasub=datasub,negative=negative)
+ data$taux_d_echappement=-1
+ data$coe_valeur_coefficient=NA
+ contient_poids<-"poids"%in%datasub$type_de_quantite
+ if (contient_poids){
+ coe<-bilanMigration at coef_conversion[,c("coe_date_debut","coe_valeur_coefficient")]
+ data$coe_date_debut<-as.Date(data$debut_pas)
+ data<-merge(data,coe,by="coe_date_debut")
+ data<-data[,-1] # removing coe_date_debut
+ data <-fun_weight_conversion(tableau=data,time.sequence=bilanMigration at time.sequence,silent)
+ }
+ lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
+ lestableaux[[stringr::str_c("dc_",dic)]][["method"]]<-"sum"
+ lestableaux[[stringr::str_c("dc_",dic)]][["contient_poids"]]<-contient_poids
+ lestableaux[[stringr::str_c("dc_",dic)]][["negative"]]<-negative
}
- bilanMigration at data<-tableau
+ # TODO developper une methode pour sumneg
+ bilanMigration at calcdata<-lestableaux
assign("bilanMigration",bilanMigration,envir_stacomi)
- funout(get("msg",envir_stacomi)$BilanMigration.3)
- assign("tableau",tableau,envir_stacomi)
- funout(get("msg",envir_stacomi)$BilanMigration.4)
+ if (!silent){
+ 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)
}
})
+#' 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"
+#' as needed, the function will test for the existence of data for one dc, one taxa, and one stage}
+#' \item{plot.type="step"}{creates Cumulated graphs for BilanMigrationMult. Data are summed per day for different dc taxa and stages}
+#' \item{plot.type="multiple"}{Method to overlay graphs for BilanMigrationMult (multiple dc/taxa/stage in the same plot)}
+#' }
+#' @param x An object of class BilanMigrationMult
+#' @param y From the formals but missing
+#' @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 ... Additional arguments, see \code{plot}, \code{plot.default} and \code{par}
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
-
#' handler hBilanMigrationgraph
#' calls the fungraph for BilanMigration and allows the saving of daily and monthly counts in the database
#' @note pb if other than daily value, the time steps have been constrained to daily values for this plot
#' @param h a handler
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+setMethod("plot",signature(x = "BilanMigration", y = "ANY"),definition=function(x, y,plot.type="standard",silent=FALSE,...){
+ #bilanMigration<-bM_Arzal
+ bilanMigration<-x
+ if (exists("bilanMigration",envir_stacomi)) {
+ bilanMigration<-get("bilanMigration",envir_stacomi)
+ } else {
+ funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
+ }
+ #§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+ # standard plot
+ #§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+ if (plot.type=="standard"){
+ if (!silent) print("plot type standard")
+ if (!silent) funout(get("msg",envir_stacomi)$BilanMigration.9)
+ taxon=bilanMigration at taxons@data[1,"tax_nom_latin"]
+ stade=bilanMigration at stades@data[1,"std_libelle"]
+ dc=as.numeric(bilanMigration at dc@dc_selectionne)[1]
+ # preparation du jeu de donnees pour la fonction fungraph_civ
+ #developpee pour la classe BilanMigration
+ data<-bilanMigration at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
+ if (!is.null(data)){
+ if (nrow(data)>0){
+ if (!silent) {
+ funout(paste("dc=",dc,
+ "taxon"=taxon,
+ "stade"=stade,"\n"))
+ funout("---------------------\n")
+ }
+ if (any(duplicated(data$No.pas))) stop("duplicated values in No.pas")
+ data_without_hole<-merge(
+ data.frame(No.pas=as.numeric(strftime(bilanMigrationMult at time.sequence,format="%j"))-1,
+ debut_pas=bilanMigrationMult at time.sequence),
+ data,
+ by=c("No.pas","debut_pas"),
+ all.x=TRUE
+ )
+ data_without_hole$CALCULE[is.na(data_without_hole$CALCULE)]<-0
+ 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
+ if (bilanMigration at calcdata[[stringr::str_c("dc_",dc)]][["contient_poids"]]&
+ taxon=="Anguilla anguilla"&
+ (stade=="civelle"|stade=="Anguilla jaune")) {
+ #----------------------------------
+ # bilan migration avec poids (civelles
+ #-----------------------------------------
+ grDevices::X11()
+ fungraph_civelle(bilanMigration=bilanMigration,
+ table=data_without_hole,
+ time.sequence=bilanMigration at time.sequence,
+ taxon=taxon,
+ stade=stade,
+ dc=dc,
+ silent,
+ ...)
+ } else {
+
+ #----------------------------------
+ # bilan migration standard
+ #-----------------------------------------
+ grDevices::X11()
+ #silent=TRUE
+ fungraph(bilanMigration=bilanMigration,
+ tableau=data_without_hole,
+ time.sequence=bilanMigration at time.sequence,
+ taxon,
+ stade,
+ dc,
+ silent)
+ }
+ } # end nrow(data)>0
+ } # end is.null(data)
+
+ #§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+ # step plot
+ #§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§§
+ } else if (plot.type=="step"){
+ taxon= as.character(bilanMigration at taxons@data$tax_nom_latin)
+ stade= as.character(bilanMigration at stades@data$std_libelle)
+ DC=as.numeric(bilanMigration at dc@dc_selectionne)
+ if (bilanMigration at pasDeTemps@stepDuration==86400 & bilanMigration at pasDeTemps@stepDuration==86400) {
+ grdata<-bilanMigration at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
+ grdata<-funtraitementdate(grdata,
+ nom_coldt="debut_pas",
+ annee=FALSE,
+ mois=TRUE,
+ quinzaine=TRUE,
+ semaine=TRUE,
+ jour_an=TRUE,
+ jour_mois=FALSE,
+ heure=FALSE)
+ grdata$Cumsum=cumsum(grdata$Effectif_total)
+ # pour sauvegarder sous excel
+ annee=unique(strftime(as.POSIXlt(bilanMigration at time.sequence),"%Y"))
+ dis_commentaire= as.character(bilanMigration at dc@data$dis_commentaires[bilanMigration at dc@data$dc%in%bilanMigration at dc@dc_selectionne])
+ update_geom_defaults("step", aes(size = 3))
+
+ p<-ggplot(grdata)+
+ geom_step(aes(x=debut_pas,y=Cumsum,colour=mois))+
+ ylab(get("msg",envir_stacomi)$BilanMigration.6)+
+ ggtitle(paste(get("msg",envir_stacomi)$BilanMigration.7," ",dis_commentaire,", ",taxon,", ",stade,", ",annee,sep="")) +
+ theme(plot.title = element_text(size=10,colour="navy"))+
+ scale_colour_manual(values=c("01"="#092360",
+ "02"="#1369A2",
+ "03"="#0099A9",
+ "04"="#009780",
+ "05"="#67B784",
+ "06"="#CBDF7C",
+ "07"="#FFE200",
+ "08"="#DB9815",
+ "09"="#E57B25",
+ "10"="#F0522D",
+ "11"="#912E0F",
+ "12"="#33004B"
+ ))
+ print(p)
+ } else {
+ funout(get("msg",envir_stacomi)$BilanMigration.8)
+ }
+ } else {
+ stop("unrecognised plot.type argument, plot.type should either be standard or step")
+ }
+ })
+
+
+
+
hbilanMigrationgraph = function(h,...) {
if (exists("bilanMigration",envir_stacomi)) {
bilanMigration<-get("bilanMigration",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
}
- taxon= as.character(bilanMigration at taxons@data$tax_nom_latin)
- stade= as.character(bilanMigration at stades@data$std_libelle)
- DC=as.numeric(bilanMigration at dc@dc_selectionne)
- funout(get("msg",envir_stacomi)$BilanMigration.9)
-
- # si le bilan est journalier
- if (bilanMigration at pasDeTemps@stepDuration==86400 & bilanMigration at pasDeTemps@stepDuration==86400) {
-
- # pour sauvegarder sous excel
- if (taxon=="Anguilla anguilla"& stade=="civelle") {
- fungraph_civelle(bilanMigration=bilanMigration,bilanMigration at data,bilanMigration at time.sequence,taxon=taxon,stade=stade)
- }
- else {
- fungraph(bilanMigration=bilanMigration,tableau=bilanMigration at data,time.sequence=bilanMigration at time.sequence,taxon,stade)
- }
-
- } else {
- funout(get("msg",envir_stacomi)$BilanMigration.8)
- # normalement ce cas ne devrait plus se poser
- }
+ #funout(get("msg",envir_stacomi)$BilanMigration.9)
+ plot(bilanMigration,plot.type="standard")
# ecriture du bilan journalier, ecrit aussi le bilan mensuel
fn_EcritBilanJournalier(bilanMigration)
+
}
#' handler for calcul hBilanMigrationgraph2
@@ -218,35 +428,8 @@
} else {
funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
}
- taxon= as.character(bilanMigration at taxons@data$tax_nom_latin)
- stade= as.character(bilanMigration at stades@data$std_libelle)
- DC=as.numeric(bilanMigration at dc@dc_selectionne)
- if (bilanMigration at pasDeTemps@stepDuration==86400 & bilanMigration at pasDeTemps@stepDuration==86400) {
- bilanMigration at data$time.sequence=bilanMigration at time.sequence
- # pour sauvegarder sous excel
- bilanMigration at data<-funtraitementdate(bilanMigration at data,
- nom_coldt="time.sequence",
- annee=FALSE,
- mois=TRUE,
- quinzaine=TRUE,
- semaine=TRUE,
- jour_an=TRUE,
- jour_mois=FALSE,
- heure=FALSE)
- bilanMigration at data$Cumsum=cumsum(bilanMigration at data$Effectif_total)
- # pour sauvegarder sous excel
- annee=unique(strftime(as.POSIXlt(bilanMigration at time.sequence),"%Y"))
- dis_commentaire= as.character(bilanMigration at dc@data$dis_commentaires[bilanMigration at dc@data$dc%in%bilanMigration at dc@dc_selectionne])
- update_geom_defaults("step", aes(size = 3))
- p<-ggplot(bilanMigration at data)+
- geom_step(aes(x=time.sequence,y=Cumsum,colour=mois))+
- ylab(get("msg",envir_stacomi)$BilanMigration.6)+
- ggtitle(paste(get("msg",envir_stacomi)$BilanMigration.7,dis_commentaire,", ",taxon,", ",stade,", ",annee,sep="")) +
- theme(plot.title = element_text(size=10,colour="blue"))
- print(p)
- } else {
- funout(get("msg",envir_stacomi)$BilanMigration.8)
- }
+ #funout(get("msg",envir_stacomi)$BilanMigration.9)
+ plot(bilanMigration,plot.type="step")
}
#' handler for summary function
@@ -275,4 +458,19 @@
stade,
DC)
funtable(tableau=bilanMigration at data,time.sequence=bilanMigration at time.sequence,taxon,stade,DC,resum)
+}
+
+#' handler hBilanMigrationwrite
+#' Allows the saving of daily and monthly counts in the database, this method is also called from hbilanMigrationgraph
+#' @param h a handler
+#' @param ... Additional parameters
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+hbilanMigrationwrite = function(h,...) {
+ if (exists("bilanMigration",envir_stacomi)) {
+ bilanMigration<-get("bilanMigration",envir_stacomi)
+ } else {
+ funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
+ }
+ # ecriture du bilan journalier, ecrit aussi le bilan mensuel
+ fn_EcritBilanJournalier(bilanMigration)
}
\ No newline at end of file
Modified: pkg/stacomir/R/BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMult.r 2016-08-27 11:27:39 UTC (rev 184)
+++ pkg/stacomir/R/BilanMigrationMult.r 2016-08-29 19:41:57 UTC (rev 185)
@@ -61,23 +61,6 @@
}
)
-#' initialize method for BilanMigrationMult
-#'
-#' allows a more elaborate constuctor than new through use of charge methods
-#' of Referential objects in the class
-setMethod("initialize", "BilanMigrationMult", function(.Object, ...) {
- # callNextMethod() calls the method first inherited method, ie the
- # method that would have been called if the current method did not exist
- # here it calls the default constructor of the class (initialize as it would
- # have worked for new()
- .Object <- callNextMethod()
- .Object at taxons=charge(.Object at taxons)
- .Object at stades=charge(.Object at stades)
- .Object at dc=charge(.Object at dc)
- fonctionnementDC=new("BilanFonctionnementDC")
- assign("fonctionnementDC",fonctionnementDC,envir = envir_stacomi)
- .Object
- })
@@ -146,20 +129,21 @@
#' calcule method for BilanMigrationMult
#'
-#' does the calculation once data are filled
+#' does the calculation once data are filled. It also performs conversion from weight to numbers
#' in with the connect method
#' @param object An object of class \code{\link{BilanMigrationMult-class}}
#' @param negative a boolean indicating if a separate sum must be done for positive and negative values, if true, positive and negative counts return
#' different rows
+#' @param silent Defautl FALSE, should messages be stopped
#' @note The class BilanMigrationMult does not handle escapement rates. Use class BilanMigration if you want to handle them. The class does not handler
#' 'devenir' i.e. the destination of the fishes.
-#' @return BilanMigrationMult with slots filled by user choice
+#' @return BilanMigrationMult with a list in calcdata, one for each triplet (dc/taxa/stage) with data
#' @export
-setMethod("calcule",signature=signature("BilanMigrationMult"),definition=function(object,negative=FALSE){
+setMethod("calcule",signature=signature("BilanMigrationMult"),definition=function(object,negative=FALSE,silent=FALSE){
bilanMigrationMult<-object
bilanMigrationMult=connect(bilanMigrationMult)
- cat(stringr::str_c("nrow=",nrow(bilanMigrationMult at data)))
+ if (!silent) cat(stringr::str_c("data collected from the database nrow=",nrow(bilanMigrationMult at data),"\n"))
bilanMigrationMult at data$time.sequence=difftime(bilanMigrationMult at data$ope_date_fin,
bilanMigrationMult at data$ope_date_debut,
@@ -190,7 +174,7 @@
data$coe_date_debut<-as.Date(data$debut_pas)
data<-merge(data,coe,by="coe_date_debut")
data<-data[,-1] # removing coe_date_debut
- data <-fun_weight_conversion(tableau=data,time.sequence=bilanMigrationMult at time.sequence)
+ data <-fun_weight_conversion(tableau=data,time.sequence=bilanMigrationMult at time.sequence,silent)
}
lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
@@ -202,7 +186,14 @@
data<-fun_bilanMigrationMult(time.sequence = time.sequence,datasub=datasub,negative=negative)
data$taux_d_echappement=-1
data$coe_valeur_coefficient=NA
-
+ contient_poids<-"poids"%in%datasub$type_de_quantite
+ if (contient_poids){
+ coe<-bilanMigrationMult at coef_conversion[,c("coe_date_debut","coe_valeur_coefficient")]
+ data$coe_date_debut<-as.Date(data$debut_pas)
+ data<-merge(data,coe,by="coe_date_debut")
+ data<-data[,-1] # removing coe_date_debut
+ data <-fun_weight_conversion(tableau=data,time.sequence=bilanMigrationMult at time.sequence,silent)
+ }
lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
lestableaux[[stringr::str_c("dc_",dic)]][["method"]]<-"sum"
lestableaux[[stringr::str_c("dc_",dic)]][["contient_poids"]]<-contient_poids
@@ -212,8 +203,10 @@
# TODO developper une methode pour sumneg
bilanMigrationMult at calcdata<-lestableaux
assign("bilanMigrationMult",bilanMigrationMult,envir_stacomi)
- funout(get("msg",envir_stacomi)$BilanMigrationMult.3)
- funout(get("msg",envir_stacomi)$BilanMigrationMult.4)
+ if (!silent){
+ funout(get("msg",envir_stacomi)$BilanMigrationMult.3)
+ funout(get("msg",envir_stacomi)$BilanMigrationMult.4)
+ }
return(bilanMigrationMult)
})
@@ -302,11 +295,11 @@
} else {
funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
}
- plot(x=bilanMigrationMult,type="standard")
+ plot(x=bilanMigrationMult,plot.type="standard")
}
-#' Main plot method
+#' Plots of various type for BilanMigrationMult
#'
#' \itemize{
#' \item{plot.type="standard"}{calls \code{\link{fungraph}} and \code{\link{fungraph_civelle}} functions to plot as many "bilanmigration"
@@ -325,9 +318,9 @@
# getGeneric("plot")
# showMethods("plot")
# methods("plot")
-setMethod("plot",signature(x = "BilanMigrationMult", y = "ANY"),definition=function(x, y,plot.type="standard",...){
+setMethod("plot",signature(x = "BilanMigrationMult", y = "ANY"),definition=function(x, y,plot.type="standard",silent=FALSE,...){
#browser()
- print("entering plot function")
+ #print("entering plot function")
#bilanMigrationMult<-bMM_Arzal
bilanMigrationMult<-x
lestaxons= bilanMigrationMult at taxons@data
@@ -335,9 +328,9 @@
lesdc=as.numeric(bilanMigrationMult at dc@dc_selectionne)
#==========================type=1=============================
if (plot.type=="standard"){
- print("plot type standard")
- funout(get("msg",envir_stacomi)$BilanMigration.9)
- #dcnum=2
+ if (!silent) print("plot type standard")
+ if (!silent) funout(get("msg",envir_stacomi)$BilanMigration.9)
+ #dcnum=1;taxonnum=1;stadenum=2
#&&&&&&&&&&&&&&&&&&&&&&&&&debut de boucle&&&&&&&&&&&&&&&&&&&&&&&&&&&
for (dcnum in 1:length(lesdc)){
for (taxonnum in 1:nrow(lestaxons)){
@@ -356,9 +349,12 @@
if (!is.null(data)){
if (nrow(data)>0){
- funout(paste("dc=",dc,
- "taxon"=taxon,
- "stade"=stade))
+ if (!silent) {
+ funout(paste("dc=",dc,
+ "taxon"=taxon,
+ "stade"=stade,"\n"))
+ funout("---------------------\n")
+ }
if (any(duplicated(data$No.pas))) stop("duplicated values in No.pas")
data_without_hole<-merge(
data.frame(No.pas=as.numeric(strftime(bilanMigrationMult at time.sequence,format="%j"))-1,
@@ -373,7 +369,7 @@
data_without_hole$PONCTUEL[is.na(data_without_hole$PONCTUEL)]<-0
if (bilanMigrationMult at calcdata[[stringr::str_c("dc_",dc)]][["contient_poids"]]&
taxon=="Anguilla anguilla"&
- stade=="civelle") {
+ (stade=="civelle"|stade=="Anguilla jaune")) {
#----------------------------------
# bilan migration avec poids (civelles
@@ -385,20 +381,22 @@
taxon=taxon,
stade=stade,
dc=dc,
+ silent,
...)
} else {
-
+
#----------------------------------
# bilan migration standard
#-----------------------------------------
grDevices::X11()
+ #silent=TRUE
fungraph(bilanMigration=bilanMigrationMult,
tableau=data_without_hole,
time.sequence=bilanMigrationMult at time.sequence,
taxon,
stade,
dc,
- ...)
+ silent)
}
} # end nrow(data)>0
# ecriture du bilan journalier, ecrit aussi le bilan mensuel
@@ -459,58 +457,72 @@
p<-ggplot(grdata_without_hole)+
geom_step(aes(x=debut_pas,y=cumsum,colour=mois))+
ylab(get("msg",envir_stacomi)$BilanMigration.6)+
- theme(plot.title=element_text(size=10,colour="blue"))+
+ theme(plot.title=element_text(size=10,colour="deepskyblue"))+
+ xlab("mois")+
+ scale_colour_manual(values=c("01"="#092360",
+ "02"="#1369A2",
+ "03"="#0099A9",
+ "04"="#009780",
+ "05"="#67B784",
+ "06"="#CBDF7C",
+ "07"="#FFE200",
+ "08"="#DB9815",
+ "09"="#E57B25",
+ "10"="#F0522D",
+ "11"="#912E0F",
+ "12"="#33004B"
+ ))+
ggtitle(paste(get("msg",envir_stacomi)$BilanMigration.7,"dc=",dis_commentaire,", tax=",lestaxons,", srd=",lesstades,", ",annee,sep="") )
print(p)
}
#==========================type=3=============================
- if (plot.type=="multiple"){
- lestaxons= paste(bilanMigrationMult at taxons@data$tax_nom_latin,collapse=",")
- lesstades= paste(bilanMigrationMult at stades@data$std_code,collapse=",")
- grdata<-data.frame()
- for (i in 1:length(bilanMigrationMult at calcdata)){
- data<-bilanMigrationMult at calcdata[[i]]$data
- # extracting similar columns (not those calculated)
- data<-data[,c(
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 185
More information about the Stacomir-commits
mailing list