[Stacomir-commits] r206 - in pkg: stacomir/R stacomir/data stacomir/examples/02_BilanMigration stacomir/examples/03_BilanFonctionnementDF stacomir/inst/tests/testthat stacomir/man stacomirtools/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 11 20:27:39 CEST 2016
Author: briand
Date: 2016-09-11 20:27:39 +0200 (Sun, 11 Sep 2016)
New Revision: 206
Added:
pkg/stacomir/data/calcmig.csv
pkg/stacomir/man/houtBilanMigration.Rd
pkg/stacomir/man/summary-BilanMigration-method.Rd
Removed:
pkg/stacomir/data/calcmig.rda
Modified:
pkg/stacomir/R/BilanConditionEnv.r
pkg/stacomir/R/BilanEspeces.r
pkg/stacomir/R/BilanFonctionnementDC.r
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/BilanMigrationConditionEnv.r
pkg/stacomir/R/BilanMigrationInterAnnuelle.r
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/PasDeTempsJournalier.r
pkg/stacomir/R/RefDC.r
pkg/stacomir/R/RefMsg.r
pkg/stacomir/R/RefTaxon.r
pkg/stacomir/R/fn_EcritBilanJournalier.r
pkg/stacomir/R/fn_EcritBilanMensuel.r
pkg/stacomir/R/funtable.r
pkg/stacomir/R/interface_BilanMigration.r
pkg/stacomir/R/interface_BilanMigrationMult.r
pkg/stacomir/R/setAs.r
pkg/stacomir/examples/02_BilanMigration/bilanMigration_Arzal.R
pkg/stacomir/examples/03_BilanFonctionnementDF/bilanFonctionnementDF_example.R
pkg/stacomir/inst/tests/testthat/test-00stacomir.R
pkg/stacomir/inst/tests/testthat/test-01BilanMigrationMult.R
pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R
pkg/stacomir/man/BilanMigration-class.Rd
pkg/stacomir/man/calcule-BilanMigrationConditionEnv-method.Rd
pkg/stacomir/man/calcule-BilanMigrationMult-method.Rd
pkg/stacomir/man/charge-BilanConditionEnv-method.Rd
pkg/stacomir/man/charge-BilanFonctionnementDC-method.Rd
pkg/stacomir/man/charge-BilanMigration-method.Rd
pkg/stacomir/man/charge-BilanMigrationMult-method.Rd
pkg/stacomir/man/choicemult-RefDC-method.Rd
pkg/stacomir/man/connect-BilanConditionEnv-method.Rd
pkg/stacomir/man/connect-BilanFonctionnementDC-method.Rd
pkg/stacomir/man/connect-BilanMigrationInterAnnuelle-method.Rd
pkg/stacomir/man/createmessage-RefMsg-method.Rd
pkg/stacomir/man/hTableBilanMigration.Rd
pkg/stacomirtools/R/RequeteODBC.r
Log:
Modified: pkg/stacomir/R/BilanConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanConditionEnv.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanConditionEnv.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -45,7 +45,7 @@
#' connect method for BilanConditionEnv class
-#' @param object An objet of class \link{BilanConditionEnv-class}
+#' @param object An object of class \link{BilanConditionEnv-class}
#' @param h A handler
#' @return an object of BilanConditionEnv class
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
@@ -79,7 +79,7 @@
)
#' charge method for BilanCondtionEnv class
-#' @param object An objet of class \link{BilanConditionEnv-class}
+#' @param object An object of class \link{BilanConditionEnv-class}
#' @param h A handler
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
Modified: pkg/stacomir/R/BilanEspeces.r
===================================================================
--- pkg/stacomir/R/BilanEspeces.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanEspeces.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -242,7 +242,7 @@
"mois"=as.data.frame(xtabs(lot_effectif~taxon_stades+mois,data=tableEspeces)),
"semaine"=as.data.frame(xtabs(lot_effectif~taxon_stades+semaine,data=tableEspeces)),
"aucun"=as.data.frame(xtabs(lot_effectif~taxon_stades,data=tableEspeces)))
- colnames(sumEspeces)[colnames(sumEspeces)=="Freq"]<-"Effectif" # pas forcement le m nb de colonnes funout(get("msg",envir_stacomi)$BilanMigration.9)
+ colnames(sumEspeces)[colnames(sumEspeces)=="Freq"]<-"Effectif" # pas forcement le m nb de colonnes
path=file.path(normalizePath(path.expand(get("datawd",envir=envir_stacomi))),paste("tableEspece",now,".csv",sep=""),fsep ="\\")
write.table(sumEspeces,path,row.names=TRUE,col.names=TRUE,sep=";",append=FALSE)
funout(paste(get("msg",envir=envir_stacomi)$funtable.1,path,"\n"))
Modified: pkg/stacomir/R/BilanFonctionnementDC.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDC.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanFonctionnementDC.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -40,11 +40,11 @@
#' connect method for BilanFonctionnementDC
#'
#' loads the working periods and type of arrest or disfunction of the DC
-#' @param objet An object of class \link{BilanFonctionnementDC-class}
+#' @param object An object of class \link{BilanFonctionnementDC-class}
#' @return An object of class \link{BilanFonctionnementDC-class}
#'
#' @author cedric.briand
-setMethod("connect",signature=signature("BilanFonctionnementDC"),definition=function(object,h) {
+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",
@@ -71,12 +71,12 @@
#'
#' used by the graphical interface to retreive the objects of Referential classes
#' assigned to envir_stacomi
-#' @param objet An object of class \link{BilanFonctionnementDC-class}
+#' @param object An object of class \link{BilanFonctionnementDC-class}
#' @param h A handler passed from the graphical interface
#' @return An object of class \link{BilanFonctionnementDC-class}
#'
#' @author cedric.briand
-setMethod("charge",signature=signature("BilanFonctionnementDC"),definition=function(object,h) {
+setMethod("charge",signature=signature("BilanFonctionnementDC"),definition=function(object) {
# construit une requete ODBCwheredate
# chargement des donnees dans l'environnement de la fonction
if (exists("refDC",envir_stacomi)) {
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanMigration.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -55,11 +55,10 @@
rep2=length(object at taxons)==1
rep3=length(object at stades)==1
rep3=length(object at pasDeTemps)==1
- rep4=(object at pasDeTemps@nbStep==365) # contrainte : pendant 365j
+ rep4=(object at pasDeTemps@nbStep==365|object at pasDeTemps@nbStep==366) # constraint 365 to 366 days
rep5=as.numeric(strftime(object at pasDeTemps@dateDebut,'%d'))==1 # contrainte : depart = 1er janvier
rep6=as.numeric(strftime(object at pasDeTemps@dateDebut,'%m'))==1
- 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)]))
+ return(ifelse(rep1 & rep2 & rep3 & rep4 & rep5 & rep6 , TRUE ,c(1:6)[!c(rep1, rep2, rep3, rep4, rep5, rep6)]))
}
)
@@ -72,7 +71,7 @@
hbilanMigrationcalc=function(h,...){
bilanMigration<-get("bilanMigration",envir=envir_stacomi)
bilanMigration<-charge(bilanMigration)
- bilanMigration<-connect(bilanMigration)
+ # charge loads the method connect
bilanMigration<-calcule(bilanMigration)
}
@@ -119,11 +118,15 @@
bilanMigration at stades<-charge_avec_filtre(object=bilanMigration at stades,bilanMigration at dc@dc_selectionne,bilanMigration at taxons@data$tax_code)
bilanMigration at stades<-choice_c(bilanMigration at stades,stades)
bilanMigration at pasDeTemps<-choice_c(bilanMigration at pasDeTemps,datedebut,datefin)
+ bilanMigration<-connect(bilanMigration)
+ stopifnot(validObject(bilanMigration, test=TRUE))
assign("bilanMigration",bilanMigration,envir = envir_stacomi)
return(bilanMigration)
})
#' charge method for BilanMigration
+#'
+#' fills also the data slot by the connect method
#' @param object An object of class \code{\link{BilanMigration-class}}
#' @return An object of class \link{BilanMigration-class} with slots filled by user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
@@ -157,8 +160,10 @@
funout(get("msg",envir=envir_stacomi)$BilanMigration.1,arret=FALSE)
warning(get("msg",envir=envir_stacomi)$BilanMigration.1)
}
+ bilanMigration=connect(bilanMigration)
+ if (!silent) cat(stringr::str_c("data collected from the database nrow=",nrow(bilanMigration at data),"\n"))
stopifnot(validObject(bilanMigration, test=TRUE))
- funout(get("msg",envir=envir_stacomi)$BilanMigration.2)
+ if (!silent) funout(get("msg",envir=envir_stacomi)$BilanMigration.2)
return(bilanMigration)
})
@@ -182,12 +187,11 @@
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")
+
+ 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,
@@ -255,6 +259,23 @@
}
})
+
+
+#' handler to print the command line
+#' @param h a handler
+#' @param ... Additional parameters
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+ houtBilanMigration=function(h=null,...) {
+ if (exists("refStades",envir_stacomi)) {
+ bilanMigration<-get("bilanMigration",envir_stacomi)
+ print(bilanMigration)
+ }
+ else
+ {
+ funout(get("msg",envir_stacomi)$BilanMigrationMult.2,arret=TRUE)
+ }
+ }
+
#' Method to print the command line of the object
#' @param x An object of class BilanMigrationMult
#' @param ... Additional parameters passed to print
@@ -434,7 +455,7 @@
} else {
funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
}
- #funout(get("msg",envir_stacomi)$BilanMigration.9)
+
plot(bilanMigration,plot.type="standard")
# ecriture du bilan journalier, ecrit aussi le bilan mensuel
fn_EcritBilanJournalier(bilanMigration)
@@ -453,38 +474,46 @@
} else {
funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
}
- #funout(get("msg",envir_stacomi)$BilanMigration.9)
plot(bilanMigration,plot.type="step")
}
-#' handler for summary function
+#' handler for summary function, internal use
#' calls functions funstat and funtable to build summary tables in html and
#' csv files
#' @param h Handler
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
hTableBilanMigration=function(h,...) {
- funout("Tableau de sortie \n")
- if (exists("bilanMigration",envir_stacomi))
- {
- bilanMigration<-get("bilanMigration",envir_stacomi)
- }
- else
- {
- funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
+ hTableBilanMigrationMult=function(h=null,...) {
+ if (exists("bilanMigration",envir_stacomi))
+ {
+ bilanMigration<-get("bilanMigration",envir_stacomi)
+ }
+ else
+ {
+ funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
+ }
+ summary(bilanMigration)
}
- 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)
- resum=funstat(tableau=bilanMigration at data,
- bilanMigration at time.sequence,
- taxon,
- stade,
- DC)
- funtable(tableau=bilanMigration at data,time.sequence=bilanMigration at time.sequence,taxon,stade,DC,resum)
}
+#' summary for bilanMigration
+#' calls functions funstat and funtable to create migration overviews
+#' and generate csv and html output in the user data directory
+#' @param object An object of class \code{\link{BilanMigration-class}}
+#' @param silent Should the program stay silent or display messages, default FALSE
+#' @param ... Additional parameters (not used there)
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("summary",signature=signature(object="BilanMigration"),definition=function(object,silent=FALSE,...){
+ bilanMigrationMult<-as(object,"BilanMigrationMult")
+ summary(bilanMigrationMult,silent=silent)
+ })
+
+
+
+
+
#' handler hBilanMigrationwrite
#' Allows the saving of daily and monthly counts in the database, this method is also called from hbilanMigrationgraph
#' @param h a handler
Modified: pkg/stacomir/R/BilanMigrationConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanMigrationConditionEnv.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanMigrationConditionEnv.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -68,7 +68,7 @@
#'
-#' @param object An object of class \code{\link{BilanMigrationEnv-class}}
+#' @param object An object of class \code{\link{BilanMigrationConditionEnv-class}}
#' @param ... additional parameters
#' @return \code{\link{BilanMigrationEnv-class}}
#' @export
Modified: pkg/stacomir/R/BilanMigrationInterAnnuelle.r
===================================================================
--- pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -52,11 +52,12 @@
#' 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
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("connect",signature=signature("BilanMigrationInterAnnuelle"),
- definition=function(object)
+ definition=function(object,silent=FALSE)
{
# tableau contenant toutes les annees
les_annees = (object at anneeDebut@annee_selectionnee):(object at anneeFin@annee_selectionnee)
@@ -77,17 +78,19 @@
index=unique(object at data$bjo_annee) %in% les_annees
# s'il manque des donnees pour certaines annees selectionnnees"
- if (length(les_annees[!index]>0))
- {
- funout(paste(get("msg",envir=envir_stacomi)$BilanMigrationInterannuelle.1,
- paste(les_annees[!index],collapse=","),get("msg",envir=envir_stacomi)$BilanMigrationInterannuelle.2,"\n"))
- } # end if
-
- # si toutes les annees sont presentes
- if (length(les_annees[index]>0)){
- funout(paste(get("msg",envir=envir_stacomi)$BilanMigrationInterannuelle.3,
- paste(les_annees[index],collapse=","), "\n"))
- }
+ if (!silent){
+ if (length(les_annees[!index]>0))
+ {
+ funout(paste(get("msg",envir=envir_stacomi)$BilanMigrationInterannuelle.1,
+ paste(les_annees[!index],collapse=","),get("msg",envir=envir_stacomi)$BilanMigrationInterannuelle.2,"\n"))
+ } # end if
+
+ # si toutes les annees sont presentes
+ if (length(les_annees[index]>0)){
+ funout(paste(get("msg",envir=envir_stacomi)$BilanMigrationInterannuelle.3,
+ paste(les_annees[index],collapse=","), "\n"))
+ }
+ }
return(object)
}
)
@@ -110,15 +113,17 @@
requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
requete at select=stringr::str_c("DELETE from ",get("sch",envir=envir_stacomi),"t_bilanmigrationjournalier_bjo ")
requete at where=paste("WHERE bjo_annee IN (",paste(les_annees,collapse=","),") AND bjo_tax_code='",tax,"' AND bjo_std_code='",std,"' AND bjo_dis_identifiant=",dic,sep="")
- requete<-stacomirtools::connect(requete)
+ invisible(capture_output(requete<-stacomirtools::connect(requete)))
+
requete=new("RequeteODBCwhere")
requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
requete at select=stringr::str_c("DELETE from ",get("sch",envir=envir_stacomi),"t_bilanmigrationmensuel_bme ")
requete at where=paste("WHERE bme_annee IN (",paste(les_annees,collapse=","),") AND bme_tax_code='",tax,"' AND bme_std_code='",std,"' AND bme_dis_identifiant=",dic,sep="")
- requete<-stacomirtools::connect(requete)
+ invisible(capture_output(requete<-stacomirtools::connect(requete)))
+
return(invisible(NULL))
}
-
+
)
#' loading method for BilanMigrationInterannuelle class
@@ -303,7 +308,7 @@
# si nul on remplace par jour pour generer le script en dessous
timesplit="jour"
jour2000=as.Date(Hmisc::trunc.POSIXt(seq.POSIXt(from=strptime("2000-01-01",format='%Y-%m-%d'),
- to=strptime("2000-12-31",format='%Y-%m-%d'), by="day"), digits='days'))
+ to=strptime("2000-12-31",format='%Y-%m-%d'), by="day"), digits='days'))
for (j in unique(dat$annee)){
# les jours qui n'ont pas de bilan journalier pour ce jour sont rajoutes avec zero
jour2000restant<-jour2000[!jour2000 %in% dat[dat$annee==j,"jour"]]
@@ -347,7 +352,7 @@
#################
# Calcul des cumsum
###################
-
+
#dat$valeur[dat$valeur<0]<-0
for (an in unique(dat$annee)){
# an=as.character(unique(dat$annee)) ;an<-an[1]
@@ -358,7 +363,7 @@
dat$jour=as.Date(dat$jour)
dat$annee=as.factor(dat$annee)
# bug, enleve les annees avec seulement une ligne
-
+
#################
# Graphique
###################
@@ -411,7 +416,7 @@
thechoice=select.list(choices=as.character(unique(dat$annee)),preselect=as.character(max(as.numeric(as.character(dat$annee)))),"choice annee",multiple=TRUE)
amplitude=paste(min(as.numeric(as.character(dat$annee))),"-",max(as.numeric(as.character(dat$annee))),sep="")
# 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
if (length(thechoice)>0) {
@@ -478,7 +483,7 @@
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
@@ -486,7 +491,7 @@
# dat[,timesplit]<-gdata::reorder(dat[,timesplit], new.order=match(levels(dat[,timesplit]),newdat[,timesplit]))
# levels(dat[,timesplit])<-newdat[,timesplit]
# levels(newdat[,timesplit])<-newdat[,timesplit]
-
+
the_choice=select.list(choices=as.character(unique(dat$annee)),preselect=as.character(max(as.numeric(as.character(dat$annee)))),"choice annee",multiple=TRUE)
amplitude=paste(min(as.numeric(as.character(dat$annee))),"-",max(as.numeric(as.character(dat$annee))),sep="")
Modified: pkg/stacomir/R/BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMult.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/BilanMigrationMult.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -53,10 +53,6 @@
rep1=length(object at dc)>=1
rep2=length(object at taxons)>=1
rep3=length(object at stades)>=1
- # rep3=length(object at pasDeTemps)==1
- #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 , TRUE ,c(1:6)[!c(rep1, rep2, rep3)]))
}
)
@@ -66,7 +62,8 @@
#' charge method for BilanMigrationMult
#'
-#' Used by the graphical interface to collect and test objects in the environment envir_stacomi
+#' Used by the graphical interface to collect and test objects in the environment envir_stacomi,
+#' fills also the data slot by the connect method
#' @return BilanMigrationMult with slots filled by user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
setMethod("charge",signature=signature("BilanMigrationMult"),definition=function(object,...){
@@ -97,6 +94,9 @@
funout(get("msg",envir=envir_stacomi)$BilanMigration.1,arret=FALSE)
warning(get("msg",envir=envir_stacomi)$BilanMigration.1)
}
+ bilanMigrationMult=connect(bilanMigrationMult)
+ if (!silent) cat(stringr::str_c("data collected from the database nrow=",nrow(bilanMigrationMult at data),"\n"))
+
stopifnot(validObject(bilanMigrationMult, test=TRUE))
funout(get("msg",envir=envir_stacomi)$BilanMigration.2)
return(bilanMigrationMult)
@@ -129,8 +129,8 @@
#' calcule method for BilanMigrationMult
#'
-#' does the calculation once data are filled. It also performs conversion from weight to numbers
-#' in with the connect method
+#' does the calculation once data are filled.
+#'
#' @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
@@ -142,8 +142,6 @@
setMethod("calcule",signature=signature("BilanMigrationMult"),definition=function(object,negative=FALSE,silent=FALSE){
bilanMigrationMult<-object
- bilanMigrationMult=connect(bilanMigrationMult)
- 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,
@@ -538,6 +536,7 @@
hbilanMigrationMultcalc=function(h=null,...){
bilanMigrationMult<-get("bilanMigrationMult",envir=envir_stacomi)
bilanMigrationMult<-charge(bilanMigrationMult)
+ # charge loads the method connect
bilanMigrationMult<-calcule(bilanMigrationMult)
}
@@ -583,7 +582,6 @@
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
hTableBilanMigrationMult=function(h=null,...) {
- funout("Tableau de sortie \n")
if (exists("bilanMigrationMult",envir_stacomi))
{
bilanMigrationMult<-get("bilanMigrationMult",envir_stacomi)
@@ -604,12 +602,14 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("summary",signature=signature(object="BilanMigrationMult"),definition=function(object,silent=FALSE,...){
+ #bilanMigrationMult<-bMM_Arzal; silent<-FALSE
bilanMigrationMult<-object
lestaxons= bilanMigrationMult at taxons@data
lesstades= bilanMigrationMult at stades@data
lesdc=as.numeric(bilanMigrationMult at dc@dc_selectionne)
- funout(get("msg",envir_stacomi)$BilanMigration.9)
+ if (!silent) funout(get("msg",envir_stacomi)$BilanMigration.9)
#&&&&&&&&&&&&&&&&&&&&&&&&&debut de boucle&&&&&&&&&&&&&&&&&&&&&&&&&&&
+ #dcnum=2;taxonnum=1;stadenum=1
for (dcnum in 1:length(lesdc)){
for (taxonnum in 1:nrow(lestaxons)){
for (stadenum in 1:nrow(lesstades)){
@@ -642,6 +642,9 @@
resum=funstat(tableau=data_without_hole,
time.sequence=bilanMigrationMult at time.sequence,taxon,stade,DC,silent)
+ # pb with posixt and xtable, removing posixt and setting date instead
+ data_without_hole$debut_pas<-as.Date(data_without_hole$debut_pas)
+ data_without_hole<-data_without_hole[,-match("fin_pas",colnames(data_without_hole))]
funtable(tableau=data_without_hole,
time.sequence=bilanMigrationMult at time.sequence,
taxon,stade,DC,resum,silent)
Modified: pkg/stacomir/R/PasDeTempsJournalier.r
===================================================================
--- pkg/stacomir/R/PasDeTempsJournalier.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/PasDeTempsJournalier.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -143,7 +143,7 @@
}
}
object at dateDebut<-as.POSIXlt(datedebut)
- object at nbStep=as.numeric(difftime(datefin,datedebut,units="days"))
+ object at nbStep=as.numeric(difftime(datefin,datedebut,units="days")+1)
validObject(object)
return(object)
})
Modified: pkg/stacomir/R/RefDC.r
===================================================================
--- pkg/stacomir/R/RefDC.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/RefDC.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -164,7 +164,7 @@
#' By default, the value of the objectbilan is null.
#' When it is not the method calls daughter widgets (e.g. the dc widget will call species)
#' and fills it with the method \link{charge_avec_filtre,RefTaxon-method}
-#' @param object An objet of class RefDC
+#' @param object An object of class RefDC
#' @param objectBilan A bilan object
#' @param is.enabled A boolean indicating if the widget can be seleted at launch
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
Modified: pkg/stacomir/R/RefMsg.r
===================================================================
--- pkg/stacomir/R/RefMsg.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/RefMsg.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -48,7 +48,7 @@
})
#' createmessage method for RefMsg referential objects
-#' @param ojbect An objet of class RefMsg
+#' @param ojbect An object of class RefMsg
#' @param database_expected Default to TRUE, if FALSE, no database connection is expected and the messages will be loaded from msg dataset within the package
#' @return An S4 object of class RefMsg
#' @note When coming from the database, doublequotes are now escaped with an antislash (/"), those at the beginning and end are left as doublequotes,
Modified: pkg/stacomir/R/RefTaxon.r
===================================================================
--- pkg/stacomir/R/RefTaxon.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/RefTaxon.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -217,11 +217,11 @@
funout(get("msg",envir=envir_stacomi)$RefTaxon.5,arret=TRUE)
} else if (class(taxons)=="character"){
libellemanquants<-taxons[!taxons%in%object at data$tax_nom_latin]
- if (length(libellemanquants)>0) funout(paste(get("msg",envir=envir_stacomi)$RefTaxon.6,stringr::str_c(libellemanquants,collapse=", ")))
+ if (length(libellemanquants)>0) warning(paste(get("msg",envir=envir_stacomi)$RefTaxon.6,stringr::str_c(libellemanquants,collapse=", ")))
object at data<-object at data[object at data$tax_nom_latin%in%taxons,]
} else if (class(taxons)=="numeric"){
codemanquants<-taxons[!taxons%in%object at data$tax_code]
- if (length(codemanquants)>0) funout(paste(get("msg",envir=envir_stacomi)$RefTaxon.6,stringr::str_c(codemanquants,collapse=", ")))
+ if (length(codemanquants)>0) warning(paste(get("msg",envir=envir_stacomi)$RefTaxon.6,stringr::str_c(codemanquants,collapse=", ")))
object at data<-object at data[object at data$tax_code%in%taxons,]
}
if (nrow(object at data)==0 ) {
Modified: pkg/stacomir/R/fn_EcritBilanJournalier.r
===================================================================
--- pkg/stacomir/R/fn_EcritBilanJournalier.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/fn_EcritBilanJournalier.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -48,15 +48,12 @@
# Ci dessous conversion de la classe vers migration Interannuelle pour utiliser
# les methodes de cette classe
bil=as(bilanMigration,"BilanMigrationInterAnnuelle")
- bil=connect(bil)
+ bil=connect(bil,silent=silent)
hconfirm=function(h,...){
# suppression des donnees actuellement presentes dans la base
- supprime(bil)
- requete=new("RequeteODBC")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at silent=TRUE
- requete at open=TRUE
+ # bilanjournalier et bilanmensuel
+ supprime(bil)
# progress bar
# OLD CODE = problems to pass Rcheck
# progres<-utils::winProgressBar(title = get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.3,
@@ -67,9 +64,10 @@
# width = 400)
mygtkProgressBar(title=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.3,
- progress_text=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.4)
+ progress_text=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.4)
- for (i in 1:nrow(t_bilanmigrationjournalier_bjo)) {
+ for (i in 1:nrow(t_bilanmigrationjournalier_bjo)) {
+
zz=i/nrow(t_bilanmigrationjournalier_bjo)
progress_bar$setFraction(zz)
progress_bar$setText(sprintf("%d%% progression",round(100*zz)))
@@ -79,18 +77,23 @@
# zz,
# title=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.5,
# label=sprintf("%d%% progression",
-# round(100*zz)))
+# round(100*zz)))
+ # leaving requete at open outside the loop leads to problem ?
+ requete=new("RequeteODBC")
+ requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ requete at silent=TRUE
requete at sql=paste( "INSERT INTO ",get("sch",envir=envir_stacomi),"t_bilanmigrationjournalier_bjo (",
"bjo_dis_identifiant,bjo_tax_code,bjo_std_code,bjo_annee,bjo_jour,bjo_valeur,bjo_labelquantite,bjo_horodateexport,bjo_org_code)",
" VALUES " ,"('",paste(t_bilanmigrationjournalier_bjo[i,],collapse="','"),"');",sep="")
- invisible(requete<-stacomirtools::connect(requete))
+ # to avoid printing character use of invisible (capture_output(
+ invisible(capture_output(stacomirtools::connect(requete)))
} # end for
if (!silent){
- funout(paste(get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.5,"\n"))
+ funout(paste(get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.5,"\n"))
}
# si l'utilisateur accepte de remplacer les valeurs
- odbcClose(requete at connection)
+
progres<-get("progres",envir=envir_stacomi)
gtkWidgetDestroy(progres)
# ecriture egalement du bilan mensuel
@@ -105,10 +108,10 @@
if (nrow(bil at data)>0)
{
if (!silent){
- choice<-gWidgets::gconfirm(paste(get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.1, # Un bilan a deja ete ecrit dans la base
- unique(bil at data$bjo_horodateexport),
- get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.2),
- handler=hconfirm) # voulez vous le remplacer ?
+ choice<-gWidgets::gconfirm(paste(get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.1, # Un bilan a deja ete ecrit dans la base
+ unique(bil at data$bjo_horodateexport),
+ get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.2),
+ handler=hconfirm) # voulez vous le remplacer ?
} else {
hconfirm(h=NULL)
}
@@ -116,13 +119,10 @@
}
else # sinon on ecrit les resultats quoiqu'il arrive
{
- requete=new("RequeteODBC")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at silent=TRUE
- requete at open=TRUE
+
mygtkProgressBar(title=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.3,
progress_text=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.4)
-
+
# progres<-utils::winProgressBar(title = get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.5,
# label = "progression %",
# min = 0,
@@ -136,16 +136,18 @@
# title=get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.5,
# label=sprintf("%d%% progression",
# round(100*zz)))
- progress_bar$setFraction(zz)
- progress_bar$setText(sprintf("%d%% progression",round(100*zz)))
- RGtk2::gtkMainIterationDo(FALSE)
+ progress_bar$setFraction(zz)
+ progress_bar$setText(sprintf("%d%% progression",round(100*zz)))
+ RGtk2::gtkMainIterationDo(FALSE)
+ requete=new("RequeteODBC")
+ requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ requete at silent=TRUE
requete at sql=paste( "INSERT INTO ",get("sch",envir=envir_stacomi),"t_bilanmigrationjournalier_bjo (",
"bjo_dis_identifiant,bjo_tax_code,bjo_std_code,bjo_annee,bjo_jour,bjo_valeur,bjo_labelquantite,bjo_horodateexport,bjo_org_code)",
" VALUES " ,
"('",paste(t_bilanmigrationjournalier_bjo[i,],collapse="','"),"');",sep="")
- invisible(requete<-stacomirtools::connect(requete))
+ invisible(capture_output(stacomirtools::connect(requete)))
} # end for
- RODBC::odbcClose(requete at connection)
if (!silent) funout(paste(get("msg",envir=envir_stacomi)$fn_EcritBilanJournalier.5,"\n"))
taxon= as.character(bilanMigration at taxons@data$tax_nom_latin)
stade= as.character(bilanMigration at stades@data$std_libelle)
Modified: pkg/stacomir/R/fn_EcritBilanMensuel.r
===================================================================
--- pkg/stacomir/R/fn_EcritBilanMensuel.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/fn_EcritBilanMensuel.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -25,18 +25,19 @@
)
# la requete pour la suppression
- requete=new("RequeteODBC")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at open<-TRUE # on laisse la base ouverte
+
+
# ecriture dans la base...
+
for (i in 1:nrow(t_bilanmigrationmensuel_bme)) {
+ requete=new("RequeteODBC")
+ requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
requete at sql=paste("INSERT INTO ",get("sch",envir=envir_stacomi),"t_bilanMigrationMensuel_bme (",
"bme_dis_identifiant,bme_tax_code,bme_std_code,bme_annee,bme_labelquantite,bme_valeur,bme_mois,bme_horodateexport,bme_org_code)",
" VALUES ('",paste(t_bilanmigrationmensuel_bme[i,],collapse="','"),"');",sep="")
- invisible(requete<-stacomirtools::connect(requete))
+ invisible(capture_output(stacomirtools::connect(requete)))
} # end for
- odbcClose(requete at connection)
if (!silent) funout(paste(get("msg",envir=envir_stacomi)$fn_EcritBilanMensuel.1,"\n"))
} # end function
Modified: pkg/stacomir/R/funtable.r
===================================================================
--- pkg/stacomir/R/funtable.r 2016-09-10 12:52:26 UTC (rev 205)
+++ pkg/stacomir/R/funtable.r 2016-09-11 18:27:39 UTC (rev 206)
@@ -12,9 +12,10 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funtable=function(tableau,time.sequence,taxon,stade,DC,resum,silent){
annee=unique(strftime(as.POSIXlt(time.sequence),"%Y"))
+ tableau$debut_pas<-as.character(tableau$debut_pas)
path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste(DC,"_",taxon,"_",stade,"_",annee,".csv",sep=""),fsep ="/")
write.table(tableau,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
- funout(paste(get("msg",envir=envir_stacomi)$funtable.1,path1,"\n"))
+ if (!silent) funout(paste(get("msg",envir=envir_stacomi)$funtable.1,path1,"\n"))
path1html=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste(DC,"_",taxon,"_",stade,"_",annee,".html",sep=""),fsep ="/")
funhtml(data=tableau,
caption=paste(DC,"_",taxon,"_",stade,"_",annee,".csv",sep=""),
@@ -28,7 +29,10 @@
if( !is.null(resum) )
{
path2=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("res",annee,".csv",sep=""),fsep ="/")
+ # warning that it is appending column name to file
+ options(warn = 2)
write.table(resum,path2,row.names=TRUE,col.names=TRUE,sep=";",append=TRUE)
+ options(warn = 0)
path2html=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste("res",annee,".html",sep=""),fsep ="/")
if (!silent) funout(paste(get("msg",envir=envir_stacomi)$funtable.1,path2,"\n"))
funhtml(data=resum,
@@ -40,9 +44,7 @@
digits=2
)
if (!silent) funout(paste(get("msg",envir=envir_stacomi)$funtable.1,path2html,"\n"))
- rm(path1,path1html,path2,path2html)
}
-# setwd(wd)
}
Modified: pkg/stacomir/R/interface_BilanMigration.r
===================================================================
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 206
More information about the Stacomir-commits
mailing list