[Stacomir-commits] r220 - 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
Sun Sep 25 21:42:35 CEST 2016
Author: briand
Date: 2016-09-25 21:42:34 +0200 (Sun, 25 Sep 2016)
New Revision: 220
Added:
pkg/stacomir/R/BilanOperation.r
pkg/stacomir/data/bilanFonctionnementDC.rda
pkg/stacomir/data/bilanFonctionnementDF.rda
pkg/stacomir/data/bilanOperation.rda
pkg/stacomir/man/BilanOperation-class.Rd
pkg/stacomir/man/charge-BilanOperation-method.Rd
pkg/stacomir/man/connect-BilanOperation-method.Rd
Removed:
pkg/stacomir/R/fn_sql_dis.r
pkg/stacomir/R/funtraitementdate.r
pkg/stacomir/man/fn_sql_dis.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/BilanMigrationMult.r
pkg/stacomir/R/BilanMigrationPar.r
pkg/stacomir/R/PasDeTempsJournalier.r
pkg/stacomir/R/RefDF.r
pkg/stacomir/R/RefHorodate.r
pkg/stacomir/R/RefListe.r
pkg/stacomir/R/RefStades.r
pkg/stacomir/R/RefTaxon.r
pkg/stacomir/R/data.r
pkg/stacomir/R/fungraph.r
pkg/stacomir/R/fungraph_civelle.r
pkg/stacomir/R/interface_BilanFonctionnementDC.r
pkg/stacomir/R/interface_BilanFonctionnementDF.r
pkg/stacomir/R/interface_BilanMigration.r
pkg/stacomir/R/interface_BilanMigrationMult.r
pkg/stacomir/R/interface_BilanMigrationPar.r
pkg/stacomir/R/interface_Bilan_carlot.r
pkg/stacomir/R/interface_bilan_poids_moyen.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/R/utilitaires.r
pkg/stacomir/data/bM_Arzal.rda
pkg/stacomir/data/msg.rda
pkg/stacomir/inst/config/generate_Roxygen2.R
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/config/testthat.R
pkg/stacomir/inst/examples/bilanFonctionnementDF_example.R
pkg/stacomir/inst/examples/bilanMigrationMult_Arzal.R
pkg/stacomir/inst/tests/testthat/test-00stacomir.R
pkg/stacomir/inst/tests/testthat/test-01BilanMigrationMult.R
pkg/stacomir/man/BilanFonctionnementDC-class.Rd
pkg/stacomir/man/BilanFonctionnementDF-class.Rd
pkg/stacomir/man/BilanMigration-class.Rd
pkg/stacomir/man/BilanMigrationMult-class.Rd
pkg/stacomir/man/RefDF-class.Rd
pkg/stacomir/man/bfDF.Rd
pkg/stacomir/man/calcule-BilanMigrationMult-method.Rd
pkg/stacomir/man/charge-BilanFonctionnementDC-method.Rd
pkg/stacomir/man/choice-RefHorodate-method.Rd
pkg/stacomir/man/choice_c-RefDF-method.Rd
pkg/stacomir/man/choice_c-RefHorodate-method.Rd
pkg/stacomir/man/connect-BilanFonctionnementDC-method.Rd
pkg/stacomir/man/connect-BilanMigrationMult-method.Rd
pkg/stacomir/man/funtraitementdate.Rd
pkg/stacomir/man/interface_BilanMigration.Rd
pkg/stacomir/man/msg.Rd
Log:
Lots of change to avoid connecting to database using fungraph, calls from BilanMigration and BilanMigrationMult. Class BilanOperation, FonctionnementDC, FonctionnementDF are now loaded by charge and connect methods; All classes developped to version 5.0 are now using both charge and connect method (connect not called from charge).
Examples created.....
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2016-09-24 10:02:07 UTC (rev 219)
+++ pkg/stacomir/DESCRIPTION 2016-09-25 19:42:34 UTC (rev 220)
@@ -36,6 +36,7 @@
'Refparqual.r'
'Refparquan.r'
'BilanMigrationPar.r'
+ 'BilanOperation.r'
'Bilan_carlot.r'
'RefCoe.r'
'Bilan_poids_moyen.r'
@@ -49,7 +50,6 @@
'data.r'
'fn_EcritBilanJournalier.r'
'fn_EcritBilanMensuel.r'
- 'fn_sql_dis.r'
'fn_table_per_dis.r'
'funBilanMigrationAnnuel.r'
'funSousListeBilanMigration.r'
@@ -61,7 +61,6 @@
'funstatJournalier.r'
'funtable.r'
'funtraitement_poids.r'
- 'funtraitementdate.r'
'interface_BilanConditionEnv.r'
'interface_BilanFonctionnementDC.r'
'interface_BilanFonctionnementDF.r'
@@ -104,11 +103,9 @@
lubridate,
dplyr
Suggests:
- xtable
+ testthat
Author: Cedric Briand [aut, cre],
Marion Legrand [aut]
Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
RoxygenNote: 5.0.1
NeedsCompilation: no
-Suggests:
- testthat
Modified: pkg/stacomir/NAMESPACE
===================================================================
--- pkg/stacomir/NAMESPACE 2016-09-24 10:02:07 UTC (rev 219)
+++ pkg/stacomir/NAMESPACE 2016-09-25 19:42:34 UTC (rev 220)
@@ -14,6 +14,7 @@
export(funstat)
export(funtableBilan_carlot)
export(funtraitement_poids)
+export(funtraitementdate)
export(hBilanEspecescalc)
export(hCamembert)
export(hTableBilanEspeces)
@@ -32,6 +33,7 @@
exportClasses(BilanMigrationConditionEnv)
exportClasses(BilanMigrationInterAnnuelle)
exportClasses(BilanMigrationMult)
+exportClasses(BilanOperation)
exportClasses(Bilan_carlot)
exportClasses(Bilan_poids_moyen)
exportClasses(Bilan_stades_pigm)
Modified: pkg/stacomir/R/BilanFonctionnementDC.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDC.r 2016-09-24 10:02:07 UTC (rev 219)
+++ pkg/stacomir/R/BilanFonctionnementDC.r 2016-09-25 19:42:34 UTC (rev 220)
@@ -6,8 +6,8 @@
#' class allows to draw graphics allowing an overview of the device operation
#' @slot data A data frame
#' @slot dc An object of class \code{RefDC-class}
-#' @slot horodate An object of class \code{RefHorodate-class}
-#' @slot requete An object of class \code{RequeteODBCwheredate-class}
+#' @slot horodatedebut An object of class \code{RefHorodate-class}
+#' @slot horodatefin An object of class \code{RefHorodate-class}
#' @section Objects from the Class: Objects can be created by calls of the form
#' \code{new("BilanFonctionnementDC", ...)}.
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
@@ -26,12 +26,12 @@
setClass(Class="BilanFonctionnementDC",
representation= representation(data="data.frame",
dc="RefDC",
- horodate="RefHorodate",
- requete="RequeteODBCwheredate"),
+ horodatedebut="RefHorodate",
+ horodatefin="RefHorodate"),
prototype=prototype(data=data.frame(),
dc=new("RefDC"),
- horodate=new("RefHorodate"),
- requete=new("RequeteODBCwheredate"))
+ horodatedebut=new("RefHorodate"),
+ horodatefin=new("RefHorodate"))
)
@@ -41,13 +41,15 @@
#'
#' loads the working periods and type of arrest or disfunction of the DC
#' @param object An object of class \link{BilanFonctionnementDC-class}
+#' @param silent Boolean, default FALSE, if TRUE messages are not displayed
#' @return An object of class \link{BilanFonctionnementDC-class}
#'
#' @author cedric.briand
-setMethod("connect",signature=signature("BilanFonctionnementDC"),definition=function(object) {
-# construit une requete ODBCwheredate
- object at requete@baseODBC<-get("baseODBC",envir=envir_stacomi)
- object at requete@select= sql<-paste("SELECT",
+setMethod("connect",signature=signature("BilanFonctionnementDC"),definition=function(object,silent=FALSE) {
+ #object<-bilanFonctionnementDC
+ req<-new("RequeteODBCwheredate")
+ req at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ req at select= sql<-paste("SELECT",
" per_dis_identifiant,",
" per_date_debut,",
" per_date_fin,",
@@ -57,13 +59,16 @@
" tar_libelle AS libelle",
" FROM ",get("sch",envir=envir_stacomi),"t_periodefonctdispositif_per per",
" INNER JOIN ref.tr_typearretdisp_tar tar ON tar.tar_code=per.per_tar_code",sep="")
- object at requete@colonnedebut<-"per_date_debut"
- object at requete@colonnefin<-"per_date_fin"
- object at requete@order_by<-"ORDER BY per_date_debut"
- object at requete@and<-paste("AND per_dis_identifiant=",object at dc@dc_selectionne )
-#object at requete@where=#defini dans la methode ODBCwheredate
- object at requete<-stacomirtools::connect(object at requete) # appel de la methode connect de l'object ODBCWHEREDATE
- funout(get("msg",envir_stacomi)$BilanFonctionnementDC.1)
+ req at colonnedebut<-"per_date_debut"
+ req at colonnefin<-"per_date_fin"
+ req at datedebut<-object at horodatedebut@horodate
+ req at datefin<-object at horodatefin@horodate
+ req at order_by<-"ORDER BY per_date_debut"
+ req at and<-paste("AND per_dis_identifiant in ",vector_to_listsql(object at dc@dc_selectionne))
+#req at where=#defini dans la methode ODBCwheredate
+ req<-stacomirtools::connect(req) # appel de la methode connect de l'object ODBCWHEREDATE
+ object at data<-req at query
+ if (!silent) funout(get("msg",envir_stacomi)$BilanFonctionnementDC.1)
return(object)
})
@@ -72,10 +77,11 @@
#' used by the graphical interface to retreive the objects of Referential classes
#' assigned to envir_stacomi
#' @param object An object of class \link{BilanFonctionnementDC-class}
+#' @param silent Boolean, default FALSE, if TRUE messages are not displayed.
#' @return An object of class \link{BilanFonctionnementDC-class}
#'
#' @author cedric.briand
-setMethod("charge",signature=signature("BilanFonctionnementDC"),definition=function(object) {
+setMethod("charge",signature=signature("BilanFonctionnementDC"),definition=function(object,silent=FALSE) {
# construit une requete ODBCwheredate
# chargement des donnees dans l'environnement de la fonction
if (exists("refDC",envir_stacomi)) {
@@ -83,18 +89,17 @@
} else {
funout(get("msg",envir_stacomi)$ref.1,arret=TRUE) }
- if (exists("fonctionnementDC_date_debut",envir_stacomi)) {
- object at requete@datedebut<-get("fonctionnementDC_date_debut",envir_stacomi)@horodate
+ if (exists("bilanFonctionnementDC_date_debut",envir_stacomi)) {
+ object at horodatedebut@horodate<-get("bilanFonctionnementDC_date_debut",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.5,arret=TRUE)
}
- if (exists("fonctionnementDC_date_fin",envir_stacomi)) {
- object at requete@datefin<-get("fonctionnementDC_date_fin",envir_stacomi)@horodate
+ if (exists("bilanFonctionnementDC_date_fin",envir_stacomi)) {
+ object at horodatefin@horodate<-get("bilanFonctionnementDC_date_fin",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.6,arret=TRUE)
}
- object<-connect(object)
return(object)
})
# Methode permettant l'affichage d'un graphique en lattice (barchart) du fonctionnement mensuel du dispositif
@@ -107,20 +112,20 @@
#'
#' @author cedric.briand
funbarchartDC = function(h,...) {
- fonctionnementDC=charge(fonctionnementDC)
-
- if( nrow(fonctionnementDC at requete@query)==0 ) {
+ bilanFonctionnementDC=charge(bilanFonctionnementDC)
+ bilanFonctionnementDC=connect(bilanFonctionnementDC)
+ if( nrow(bilanFonctionnementDC at data)==0 ) {
funout(get("msg",envir_stacomi)$BilanFonctionnementDC.2, arret=TRUE)
}
- t_periodefonctdispositif_per<-fonctionnementDC at requete@query # on recupere le data.frame
+ t_periodefonctdispositif_per<-bilanFonctionnementDC at data # on recupere le data.frame
# l'objectif du programme ci dessous est de calculer la time.sequence mensuelle de fonctionnement du dispositif.
tempsdebut<-strptime(t_periodefonctdispositif_per$per_date_debut,"%Y-%m-%d %H:%M:%S", tz = "GMT")
tempsfin<-strptime(t_periodefonctdispositif_per$per_date_fin,"%Y-%m-%d %H:%M:%S", tz = "GMT")
- # test la premiere horodate peut etre avant le choice de temps de debut, remplacer cette date par requete at datedebut
- tempsdebut[tempsdebut<fonctionnementDC at requete@datedebut]<-fonctionnementDC at requete@datedebut
+ # test la premiere horodate peut etre avant le choice de temps de debut, remplacer cette date par object at datedebut
+ tempsdebut[tempsdebut<bilanFonctionnementDC at horodatedebut@horodate]<-bilanFonctionnementDC at horodatedebut@horodate
# id pour fin
- tempsfin[tempsfin>fonctionnementDC at requete@datefin]<-fonctionnementDC at requete@datefin
+ tempsfin[tempsfin>bilanFonctionnementDC at horodatefin@horodate]<-bilanFonctionnementDC at horodatefin@horodate
t_periodefonctdispositif_per=cbind(t_periodefonctdispositif_per,tempsdebut,tempsfin) # rajoute les 2 colonnes tempsdebut et tempsfin
# BUG 06/02/2009 11:51:49 si la date choisie n'est pas le debut du mois
seqmois<-seq(from=tempsdebut[1],to=tempsfin[nrow(t_periodefonctdispositif_per)],by="month",tz = "GMT")
@@ -159,7 +164,7 @@
stack=TRUE,
xlab=get("msg",envir_stacomi)$BilanFonctionnementDC.3,
ylab=get("msg",envir_stacomi)$BilanFonctionnementDC.4,
- main=list(label=paste(get("msg",envir_stacomi)$BilanFonctionnementDC.5,fonctionnementDC at dc@dc_selectionne), gp=grid::gpar(col="grey", fontsize=8)),
+ main=list(label=paste(get("msg",envir_stacomi)$BilanFonctionnementDC.5,bilanFonctionnementDC at dc@dc_selectionne), gp=grid::gpar(col="grey", fontsize=8)),
auto.key=list(rectangles=TRUE,space="bottom",
text=c(get("msg",envir_stacomi)$BilanFonctionnementDC.6,get("msg",envir_stacomi)$FonctionnementDC.7)),
scales= list(x=list(t_periodefonctdispositif_per_mois$mois),
@@ -176,13 +181,14 @@
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funboxDC = function(h,...) {
- fonctionnementDC=charge(fonctionnementDC)
+ bilanFonctionnementDC=charge(bilanFonctionnementDC)
+ bilanFonctionnementDC=connect(bilanFonctionnementDC)
- if( nrow(fonctionnementDC at requete@query)==0 ) {
+ if( nrow(bilanFonctionnementDC at data)==0 ) {
funout(get("msg",envir_stacomi)$BilanFonctionnementDC.2, arret=TRUE)
}
- t_periodefonctdispositif_per<-fonctionnementDC at requete@query # on recupere le data.frame
- time.sequence<-seq.POSIXt(from=fonctionnementDC at requete@datedebut,to=fonctionnementDC at requete@datefin,by="day")
+ t_periodefonctdispositif_per<-bilanFonctionnementDC at data # on recupere le data.frame
+ time.sequence<-seq.POSIXt(from=bilanFonctionnementDC at horodatedebut@horodate,to=bilanFonctionnementDC at horodatedebut@horodate,by="day")
debut<-unclass(as.Date(time.sequence[1]))[[1]]
fin<-unclass(as.Date(time.sequence[length(time.sequence)]))[[1]]
mypalette<-RColorBrewer::brewer.pal(12,"Paired")
@@ -297,24 +303,25 @@
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funtableDC = function(h,...) {
- fonctionnementDC=charge(fonctionnementDC)
+ bilanFonctionnementDC=charge(bilanFonctionnementDC)
+ bilanFonctionnementDC=connect(bilanFonctionnementDC)
- if( nrow(fonctionnementDC at requete@query)==0 ) {
+ if( nrow(bilanFonctionnementDC at data)==0 ) {
funout(get("msg",envir_stacomi)$BilanFonctionnementDC.2, arret=TRUE)
}
- t_periodefonctdispositif_per<-fonctionnementDC at requete@query # on recupere le data.frame
+ t_periodefonctdispositif_per<-bilanFonctionnementDC at data # on recupere le data.frame
t_periodefonctdispositif_per$per_date_debut<-as.character(t_periodefonctdispositif_per$per_date_debut)
t_periodefonctdispositif_per$per_date_fin<-as.character(t_periodefonctdispositif_per$per_date_fin)
gdf(t_periodefonctdispositif_per, container=TRUE)
annee=paste(unique(strftime(as.POSIXlt(t_periodefonctdispositif_per$per_date_debut),"%Y")),collapse="+")
- path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DC_",fonctionnementDC at dc@dc_selectionne,"_",annee,".csv",sep=""),fsep ="\\")
+ path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DC_",bilanFonctionnementDC at dc@dc_selectionne,"_",annee,".csv",sep=""),fsep ="\\")
write.table(t_periodefonctdispositif_per,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
funout(paste(get("msg",envir_stacomi)$BilanFonctionnementDC.14,path1,"\n"))
- path1html<-file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DC_",fonctionnementDC at dc@dc_selectionne,"_",annee,".html",sep=""),fsep ="\\")
+ path1html<-file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DC_",bilanFonctionnementDC at dc@dc_selectionne,"_",annee,".html",sep=""),fsep ="\\")
funout(paste(get("msg",envir_stacomi)$BilanFonctionnementDC.14,path1html,get("msg",envir_stacomi)$BilanFonctionnementDC.15))
funhtml(t_periodefonctdispositif_per,
- caption=paste("t_periodefonctdispositif_per_DF_",fonctionnementDF at df@df_selectionne,"_",annee,sep=""),
+ caption=paste("t_periodefonctdispositif_per_DF_",bilanFonctionnementDF at df@df_selectionne,"_",annee,sep=""),
top=TRUE,
outfile=path1html,
clipboard=FALSE,
Modified: pkg/stacomir/R/BilanFonctionnementDF.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDF.r 2016-09-24 10:02:07 UTC (rev 219)
+++ pkg/stacomir/R/BilanFonctionnementDF.r 2016-09-25 19:42:34 UTC (rev 220)
@@ -11,6 +11,10 @@
#' @include RefDF.r
#' @section Objects from the Class: Objects can be created by calls of the form
#' \code{new("BilanFonctionnementDF")}.
+#' @slot data A data frame
+#' @slot dc An object of class \code{RefDC-class}
+#' @slot horodatedebut An object of class \code{RefHorodate-class}
+#' @slot horodatefin An object of class \code{RefHorodate-class}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @seealso Other Bilan Class \code{\linkS4class{Bilan_carlot}}
#' \code{\linkS4class{Bilan_poids_moyen}}
@@ -31,12 +35,11 @@
representation= representation(data="data.frame",
df="RefDF",
horodatedebut="RefHorodate",
- horodatefin="RefHorodate",
- requete="RequeteODBCwheredate"),
+ horodatefin="RefHorodate"
+ ),
prototype=prototype(data=data.frame(),df=new("RefDF"),
horodatedebut=new("RefHorodate"),
- horodatefin=new("RefHorodate"),
- requete=new("RequeteODBCwheredate")
+ horodatefin=new("RefHorodate")
)
)
@@ -51,8 +54,9 @@
#' @author cedric.briand
setMethod("connect",signature=signature("BilanFonctionnementDF"),definition=function(object,silent=FALSE) {
# construit une requete ODBCwheredate
- object at requete@baseODBC<-get("baseODBC",envir=envir_stacomi)
- object at requete@select= paste("SELECT",
+ req<-new("RequeteODBCwheredate")
+ req at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ req at select= paste("SELECT",
" per_dis_identifiant,",
" per_date_debut,",
" per_date_fin,",
@@ -62,14 +66,14 @@
" tar_libelle AS libelle",
" FROM ",get("sch",envir=envir_stacomi),"t_periodefonctdispositif_per per",
" INNER JOIN ref.tr_typearretdisp_tar tar ON tar.tar_code=per.per_tar_code",sep="")
- object at requete@colonnedebut="per_date_debut"
- object at requete@colonnefin="per_date_fin"
- object at requete@order_by="ORDER BY per_date_debut"
- object at requete@datedebut<-object at horodatedebut@horodate
- object at requete@datefin<-object at horodatefin@horodate
- object at requete@and=paste("AND per_dis_identifiant=",object at df@df_selectionne )
-#object at requete@where=#defini dans la methode ODBCwheredate
- req<-stacomirtools::connect(object at requete) # appel de la methode connect de l'object ODBCWHEREDATE
+ req at colonnedebut="per_date_debut"
+ req at colonnefin="per_date_fin"
+ req at order_by="ORDER BY per_date_debut"
+ req at datedebut<-object at horodatedebut@horodate
+ req at datefin<-object at horodatefin@horodate
+ req at and=paste("AND per_dis_identifiant in",vector_to_listsql(object at df@df_selectionne))
+#req at where=#defini dans la methode ODBCwheredate
+ req<-stacomirtools::connect(req) # appel de la methode connect de l'object ODBCWHEREDATE
object at data<-req at query
if (!silent) funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.1)
return(object)
@@ -102,19 +106,18 @@
funout(get("msg",envir=envir_stacomi)$ref.12,arret=TRUE)
}
- if (exists("fonctionnementDF_date_debut",envir=envir_stacomi)) {
- object at horodatedebut@horodate<-get("fonctionnementDF_date_debut",envir=envir_stacomi)@horodate
+ if (exists("bilanFonctionnementDF_date_debut",envir=envir_stacomi)) {
+ object at horodatedebut@horodate<-get("bilanFonctionnementDF_date_debut",envir=envir_stacomi)
} else {
funout(get("msg",envir=envir_stacomi)$ref.5,arret=TRUE)
}
- if (exists("fonctionnementDF_date_fin",envir=envir_stacomi)) {
- object at horodatefin@horodate<-get("fonctionnementDF_date_fin",envir=envir_stacomi)@horodate
+ if (exists("bilanFonctionnementDF_date_fin",envir=envir_stacomi)) {
+ object at horodatefin@horodate<-get("bilanFonctionnementDF_date_fin",envir=envir_stacomi)
} else {
funout(get("msg",envir=envir_stacomi)$ref.6,arret=TRUE)
}
- object<-connect(object,silent)
- assign("fonctionnementDF",object,envir=envir_stacomi)
+ assign("bilanFonctionnementDF",object,envir=envir_stacomi)
return(object)
})
@@ -131,23 +134,23 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("choice_c",signature=signature("BilanFonctionnementDF"),definition=function(object,df,horodatedebut,horodatefin,silent=FALSE){
- # fonctionnementDF<-BfDF;df=2;horodatedebut="2013-01-01";horodatefin="2013-12-31"
- fonctionnementDF<-object
- assign("fonctionnementDF",fonctionnementDF,envir=envir_stacomi)
+ # bilanFonctionnementDF<-BfDF;df=2;horodatedebut="2013-01-01";horodatefin="2013-12-31"
+ bilanFonctionnementDF<-object
+ assign("bilanFonctionnementDF",bilanFonctionnementDF,envir=envir_stacomi)
if (!silent) funout(get("msg",envir=envir_stacomi)$interface_BilanFonctionnementDC.1)
- fonctionnementDF at df<-charge(fonctionnementDF at df)
- fonctionnementDF at df<-choice_c(fonctionnementDF at df,df)
+ bilanFonctionnementDF at df<-charge(bilanFonctionnementDF at df)
+ bilanFonctionnementDF at df<-choice_c(bilanFonctionnementDF at df,df)
# assigns the parameter (horodatedebut) of the method to the object using choice_c method for RefDC
- fonctionnementDF at horodatedebut<-choice_c(object=fonctionnementDF at horodatedebut,
- nomassign="fonctionnementDF_date_debut",
+ bilanFonctionnementDF at horodatedebut<-choice_c(object=bilanFonctionnementDF at horodatedebut,
+ nomassign="bilanFonctionnementDF_date_debut",
funoutlabel=get("msg",envir=envir_stacomi)$interface_Bilan_lot.5,
horodate=horodatedebut, silent)
- fonctionnementDF at horodatefin<-choice_c(fonctionnementDF at horodatefin,
- nomassign="fonctionnementDF_date_fin",
+ bilanFonctionnementDF at horodatefin<-choice_c(bilanFonctionnementDF at horodatefin,
+ nomassign="bilanFonctionnementDF_date_fin",
funoutlabel=get("msg",envir=envir_stacomi)$interface_Bilan_lot.6,
horodate=horodatefin,silent)
- assign("fonctionnementDF",fonctionnementDF,envir=envir_stacomi)
- return(fonctionnementDF)
+ assign("bilanFonctionnementDF",bilanFonctionnementDF,envir=envir_stacomi)
+ return(bilanFonctionnementDF)
})
#' Different plots for BilanFonctionnementDF
@@ -174,20 +177,20 @@
#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
# PLOT OF TYPE BARCHART (plot.type=1 (true/false) or plot.type=2)
#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
- #fonctionnementDF<-bfDF; require(RGtk2); require(lubridate);require(ggplot2);title=NULL;silent=FALSE;plot.type="1"
- fonctionnementDF<-x
+ #bilanFonctionnementDF<-bfDF; require(RGtk2); require(lubridate);require(ggplot2);title=NULL;silent=FALSE;plot.type="1"
+ bilanFonctionnementDF<-x
plot.type<-as.character(plot.type)# to pass also characters
if (!plot.type%in%c("1","2","3","4")) stop('plot.type must be 1,2,3 or 4')
if (plot.type=="1"|plot.type=="2"){
if (!silent) funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.3)
- t_periodefonctdispositif_per=fonctionnementDF at data # on recupere le data.frame
+ t_periodefonctdispositif_per=bilanFonctionnementDF at data # on recupere le data.frame
# l'objectif du programme ci dessous est de calculer la time.sequence mensuelle de fonctionnement du dispositif.
tempsdebut<-t_periodefonctdispositif_per$per_date_debut
tempsfin<-t_periodefonctdispositif_per$per_date_fin
# test la premiere horodate peut etre avant le choix de temps de debut, remplacer cette date par requete at datedebut
- tempsdebut[tempsdebut<fonctionnementDF at requete@datedebut]<-fonctionnementDF at requete@datedebut
+ tempsdebut[tempsdebut<bilanFonctionnementDF at horodatedebut@horodate]<-bilanFonctionnementDF at horodatedebut@horodate
# id pour fin
- tempsfin[tempsfin>fonctionnementDF at requete@datefin]<-fonctionnementDF at requete@datefin
+ tempsfin[tempsfin>bilanFonctionnementDF at horodatefin@horodate]<-bilanFonctionnementDF at horodatefin@horodate
t_periodefonctdispositif_per=cbind(t_periodefonctdispositif_per,tempsdebut,tempsfin)
seqmois=seq(from=tempsdebut[1],to=tempsfin[nrow(t_periodefonctdispositif_per)],by="month",tz = "GMT")
seqmois=as.POSIXlt(round_date(seqmois,unit="month"))
@@ -230,7 +233,7 @@
t_periodefonctdispositif_per_mois$annee=strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%Y")
progress_bar$setText("All done.")
progress_bar$setFraction(1)
- if (is.null(title)) title<-paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,fonctionnementDF at df@df_selectionne)
+ if (is.null(title)) title<-paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,bilanFonctionnementDF at df@df_selectionne)
# graphic
t_periodefonctdispositif_per_mois<-stacomirtools::chnames(t_periodefonctdispositif_per_mois,
old_variable_name=c("sumduree","per_tar_code","per_etat_fonctionnement"),
@@ -264,16 +267,16 @@
# PLOT OF TYPE BOX (plot.type=3)
#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
} else if (plot.type=="3"){
- #fonctionnementDF<-bfDF; require(RGtk2); require(lubridate);require(ggplot2);title=NULL;silent=FALSE;plot.type="3"
+ #bilanFonctionnementDF<-bfDF; require(RGtk2); require(lubridate);require(ggplot2);title=NULL;silent=FALSE;plot.type="3"
if (!silent) funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.3)
- t_periodefonctdispositif_per=fonctionnementDF at data
+ t_periodefonctdispositif_per=bilanFonctionnementDF at data
graphdate<-function(vectordate){
vectordate<-as.POSIXct(vectordate)
attributes(vectordate)<-NULL
unclass(vectordate)
return(vectordate)
}
- time.sequence=seq.POSIXt(from=fonctionnementDF at requete@datedebut,to=fonctionnementDF at requete@datefin,by="day")
+ time.sequence=seq.POSIXt(from=bilanFonctionnementDF at horodatedebut@horodate,to=bilanFonctionnementDF at horodatefin@horodate,by="day")
debut=graphdate(time.sequence[1])
fin=graphdate(time.sequence[length(time.sequence)])
mypalette<-RColorBrewer::brewer.pal(12,"Paired")
@@ -379,10 +382,10 @@
# PLOT OF TYPE BOX (plot.type=4)
#&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
} else if (plot.type=="4"){
- if (is.null(title)) title<-paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,fonctionnementDF at df@df_selectionne)
+ if (is.null(title)) title<-paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,bilanFonctionnementDF at df@df_selectionne)
- #fonctionnementDF<-bfDF; require(RGtk2); require(lubridate);require(ggplot2);title=NULL;silent=FALSE;plot.type="4"
- t_periodefonctdispositif_per=fonctionnementDF at data
+ #bilanFonctionnementDF<-bfDF; require(RGtk2); require(lubridate);require(ggplot2);title=NULL;silent=FALSE;plot.type="4"
+ t_periodefonctdispositif_per=bilanFonctionnementDF at data
tpp<-split_per_day(t_periodefonctdispositif_per,horodatedebut="per_date_debut",horodatefin="per_date_fin")
g<-ggplot(tpp)+
@@ -417,12 +420,13 @@
#' @param ... additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funbarchartDF = function(h,...) {
- fonctionnementDF<-get("fonctionnementDF",envir=envir_stacomi)
- fonctionnementDF=charge(fonctionnementDF)
- if( nrow(fonctionnementDF at data)==0 ) {
+ bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
+ bilanFonctionnementDF=charge(bilanFonctionnementDF)
+ bilanFonctionnementDF<-connect(bilanFonctionnementDF)
+ if( nrow(bilanFonctionnementDF at data)==0 ) {
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.2, arret=TRUE)
}
- plot(fonctionnementDF,plot.type=1,silent=FALSE)
+ plot(bilanFonctionnementDF,plot.type=1,silent=FALSE)
}
@@ -433,12 +437,13 @@
#' @param ... additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funbarchart1DF = function(h,...) {
- fonctionnementDF<-get("fonctionnementDF",envir=envir_stacomi)
- fonctionnementDF=charge(fonctionnementDF)
- if( nrow(fonctionnementDF at data)==0 ) {
+ bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
+ bilanFonctionnementDF=charge(bilanFonctionnementDF)
+ bilanFonctionnementDF<-connect(bilanFonctionnementDF)
+ if( nrow(bilanFonctionnementDF at data)==0 ) {
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.2, arret=TRUE)
}
- plot(fonctionnementDF,plot.type=2,silent=FALSE)
+ plot(bilanFonctionnementDF,plot.type=2,silent=FALSE)
}
#' Internal use, rectangles to describe the DF work for BilanFonctionnementDF class,
#' graphical interface handler
@@ -446,13 +451,14 @@
#' @param ... additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funboxDF = function(h,...) {
- fonctionnementDF<-get("fonctionnementDF",envir=envir_stacomi)
- fonctionnementDF=charge(fonctionnementDF)
+ bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
+ bilanFonctionnementDF=charge(bilanFonctionnementDF)
+ bilanFonctionnementDF<-connect(bilanFonctionnementDF)
- if( nrow(fonctionnementDF at data)==0 ) {
+ if( nrow(bilanFonctionnementDF at data)==0 ) {
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.2, arret=TRUE)
}
- plot(fonctionnementDF,plot.type=3,silent=FALSE)
+ plot(bilanFonctionnementDF,plot.type=3,silent=FALSE)
}
@@ -461,13 +467,14 @@
#' @param ... additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funchartDF = function(h,...) {
- fonctionnementDF<-get("fonctionnementDF",envir=envir_stacomi)
- fonctionnementDF=charge(fonctionnementDF)
+ bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
+ bilanFonctionnementDF=charge(bilanFonctionnementDF)
+ bilanFonctionnementDF<-connect(bilanFonctionnementDF)
- if( nrow(fonctionnementDF at data)==0 ) {
+ if( nrow(bilanFonctionnementDF at data)==0 ) {
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.2, arret=TRUE)
}
- plot(fonctionnementDF,plot.type=4,silent=FALSE)
+ plot(bilanFonctionnementDF,plot.type=4,silent=FALSE)
}
@@ -476,13 +483,14 @@
#' @param ... additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funtableDF = function(h,...) {
- fonctionnementDF<-get("fonctionnementDF",envir=envir_stacomi)
- fonctionnementDF=charge(fonctionnementDF)
+ bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
+ bilanFonctionnementDF=charge(bilanFonctionnementDF)
+ bilanFonctionnementDF<-connect(bilanFonctionnementDF)
- if( nrow(fonctionnementDF at data)==0 ) {
+ if( nrow(bilanFonctionnementDF at data)==0 ) {
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.2, arret=TRUE)
}
- summary(fonctionnementDF)
+ summary(bilanFonctionnementDF)
}
#' handler to print the command line
@@ -490,11 +498,12 @@
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
houtDF = function(h,...) {
- fonctionnementDF<-get("fonctionnementDF",envir=envir_stacomi)
- fonctionnementDF<-charge(fonctionnementDF)
+ bilanFonctionnementDF<-get("bilanFonctionnementDF",envir=envir_stacomi)
+ bilanFonctionnementDF<-charge(bilanFonctionnementDF)
+ bilanFonctionnementDF<-connect(bilanFonctionnementDF)
#the charge method will check that all objects necessary to build the formula
# are in envir_stacomi
- print(fonctionnementDF)
+ print(bilanFonctionnementDF)
}
@@ -524,28 +533,28 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("summary",signature=signature(object="BilanFonctionnementDF"),definition=function(object,silent=FALSE,...){
- #fonctionnementDF<-bfDF;
- t_periodefonctdispositif_per=fonctionnementDF at data # on recupere le data.frame
+ #bilanFonctionnementDF<-bfDF;
+ t_periodefonctdispositif_per=bilanFonctionnementDF at data # on recupere le data.frame
t_periodefonctdispositif_per$per_date_debut=as.character(t_periodefonctdispositif_per$per_date_debut)
t_periodefonctdispositif_per$per_date_fin=as.character(t_periodefonctdispositif_per$per_date_fin)
#gdf(t_periodefonctdispositif_per, container=TRUE)
annee=paste(unique(strftime(as.POSIXlt(t_periodefonctdispositif_per$per_date_debut),"%Y")),collapse="+")
- path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DF_",fonctionnementDF at df@df_selectionne,"_",annee,".csv",sep=""),fsep ="\\")
+ path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DF_",bilanFonctionnementDF at df@df_selectionne,"_",annee,".csv",sep=""),fsep ="\\")
write.table(t_periodefonctdispositif_per,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
if(!silent) funout(paste(get("msg",envir=envir_stacomi)$FonctionnementDC.14,path1,"\n"))
- path1html=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DF_",fonctionnementDF at df@df_selectionne,"_",annee,".html",sep=""),fsep ="\\")
+ path1html=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("t_periodefonctdispositif_per_DF_",bilanFonctionnementDF at df@df_selectionne,"_",annee,".html",sep=""),fsep ="\\")
if(!silent) funout(paste(get("msg",envir=envir_stacomi)$FonctionnementDC.14,path1html,get("msg",envir=envir_stacomi)$BilanFonctionnementDF.15))
funhtml(t_periodefonctdispositif_per,
- caption=paste("t_periodefonctdispositif_per_DF_",fonctionnementDF at df@df_selectionne,"_",annee,sep=""),
+ caption=paste("t_periodefonctdispositif_per_DF_",bilanFonctionnementDF at df@df_selectionne,"_",annee,sep=""),
top=TRUE,
outfile=path1html,
clipboard=FALSE,
append=FALSE,
digits=2
)
- t_periodefonctdispositif_per=fonctionnementDF at data
- print(paste("summary statistics for DF=",fonctionnementDF at df@df_selectionne))
- print(paste("df_code=",fonctionnementDF at df@data[fonctionnementDF at df@data$df==fonctionnementDF at df@df_selectionne,"df_code"]))
+ t_periodefonctdispositif_per=bilanFonctionnementDF at data
+ print(paste("summary statistics for DF=",bilanFonctionnementDF at df@df_selectionne))
+ print(paste("df_code=",bilanFonctionnementDF at df@data[bilanFonctionnementDF at df@data$df==bilanFonctionnementDF at df@df_selectionne,"df_code"]))
duree<-difftime(t_periodefonctdispositif_per$per_date_fin,t_periodefonctdispositif_per$per_date_debut,units="day")
sommes<-tapply(duree,t_periodefonctdispositif_per$per_tar_code,sum)
perc<-round(100*sommes/as.numeric(sum(duree)))
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2016-09-24 10:02:07 UTC (rev 219)
+++ pkg/stacomir/R/BilanMigration.r 2016-09-25 19:42:34 UTC (rev 220)
@@ -13,7 +13,8 @@
#' @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 and how it is used to "write" in the database
+#' @note Method \code{plot(...,type="standard")} also calls a function that will write to the database if
+#' a connection to the database is expected.
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @seealso Other Bilan Class \code{\linkS4class{Bilan_carlot}},
#' \code{\linkS4class{Bilan_poids_moyen}},
@@ -71,7 +72,7 @@
hbilanMigrationcalc=function(h,...){
bilanMigration<-get("bilanMigration",envir=envir_stacomi)
bilanMigration<-charge(bilanMigration)
- # charge loads the method connect
+ bilanMigration<-connect(bilanMigration)
bilanMigration<-calcule(bilanMigration)
}
@@ -105,9 +106,6 @@
# code for debug using bM_Arzal example
#bilanMigration<-bM_Arzal;dc=5;taxons="Liza ramada";stades="IND";datedebut="2015-01-01";datefin="2015-12-31"
bilanMigration<-object
- fonctionnementDC=new("BilanFonctionnementDC")
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 220
More information about the Stacomir-commits
mailing list