[Stacomir-commits] r156 - in branch0.5: stacomir stacomir/R stacomir/data stacomir/examples stacomir/examples/01_BilanMigrationMult stacomir/inst stacomir/inst/config stacomir/man stacomirtools/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 18 12:35:31 CEST 2016
Author: briand
Date: 2016-08-18 12:35:31 +0200 (Thu, 18 Aug 2016)
New Revision: 156
Added:
branch0.5/stacomir/R/stacomi.r
branch0.5/stacomir/examples/
branch0.5/stacomir/examples/01_BilanMigrationMult/
branch0.5/stacomir/examples/01_BilanMigrationMult/Readme.md
branch0.5/stacomir/examples/01_BilanMigrationMult/bilanMigrationMult_Arzal.R
branch0.5/stacomir/inst/config/stacomi_manual_launch.r
branch0.5/stacomir/man/bMM_Arzal.Rd
branch0.5/stacomir/man/charge-BilanFonctionnementDC-method.Rd
branch0.5/stacomir/man/connect-BilanFonctionnementDC-method.Rd
branch0.5/stacomir/man/funbarchartDC.Rd
branch0.5/stacomir/man/funtableDC.Rd
Removed:
branch0.5/stacomir/R/interface_graphique.r
branch0.5/stacomir/inst/config/stacomi.r
branch0.5/stacomir/inst/stacomir-package.R
Modified:
branch0.5/stacomir/DESCRIPTION
branch0.5/stacomir/NAMESPACE
branch0.5/stacomir/R/BilanFonctionnementDC.r
branch0.5/stacomir/R/BilanFonctionnementDF.r
branch0.5/stacomir/R/BilanMigrationMult.r
branch0.5/stacomir/R/data.r
branch0.5/stacomir/R/fungraph_civelle.r
branch0.5/stacomir/data/bMM_Arzal.rda
branch0.5/stacomir/inst/config/generate_Roxygen2.R
branch0.5/stacomir/inst/config/libraries.r
branch0.5/stacomir/man/BilanConditionEnv-class.Rd
branch0.5/stacomir/man/BilanEspeces-class.Rd
branch0.5/stacomir/man/BilanFonctionnementDC-class.Rd
branch0.5/stacomir/man/BilanFonctionnementDF-class.Rd
branch0.5/stacomir/man/BilanMigration-class.Rd
branch0.5/stacomir/man/BilanMigrationConditionEnv-class.Rd
branch0.5/stacomir/man/BilanMigrationMult-class.Rd
branch0.5/stacomir/man/BilanMigrationPar-class.Rd
branch0.5/stacomir/man/Bilan_carlot-class.Rd
branch0.5/stacomir/man/Bilan_poids_moyen-class.Rd
branch0.5/stacomir/man/Bilan_taille-class.Rd
branch0.5/stacomir/man/PasDeTemps-class.Rd
branch0.5/stacomir/man/charge-BilanFonctionnementDF-method.Rd
branch0.5/stacomir/man/funboxDC.Rd
branch0.5/stacomirtools/R/ConnectionODBC.r
Log:
Modified: branch0.5/stacomir/DESCRIPTION
===================================================================
--- branch0.5/stacomir/DESCRIPTION 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/DESCRIPTION 2016-08-18 10:35:31 UTC (rev 156)
@@ -2,15 +2,12 @@
Version: 0.5.0
Date: 2016-09-01
Title: STACOMI migration control
-Authors at R: c(person("Cedric", "Briand", role = c("aut", "cre"),
- email = "cedric.briand at eptb-vilaine.fr"),
- person("Marion", "Legrand", role = "aut"),
- email="tableau-salt-loire at logrami.fr"))
-Author: Cedric Briand [aut, cre],
- Marion Legrand [aut]
-Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
-Description: Graphical outputs and treatment for a database of fishway monitoring. It is a part of the STACOMI project developed in France by the ONEMA
- institute to centralize data obtained by fishway monitoring. Version 0.4.1 is available in French English and Spanish. \url{http://w3.eptb-vilaine.fr:8080/tracstacomi}
+Authors at R: c(person("Cedric", "Briand", role = c("aut", "cre"), email = "cedric.briand at eptb-vilaine.fr"),
+ person("Marion", "Legrand", role = "aut", email="tableau-salt-loire at logrami.fr"))
+Description: Graphical outputs and treatment for a database of fishway
+ monitoring. It is a part of the STACOMI project developed in France by the ONEMA
+ institute to centralize data obtained by fishway monitoring. Version 0.4.1 is
+ available in French English and Spanish.
License: GPL (>= 2)
Collate:
'utilitaires.r'
@@ -48,6 +45,7 @@
'RefMsg.r'
'RefPoidsMoyenPeche.r'
'Refperiode.r'
+ 'data.r'
'fn_EcritBilanJournalier.r'
'fn_EcritBilanMensuel.r'
'fn_sql_dis.r'
@@ -76,18 +74,32 @@
'interface_bilan_poids_moyen.r'
'interface_chooselang.r'
'interface_graphique.r'
- 'libraries.r'
'messages.r'
'setAs.r'
LazyLoad: yes
-Depends:
+LazyData: true
+Depends:
stacomirtools
-Import:
- RODBC,
- intervals,
- RColorBrewer,
- methods,
- stringr,
- gWidgets,
- gWidgetsRGtk2
+Imports:
+ RODBC,
+ intervals,
+ RColorBrewer,
+ methods,
+ stringr,
+ gWidgets,
+ gWidgetsRGtk2,
+ RPostgreSQL,
+ dplyr,
+ ggplot2,
+ reshape2,
+ sqldf,
+ methods,
+ graphics,
+ utils,
+ stats,
+ lattice
+Author: Cedric Briand [aut, cre],
+ Marion Legrand [aut]
+Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
RoxygenNote: 5.0.1
+NeedsCompilation: no
Modified: branch0.5/stacomir/NAMESPACE
===================================================================
--- branch0.5/stacomir/NAMESPACE 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/NAMESPACE 2016-08-18 10:35:31 UTC (rev 156)
@@ -3,7 +3,9 @@
export(fun_bilanMigrationMult)
export(fun_bilanMigrationMult_Overlaps)
export(fun_weight_conversion)
+export(funbarchartDC)
export(funbarchartDF)
+export(funboxDC)
export(funboxDF)
export(funboxplotBilan_carlot)
export(fundensityBilan_carlot)
@@ -12,6 +14,7 @@
export(funstatJournalier)
export(funtable)
export(funtableBilan_carlot)
+export(funtableDC)
export(funtableDF)
export(funtraitement_poids)
export(hBilanEspecescalc)
@@ -36,9 +39,49 @@
exportMethods(charge)
exportMethods(charge_avec_filtre)
exportMethods(connect)
+exportMethods(createmessage)
exportMethods(cumplot)
exportMethods(load)
exportMethods(plot1)
exportMethods(print)
exportMethods(setRefHorodate)
exportMethods(summary)
+import(RColorBrewer)
+import(RPostgreSQL)
+import(gWidgets)
+import(gWidgetsRGtk2)
+import(ggplot2)
+import(sqldf)
+import(stringr)
+importFrom(RODBC,odbcClose)
+importFrom(grDevices,x11)
+importFrom(graphics,axis)
+importFrom(graphics,axis.Date)
+importFrom(graphics,legend)
+importFrom(graphics,rect)
+importFrom(graphics,text)
+importFrom(grid,gpar)
+importFrom(grid,grid.layout)
+importFrom(grid,grid.newpage)
+importFrom(grid,pushViewport)
+importFrom(grid,viewport)
+importFrom(intervals,"closed<-")
+importFrom(intervals,Intervals)
+importFrom(intervals,interval_overlap)
+importFrom(lattice,barchart)
+importFrom(lattice,simpleKey)
+importFrom(lattice,trellis.par.get)
+importFrom(lattice,trellis.par.set)
+importFrom(methods,"slot<-")
+importFrom(methods,as)
+importFrom(methods,new)
+importFrom(methods,slot)
+importFrom(reshape2,dcast)
+importFrom(reshape2,melt)
+importFrom(stats,ftable)
+importFrom(stats,xtabs)
+importFrom(utils,globalVariables)
+importFrom(utils,read.csv)
+importFrom(utils,setWinProgressBar)
+importFrom(utils,stack)
+importFrom(utils,winProgressBar)
Modified: branch0.5/stacomir/R/BilanFonctionnementDC.r
===================================================================
--- branch0.5/stacomir/R/BilanFonctionnementDC.r 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/R/BilanFonctionnementDC.r 2016-08-18 10:35:31 UTC (rev 156)
@@ -6,9 +6,6 @@
#' class allows to draw graphics allowing an overview of the device operation
#'
#'
-#' @name BilanFonctionnementDC-class
-#' @aliases BilanFonctionnementDC-class BilanFonctionnementDC
-
#' @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}
@@ -40,7 +37,15 @@
requete=new("RequeteODBCwheredate"))
)
-# Methode pour donner les attributs de la classe RequeteODBCwheredate correspondant � l'object fonctionnement DC
+
+
+
+#' connect method for BilanFonctionnementDC
+#'
+#' loads the working periods and type of arrest or disfunction of the DC
+#' @return An object of class \ref{BilanFonctionnementDC}
+#'
+#' @author cedric.briand
setMethod("connect",signature=signature("BilanFonctionnementDC"),definition=function(object,h) {
# construit une requete ODBCwheredate
object at requete@baseODBC<-get("baseODBC",envir=envir_stacomi)
@@ -64,6 +69,13 @@
return(object)
})
+#' charge method for BilanFonctionnementDC
+#'
+#' used by the graphical interface to retreive the objects of Referential classes
+#' assigned to envir_stacomi
+#' @return An object of class \code{BilanFonctionnementDC}
+#'
+#' @author cedric.briand
setMethod("charge",signature=signature("BilanFonctionnementDC"),definition=function(object,h) {
# construit une requete ODBCwheredate
# chargement des donnees dans l'environnement de la fonction
@@ -89,6 +101,13 @@
# Methode permettant l'affichage d'un graphique en lattice (barchart) du fonctionnement mensuel du dispositif
# Compte tenu de la structure des donnees ce n'est pas si simple...
+#' Function to create a barchart (lattice) corresponding to the periods
+#' @param h A handler
+#' @param ...
+#' @return assigns the data frame \code{periodeDC} allowing to build the lattice graph in the environment envir_stacomi
+#'
+#' @author cedric.briand
+#' @export
funbarchartDC = function(h,...) {
fonctionnementDC=charge(fonctionnementDC)
@@ -152,6 +171,13 @@
funout(get("msg",envir_stacomi)$BilanFonctionnementDC.8)
}
+
+#' function used for some lattice graph
+#'
+#' @param h A handler
+#' @param ...
+#' @export
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
funboxDC = function(h,...) {
fonctionnementDC=charge(fonctionnementDC)
@@ -166,20 +192,6 @@
#display.brewer.all()
mypalette1<-c("#1B9E77","#AE017E","orange", RColorBrewer::brewer.pal(12,"Paired"))
-
-
-
-
-
-
-#' function used for some lattice graphes with dates
-#'
-#' function used for some lattice graphes with dates
-#'
-#'
-#' @param vectordate date or POSIXt
-#' @return vectordate (without class)
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
graphdate<-function(vectordate){
attributes(vectordate)<-NULL
unclass(vectordate)
@@ -280,7 +292,13 @@
graphics::text(x=debut,y=0.45, label=get("msg",envir_stacomi)$BilanFonctionnementDC.13, font=4,pos=4)
}
}
-#
+
+
+
+#' FuntableDC create a table output for BilanFonctionnementDC class
+#' @param h a handler
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
funtableDC = function(h,...) {
fonctionnementDC=charge(fonctionnementDC)
Modified: branch0.5/stacomir/R/BilanFonctionnementDF.r
===================================================================
--- branch0.5/stacomir/R/BilanFonctionnementDF.r 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/R/BilanFonctionnementDF.r 2016-08-18 10:35:31 UTC (rev 156)
@@ -71,7 +71,7 @@
#'
#' used by the graphical interface to retreive the objects of Referential classes
#' assigned to envir_stacomi
-#' @return An object of class \ref{BilanFonctionnementDF}
+#' @return An object of class \code{BilanFonctionnementDF}
#'
#' @author cedric.briand
setMethod("charge",signature=signature("BilanFonctionnementDF"),definition=function(object,h) {
Modified: branch0.5/stacomir/R/BilanMigrationMult.r
===================================================================
--- branch0.5/stacomir/R/BilanMigrationMult.r 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/R/BilanMigrationMult.r 2016-08-18 10:35:31 UTC (rev 156)
@@ -25,11 +25,8 @@
#' @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.
-#' @examples
-#'
-#' showClass("BilanMigrationMult")
-#' bilanMigration= new("BilanMigrationMult")
#' @export
+#' @example examples/01_BilanMigrationMult/bilanMigrationMult_Arzal.R
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
setClass(Class="BilanMigrationMult",
representation=
@@ -456,7 +453,7 @@
grdata<-rbind(grdata,data)
}
names(grdata)<-tolower(names(grdata))
- grdata<-sqldf("select sum(effectif_total) as effectif_total,
+ grdata<-sqldf::sqldf("select sum(effectif_total) as effectif_total,
\"no.pas\",
debut_pas
from grdata
@@ -697,9 +694,9 @@
rownames(mat1)<-as.character(time.sequence)
rownames(mat2)<-datasub$lot_identifiant
imat1<-intervals::Intervals(mat1)
- interval::closed(imat1)<-c(FALSE,FALSE)
+ intervals::closed(imat1)<-c(FALSE,FALSE)
imat2<-intervals::Intervals(mat2)
- interval::closed(imat2)<-c(FALSE,FALSE)
+ intervals::closed(imat2)<-c(FALSE,FALSE)
listei<-intervals::interval_overlap(imat2,imat1)
listei2<-listei # copie de la liste pour l'écraser
for (i in 1:length(listei)){
@@ -744,7 +741,7 @@
# ci dessous pour faire du group by c'est quand même bien de passer par sqldf
datasub1$value<-as.numeric(datasub1$value) # sinon arrondis à des entiers
if (negative){
- datasub2<-sqldf("SELECT debut_pas,
+ datasub2<-sqldf::sqldf("SELECT debut_pas,
fin_pas,
sum(value*coef) as value,
type_de_quantite,
@@ -771,7 +768,7 @@
ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite"
)
} else {
- datasub2<-sqldf("SELECT debut_pas,
+ datasub2<-sqldf::sqldf("SELECT debut_pas,
fin_pas,
sum(value*coef) as value,
type_de_quantite,
@@ -784,7 +781,7 @@
ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite ")
}
stopifnot(all.equal(sum(datasub$value,na.rm=TRUE),sum(datasub2$value,na.rm=TRUE)))
- datasub3<-dplyr::dcast(datasub2, debut_pas+fin_pas+ope_dic_identifiant+lot_tax_code+lot_std_code+type_de_quantite~lot_methode_obtention,value.var="value")
+ datasub3<-reshape2::dcast(datasub2, debut_pas+fin_pas+ope_dic_identifiant+lot_tax_code+lot_std_code+type_de_quantite~lot_methode_obtention,value.var="value")
if (!"MESURE"%in%colnames(datasub3)) datasub3$MESURE=0
if (!"CALCULE"%in%colnames(datasub3)) datasub3$CALCULE=0
if (!"EXPERT"%in%colnames(datasub3)) datasub3$EXPERT=0
@@ -821,7 +818,7 @@
datasub1<-merge(df.ts,datasub,by="ts_id")
# ci dessous pour faire du group by c'est quand même bien de passer par sqldf
if (negative){
- datasub2<-sqldf("SELECT debut_pas,
+ datasub2<-sqldf::sqldf("SELECT debut_pas,
fin_pas,
sum(value) as value,
type_de_quantite,
@@ -847,7 +844,7 @@
GROUP BY ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite
ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite ")
} else {
- datasub2<-sqldf("SELECT debut_pas,
+ datasub2<-sqldf::sqldf("SELECT debut_pas,
fin_pas,
sum(value) as value,
type_de_quantite,
@@ -860,7 +857,7 @@
ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite")
}
stopifnot(all.equal(sum(datasub$value,na.rm=TRUE),sum(datasub2$value,na.rm=TRUE)))
- datasub3<-dcast(datasub2, debut_pas+fin_pas+ope_dic_identifiant+lot_tax_code+lot_std_code+type_de_quantite~lot_methode_obtention,value.var="value")
+ datasub3<-reshape2::dcast(datasub2, debut_pas+fin_pas+ope_dic_identifiant+lot_tax_code+lot_std_code+type_de_quantite~lot_methode_obtention,value.var="value")
if (!"MESURE"%in%colnames(datasub3)) datasub3$MESURE=0
if (!"CALCULE"%in%colnames(datasub3)) datasub3$CALCULE=0
if (!"EXPERT"%in%colnames(datasub3)) datasub3$EXPERT=0
Modified: branch0.5/stacomir/R/data.r
===================================================================
--- branch0.5/stacomir/R/data.r 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/R/data.r 2016-08-18 10:35:31 UTC (rev 156)
@@ -1,5 +1,5 @@
#' An object of class bilanMigrationMult with data loaded
-#'
+#'
#' This data corresponds to the data collected from three fishways
#' and correspond to the migration station at Arzal in 2011 for all
#' stages of eel (Anguilla anguilla)
@@ -19,22 +19,14 @@
#' \item{lot_tax_code}{species id}
#' \item{lot_std_code}{stage id}
#' \item{value}{the value}
-#' \item{type_de_quantite}{either effectif (number) or poids (weights)}
-#' \item{lot_dev_code}{destination of the fishes}
-#' \item{lot_methode_obtention}{method of data collection, measured, calculated...}
-#' }
-#' }
+#' \item{type_de_quantite}{either effectif (number) or poids (weights)}
+#' \item{lot_dev_code}{destination of the fishes}
+#' \item{lot_methode_obtention}{method of data collection, measured, calculated...}
+#' }
+#' }
#' \item{calcdata}{slot to be filled with the calcule method}
#' \item{coef_conversion} {A data frame with 364 observations with daily coefficients to convert from weight to numbers}
#' \item{time.sequence} {A time sequence generated for the bilan, used internally by the object}
-#'
-#' ...
#' }
-#' the \code{PasDeTempsJournalier} calculated for all 2011}
-
-#'
-#'
-#'
-#' }
-#'
+#' @keywords data
"bMM_Arzal"
\ No newline at end of file
Modified: branch0.5/stacomir/R/fungraph_civelle.r
===================================================================
--- branch0.5/stacomir/R/fungraph_civelle.r 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/R/fungraph_civelle.r 2016-08-18 10:35:31 UTC (rev 156)
@@ -394,35 +394,35 @@
cbind(effmois.p,"type"="1","mois"=1:12))
- superpose.polygon<-trellis.par.get("superpose.polygon")
+ superpose.polygon<-lattice::trellis.par.get("superpose.polygon")
superpose.polygon$col= mypalette[c(10,8)]
superpose.polygon$border=FALSE
- trellis.par.set("superpose.polygon",superpose.polygon)
- fontsize<-trellis.par.get("fontsize")
+ lattice::trellis.par.set("superpose.polygon",superpose.polygon)
+ fontsize<-lattice::trellis.par.get("fontsize")
fontsize$text=10
- trellis.par.set("fontsize",fontsize)
- par.main.text<-trellis.par.get("par.main.text")
+ lattice::trellis.par.set("fontsize",fontsize)
+ par.main.text<-lattice::trellis.par.get("par.main.text")
par.main.text$cex=1
par.main.text$font=1
- trellis.par.set("par.main.text",par.main.text)
+ lattice::trellis.par.set("par.main.text",par.main.text)
- par.ylab.text<-trellis.par.get("par.ylab.text")
+ par.ylab.text<-lattice::trellis.par.get("par.ylab.text")
par.ylab.text$cex=0.8
- trellis.par.set("par.ylab.text",par.ylab.text)
- par.xlab.text<-trellis.par.get("par.xlab.text")
+ lattice::trellis.par.set("par.ylab.text",par.ylab.text)
+ par.xlab.text<-lattice::trellis.par.get("par.xlab.text")
par.xlab.text$cex=0.8
- trellis.par.set("par.xlab.text",par.xlab.text)
+ lattice::trellis.par.set("par.xlab.text",par.xlab.text)
- bar<-barchart(eff/1000~as.factor(mois),
+ bar<-lattice::barchart(eff/1000~as.factor(mois),
groups=as.factor(type),
xlab=get("msg",envir=envir_stacomi)$fungraph_civelle.14,
ylab=get("msg",envir=envir_stacomi)$fungraph_civelle.15,
# main=list(label=paste("Donnees mensuelles")),
data=tablemens,
allow.multiple=FALSE,
- key=simpleKey(text=get("msg",envir=envir_stacomi)$fungraph_civelle.16,
+ key=lattice::simpleKey(text=get("msg",envir=envir_stacomi)$fungraph_civelle.16,
rectangles = TRUE,
points=FALSE,
x=0.70,
Deleted: branch0.5/stacomir/R/interface_graphique.r
===================================================================
--- branch0.5/stacomir/R/interface_graphique.r 2016-08-18 07:17:41 UTC (rev 155)
+++ branch0.5/stacomir/R/interface_graphique.r 2016-08-18 10:35:31 UTC (rev 156)
@@ -1,386 +0,0 @@
-#' handler function used by the main interface
-#'
-#'
-#' @param h A handler
-#' @param ... Other parameters
-#' @aliases hDC,hOPE,hDFDC,hBilanMigration,hBilanMigrationInterannuelle,hBilanMigrationConditionEnv, hBilanMigrationPar, hBilanConditionEnv, hBilanLots, hTail, hpds, hSt, htodo, hhelp, h0, hx11
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-hDF=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.1,wash=TRUE)
- eval(interface_BilanFonctionnementDF(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hDC=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.2,wash=TRUE)
- eval(interface_BilanFonctionnementDC(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hOPE=function(h,...){
- # TODO a developper
- funout(text=get("msg",envir_stacomi)$interface_graphique.3,wash=TRUE)
-}
-#' handler function used by the main interface
-hDFDC=function(h,...){
- # TODO developper cette fonction
- funout(get("msg",envir_stacomi)$interface_graphique.4,wash=TRUE)
-}
-#' handler function used by the main interface
-hBilanMigration=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.5,wash=TRUE)
- eval(interface_BilanMigration(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hBilanMigrationMult=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.14,wash=TRUE)
- eval(interface_BilanMigrationMult(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hBilanMigrationInterAnnuelle=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.6,wash=TRUE)
- eval(interface_BilanMigrationInterAnnuelle(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hBilanMigrationConditionEnv=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.7,wash=TRUE)
- eval(interface_BilanMigrationConditionEnv(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hBilanMigrationPar=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.8,wash=TRUE)
- eval(interface_BilanMigrationPar(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hBilanConditionEnv=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.9,wash=TRUE)
- eval(interface_ConditionEnv(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hBilanLots=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.10,wash=TRUE)
- eval(interface_BilanLot(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hTail=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.11,wash=TRUE)
- eval(interface_BilanTaille(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-hpds=function(h,...){
- eval(interface_BilanPoidsMoyen(),envir = .GlobalEnv)
- funout(get("msg",envir_stacomi)$interface_graphique.12,wash=TRUE)
-}
-#' handler function used by the main interface
-hSt=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.13,wash=TRUE)
- eval(interface_Bilan_stades_pigm(),envir = .GlobalEnv)
-}
-#' handler function used by the main interface
-htodo=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.17,wash=TRUE)
-}
-#' handler function used by the main interface
-hBilanEspeces=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.19,wash=TRUE)
- eval(interface_BilanEspeces(),envir = .GlobalEnv)
-}
-#' this handler test the connection and if it works loads the stacomi interface
-#' @note gr_interface is copied by stacomi into envir_stacomi.
-#' @param h
-#' @param ...
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-
-husr=function(h,...){
- baseODBC<-get("baseODBC",envir=envir_stacomi)
- gr_interface<-get("gr_interface",envir_stacomi) # logical true or false
- # test de la connection
- con=new("ConnectionODBC")
- if (gr_interface){
- baseODBC[2]<-svalue(usrname)
- baseODBC[3]<-svalue(usrpwd)
- } else {
- # on prend les valeurs choisies par defaut dans baseODBC
- # rien
- }
- assign("sch",paste(baseODBC[2],".",sep=""),envir=envir_stacomi)
- assign("baseODBC",baseODBC,envir=envir_stacomi)
- con at baseODBC=get("baseODBC",envir=envir_stacomi)
- e=expression(con<-connect(con))
- con=tryCatch(eval(e),error=get("msg",envir=envir_stacomi)$interface_graphique_log.7) #finally=odbcClose(con at connection)clause inutile car si �a plante la connection n'est pas ouverte
- test<-con at etat==get("msg",envir=envir_stacomi)$ConnectionODBC.6
- if (exists("logw")) dispose(logw)
- odbcCloseAll()
- # if the test is OK launches the stacomi interface
- # function handler called by gmessage
- hgmessage=function(h,...){
- stacomi(gr_interface=TRUE)
- # en cas d'erreur on relance une demande de mot de passe
- }
- if (test) { # il existe un lien ODBC mais qui pointe peut �tre ailleurs
- requete=new("RequeteODBC")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at sql="select count(*) from ref.tr_taxon_tax"
- requete=connect(requete)
- if (nrow(requete at query)==0){
- # le lien ODBC fonctionne mais pointe vers la mauvaise base
- gmessage(message=paste(get("msg",envir=envir_stacomi)$interface_graphique_log.8,
- "\n",
- get("msg",envir=envir_stacomi)$interface_graphique_log.9,
- " :",
- baseODBC[1],
- "\n",
- get("msg",envir=envir_stacomi)$interface_graphique_log.2,
- " :",
- baseODBC[2],
- "\n",
- get("msg",envir=envir_stacomi)$interface_graphique_log.3,
- " :",
- baseODBC[3]),
- title=get("msg",envir=envir_stacomi)$interface_graphique_log.5,
- icon = "error",
- handler=hgmessage)
- } else {
- # l'utilisateur peut avoir choisi une autre base que celle qui est dans le fichier xml
- assign("baseODBC",baseODBC,envir=envir_stacomi)
- gr_interface<-get("gr_interface",envir=envir_stacomi)
- if (gr_interface){
- interface_graphique()
- }
- }
- } else {
- gmessage(message=paste(get("msg",envir=envir_stacomi)$interface_graphique_log.6,
- "\n",
- get("msg",envir=envir_stacomi)$interface_graphique_log.9,
- " :",
- baseODBC[1],
- "\n",
- get("msg",envir=envir_stacomi)$interface_graphique_log.2,
- " :",
- baseODBC[2],
- "\n",
- get("msg",envir=envir_stacomi)$interface_graphique_log.3,
- " :",
- baseODBC[3]),
- title=get("msg",envir=envir_stacomi)$interface_graphique_log.5,
- icon = "error",
- handler=hgmessage)
- }
-}
-hhelp=function(h,...){
- funout(get("msg",envir_stacomi)$interface_graphique.14,wash=TRUE)
-}
-hlang=function(h,...){
- eval(interface_chooselang(),envir = .GlobalEnv)
-}
-hx11=function(h,...){
- x11()
-}
-
-
-
-
-
-#' Function that loads the loginwindow, tests connection, and then destroys the
-#' window
-#'
-#' Function that loads the loginwindow, tests connection, and then destroys the
-#' window
-#'
-#' @param gr_interface Will be used to launch the program as graphical
-#' interface or in command line
-#' @import stringr
-#' @importFrom intervals Intervals
-#' @importFrom intervals closed<-
-#' @importFrom intervals interval_overlap
-#' @import RColorBrewer
-#' @import gWidgets
-#' @import gWidgetsRGtk2
-#' @import ggplot2
-#' @importFrom methods as
-#' @importFrom methods new
-#' @importFrom methods slot
-#' @importFrom methods "slot<-"
-#' @importFrom grid viewport
-#' @importFrom grid pushViewport
-#' @importFrom grid grid.newpage
-#' @importFrom grid grid.layout
-#' @importFrom utils winProgressBar
-#' @importFrom utils setWinProgressBar
-#' @importFrom utils read.csv
-#' @importFrom utils stack
-#' @importFrom utils globalVariables
-#' @importFrom RODBC odbcClose
-#' @importFrom stats ftable
-#' @importFrom stats xtabs
-#' @import RPostgreSQL
-#' @import sqldf
-#' @importFrom reshape2 dcast
-#' @importFrom reshape2 melt
-#' @importFrom lattice barchart
-#' @importFrom lattice trellis.par.get
-#' @importFrom lattice trellis.par.set
-#' @importFrom grid gpar
-#' @importFrom grDevices x11
-#' @importFrom graphics axis.Date
-#' @importFrom graphics rect
-#' @importFrom graphics legend
-#' @importFrom graphics text
-#' @importFrom graphics axis
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-stacomi=function(gr_interface=TRUE){
- # first loading of connection and odbc info using chargexml()
- assign("gr_interface",gr_interface,envir=envir_stacomi)
- # the first messages are necessary for the first access to the database, they are in French
- msg<-messages()
- mylinks=chargecsv()
- baseODBC=mylinks[["baseODBC"]]
- datawd=mylinks[["datawd"]]
- lang=mylinks[["lang"]]
- sqldf.options=mylinks[["sqldf.options"]]
- assign("lang",lang,envir=envir_stacomi)
- assign("baseODBC",baseODBC,envir=envir_stacomi)
- assign("datawd",datawd,envir=envir_stacomi)
- assign("sqldf.options",sqldf.options,envir=envir_stacomi)
- refMsg=new("RefMsg")
- createmessage(refMsg)
-
- msg=get("msg",envir=envir_stacomi)
- #libraries()
- options(sqldf.RPostgreSQL.user = sqldf.options["sqldf.uid"],
- sqldf.RPostgreSQL.password =sqldf.options["sqldf.pwd"],
- sqldf.RPostgreSQL.dbname = sqldf.options["sqldf.dbname"],
- sqldf.RPostgreSQL.host = sqldf.options["sqldf.host"],# 1.100.1.6
- sqldf.RPostgreSQL.port = sqldf.options["sqldf.port"])
- # loginWindow, will call the husr handler
- if (gr_interface){
- logw <- gwindow(msg$interface_graphique_log.1,
- name="log",
- parent=c(0,0),
- width=100,height=100)
- assign("logw",logw,envir=.GlobalEnv)
- logly=glayout(container=logw)
- usrname<- gedit(text = baseODBC[2],
- width = 10,
- container = logly)
- assign("usrname",usrname,.GlobalEnv)
- usrpwd<- gedit(text = baseODBC[3],
- width = 10,
- container = logly)
- assign("usrpwd",usrpwd,.GlobalEnv)
- but=gbutton(text = msg$interface_graphique_log.4,
- border=TRUE,
- handler = husr,
- container = logly)
- logly[1,1]<-msg$interface_graphique_log.2
- logly[2,1]<-msg$interface_graphique_log.3
- logly[1,2]<-usrname
- logly[2,2]<-usrpwd
- logly[3,2]<-but
- } else {
-
-
- husr(gr_interface=FALSE)
- }
-}
-
-
-
-
-
-
-
-#' Program launch, this function first gathers the ODBC path from the csv file
-#'
-#' Program launch, this function fist gathers the ODBC path and working
-#' directory from the csv file and then launches the GwidgetRgtk graphical
-#' interface to stacomi.
-#'
-#'
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-interface_graphique=function(){
- msg=get("msg",envir=envir_stacomi) # appel dans chaque sous fonction
- if (exists("graphes")) rm(list=c("graphes"),envir=.GlobalEnv)
- if (exists("ggroupboutonsbas")) rm(list=c("ggroupboutonsbas"),envir=.GlobalEnv)
- if (exists("group")) rm(list=c("group"),envir=.GlobalEnv)
- if (!file.exists(path.expand(get("datawd",envir=envir_stacomi)))) {
- dir.create(path.expand(get("datawd",envir=envir_stacomi)))
- }
-
- col.sortie=rep(c("pink","purple","red","orange","green","blue","cyan","magenta"),20) # couleurs pour le texte
- assign("col.sortie",col.sortie,.GlobalEnv)
- nbligne=0
- assign("nbligne",nbligne,.GlobalEnv)
-
- library(gWidgets)
- win <- gwindow(msg$interface_graphique.16, name="main",parent=c(0,0),width=100,height=100)
- assign("win",win,envir=.GlobalEnv)
-
- ## Menubar is defined by a list
- menubarlist = list()
-
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.1]]$handler =hDF
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.1]]$icon="gWidgetsRGtk2-rarrow"
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.2]]$handler =hDC
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.2]]$icon = "gtk-media-record"
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.3]]$handler=hOPE
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.3]]$icon="gtk-cancel"#"gtk-go-forward"
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.4]]$handler=hDFDC
- menubarlist[[msg$interface_graphique_menu.1]][[msg$interface_graphique_menu.1.4]]$icon="gtk-cancel"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.1]]$handler=hBilanMigration
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.1]]$icon="gWidgetsRGtk2-curve"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.2]]$handler=hBilanConditionEnv
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.2]]$icon="gWidgetsRGtk2-curve"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.3]]$handler=hBilanMigrationConditionEnv
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.3]]$icon="gWidgetsRGtk2-curve"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.4]]$handler=hBilanMigrationPar
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.4]]$icon="gWidgetsRGtk2-curve"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.5]]$handler=hBilanMigrationInterAnnuelle
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.5]]$icon="gWidgetsRGtk2-curve"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.6]]$handler=hBilanLots
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.6]]$icon="gWidgetsRGtk2-newplot"#"gWidgetsRGtk2-logical"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.7]]$handler=hpds
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.7]]$icon="gWidgetsRGtk2-evaluate"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.8]]$handler=hTail
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.8]]$icon="gWidgetsRGtk2-evaluate"#"gWidgetsRGtk2-boxplot"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.13]]$icon="gWidgetsRGtk2-curve"#"gWidgetsRGtk2-boxplot"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.13]]$handler=hBilanEspeces
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.9]]$handler=hSt
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.9]]$icon="gWidgetsRGtk2-contour"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.10]]$handler=htodo
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.10]]$icon="gtk-cancel"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.11]]$handler=htodo
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.11]]$icon="gtk-cancel"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.12]]$handler=htodo
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.12]]$icon="gtk-cancel"
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.14]]$handler=hBilanMigrationMult
- menubarlist[[msg$interface_graphique_menu.2]][[msg$interface_graphique_menu.2.14]]$icon="gWidgetsRGtk2-curve"
- menubarlist[[msg$interface_graphique_menu.3]]$About$handler = hx11
- menubarlist[[msg$interface_graphique_menu.3]]$About$icon="newplot"
- menubarlist[[msg$interface_graphique_menu.3]]$About$handler = hhelp
- menubarlist[[msg$interface_graphique_menu.3]]$About$icon="dialog-info"
- menubarlist[[msg$interface_graphique_menu.3]]$lang$handler = hlang
- menubarlist[[msg$interface_graphique_menu.3]]$lang$icon="dialog-info"
- add(win, gmenu(menubarlist))
- ggrouptotal<- ggroup(horizontal=FALSE) # celui ci empile les autres de haut en bas
- # gsortie est au dessus de la fenêtre
- assign("ggrouptotal",ggrouptotal,envir=.GlobalEnv)
-
- add(win,ggrouptotal)
-
- gSortie=gtext(msg$interface_graphique.18,width =100 , height = 100,font.attr=list(style="italic", col="blue",family="monospace",sizes="medium"))
- assign("gSortie",gSortie,envir=.GlobalEnv)
-
- add(ggrouptotal, gSortie, expand=FALSE)
-# un groupe en dessous mais cette fois horizontal
- ggrouptotal1<- ggroup(horizontal=TRUE)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 156
More information about the Stacomir-commits
mailing list