[Stacomir-commits] r334 - in pkg/stacomir: . R R/po inst/examples inst/po/fr/LC_MESSAGES man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 3 17:49:09 CEST 2017
Author: briand
Date: 2017-04-03 17:49:09 +0200 (Mon, 03 Apr 2017)
New Revision: 334
Added:
pkg/stacomir/R/BilanMigrationMultConditionEnv.r
pkg/stacomir/R/interface_BilanMigrationMultConditionEnv.r
pkg/stacomir/inst/examples/bilanMigrationMultConditionEnv_example.R
Removed:
pkg/stacomir/R/BilanMigrationConditionEnv.r
pkg/stacomir/R/fungraph_env.r
pkg/stacomir/R/interface_BilanMigrationConditionEnv.r
Modified:
pkg/stacomir/NAMESPACE
pkg/stacomir/R/BilanAgedemer.r
pkg/stacomir/R/BilanAnnuels.r
pkg/stacomir/R/BilanConditionEnv.r
pkg/stacomir/R/po/R-stacomiR.pot
pkg/stacomir/R/po/R-stacomiR_fr_FR.mo
pkg/stacomir/R/po/R-stacomiR_fr_FR.po
pkg/stacomir/inst/po/fr/LC_MESSAGES/R-stacomiR.mo
pkg/stacomir/man/BilanAgedemer-class.Rd
Log:
Modified: pkg/stacomir/NAMESPACE
===================================================================
--- pkg/stacomir/NAMESPACE 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/NAMESPACE 2017-04-03 15:49:09 UTC (rev 334)
@@ -10,11 +10,9 @@
export(fundat)
export(fundensityBilan_carlot)
export(funout)
-export(funplotBilanAgedemer)
export(funplotBilanArgentee)
export(funpointBilan_carlot)
export(funstat)
-export(funtableBilanAgedemer)
export(funtableBilanArgentee)
export(funtableBilan_carlot)
export(funtraitement_poids)
Modified: pkg/stacomir/R/BilanAgedemer.r
===================================================================
--- pkg/stacomir/R/BilanAgedemer.r 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/R/BilanAgedemer.r 2017-04-03 15:49:09 UTC (rev 334)
@@ -34,6 +34,7 @@
#' @family Bilan Objects
#' @keywords classes
#' @example inst/examples/bilanAgedemer_example.R
+#' @aliases BilanAgedemer bilA bilanagedemer bilanAgedeMer BilanAgeDeMer bilan_adm
#' @export
setClass(Class="BilanAgedemer",
representation= representation(
@@ -210,6 +211,7 @@
#' @param object An object of class \code{\link{BilanAgedemer-class}}
#' @param silent Boolean, if TRUE, information messages are not displayed, only warnings and errors
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
setMethod("calcule",signature=signature("BilanAgedemer"),definition=function(object,silent) {
#bilan_adm<-b_carlot
bilan_adm<-object
@@ -441,7 +443,6 @@
#' @param h A handler, with action 1,2,3 or 4
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @export
funplotBilanAgedemer = function(h,...) {
bilan_adm<-get(x="bilan_adm",envir=envir_stacomi)
bilan_adm<-charge(bilan_adm)
@@ -459,7 +460,6 @@
#' @param h hanlder passed by the graphical interface
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @export
funtableBilanAgedemer = function(h,...) {
bilan_adm=charge(bilan_adm)
bilan_adm<-connect(bilan_adm)
Modified: pkg/stacomir/R/BilanAnnuels.r
===================================================================
--- pkg/stacomir/R/BilanAnnuels.r 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/R/BilanAnnuels.r 2017-04-03 15:49:09 UTC (rev 334)
@@ -332,7 +332,7 @@
#' @param legend.text See barplot help
#' @param ... additional arguments passed to barplot
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @aliases barplot.BilanAnnuels barplot.bilA
+#' @aliases barplot.BilanAnnuels barplot.bilA barplot
#' @seealso \link{BilanAnnuels-class} for examples
#' @export
setMethod("barplot",signature(height = "BilanAnnuels"),definition=function(height,legend.text=NULL,...){
Modified: pkg/stacomir/R/BilanConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanConditionEnv.r 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/R/BilanConditionEnv.r 2017-04-03 15:49:09 UTC (rev 334)
@@ -13,10 +13,6 @@
#' @slot data \code{data.frame}
#' @slot datedebut A \link[base]{-.POSIXt} value
#' @slot datefin A \link[base]{-.POSIXt} value
-#' @section Objects from the Class: Objects can be created by calls of the form
-#' \code{new("BilanConditionEnv", horodate=new("Horodate"),
-#' stationMesure=new("RefStationMesure"), data=data.frame(),
-#' requete=new("RequeteODBCwheredate"))}.
#' @author cedric.briand"at"eptb-vilaine.fr
#' @family Bilan Objects
#' @keywords classes
@@ -41,10 +37,11 @@
#' connect method for BilanConditionEnv class
#' @param object An object of class \link{BilanConditionEnv-class}
+#' @param silent Default FALSE, if TRUE the program should no display messages
#' @return an object of BilanConditionEnv class
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("connect",signature=signature("BilanConditionEnv"),definition=function(object) {
+setMethod("connect",signature=signature("BilanConditionEnv"),definition=function(object,silent=FALSE) {
#object<-bil_CE
requete=new("RequeteODBCwheredate")
requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
@@ -66,7 +63,7 @@
requete at and=paste(" AND env_stm_identifiant IN ",tmp )
requete<-stacomirtools::connect(requete)
object at data<-stacomirtools::killfactor(requete at query)
- funout(gettext("Environmental conditions loading query completed\n",domain="R-stacomiR"))
+ if (!silent) funout(gettext("Environmental conditions loading query completed\n",domain="R-stacomiR"))
return(object)
}
)
@@ -102,10 +99,10 @@
})
#' charge method for BilanCondtionEnv class
#' @param object An object of class \link{BilanConditionEnv-class}
-#' @param h A handler
+#' @param silent Default FALSE, if TRUE the program should no display messages
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("charge",signature=signature("BilanConditionEnv"),definition=function(object,h) {
+setMethod("charge",signature=signature("BilanConditionEnv"),definition=function(object,silent) {
if (exists("refStationMesure",envir_stacomi)) {
object at stationMesure<-get("refStationMesure",envir_stacomi)
@@ -140,9 +137,8 @@
plot(bilanConditionEnv)
}
#' Plot method for BilanConditionEnv
-#' @param x An object of class Bilan_carlot
-#' @param silent Stops displaying the messages.
-#' @param ... Additional arguments, see \code{plot}, \code{plot.default} and \code{par}
+#' @param x An object of class \link{BilanConditionEnv-class}
+#' @param silent Stops displaying the messages
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @aliases plot.BilanConditionEnv plot.bilanConditionEnv plot.bilanconditionenv
#' @export
Deleted: pkg/stacomir/R/BilanMigrationConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanMigrationConditionEnv.r 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/R/BilanMigrationConditionEnv.r 2017-04-03 15:49:09 UTC (rev 334)
@@ -1,198 +0,0 @@
-# Nom fichier : BilanMigrationConditionEnv (classe)
-
-#' Class "BilanMigrationConditionEnv"
-#'
-#' Enables to compute an annual overview of fish migration and environmental
-#' conditions in the same chart
-#'
-#'
-#' @section Objects from the Class: Objects can be created by calls of the form
-#' \code{new("BilanMigrationConditionEnv",
-#' bilanMigration=new("BilanMigration"),
-#' bilanConditionEnv=new("BilanConditionEnv"))}. \describe{
-#' \item{list("bilanMigration")}{Object of class \code{"BilanMigration"} The
-#' migration overview }\item{:}{Object of class \code{"BilanMigration"} The
-#' migration overview } \item{list("bilanConditionEnv")}{Object of class
-#' \code{"BilanConditionEnv"} The environmental overview}\item{:}{Object of
-#' class \code{"BilanConditionEnv"} The environmental overview} }
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @family Bilan Objects
-#' @keywords classes
-#' @export
-setClass(Class="BilanMigrationConditionEnv",representation=
- representation(
- bilanMigration="BilanMigration",
- bilanConditionEnv="BilanConditionEnv"
- ),
- prototype=prototype(
- bilanMigration=new("BilanMigration"),
- bilanConditionEnv=new("BilanConditionEnv")
-
- )
-)
-
-
-setValidity("BilanMigrationConditionEnv",
- function(object)
- {
- rep1=validObject(object at bilanMigration, test=TRUE)
- rep2=validObject(object at bilanConditionEnv, test=TRUE)
- rep3 = TRUE
- return(ifelse(rep1 & rep2 & rep3,TRUE,c(1:3)[!c(rep1, rep2, rep3)]))
- }
-)
-
-
-#' handler du graphique BilanMigrationConditionEnv
-#' realise le calcul du bilan migration avec CE, l'ecrit dans l'environnement envir_stacomi
-#' traite eventuellement les quantites de lots (si c'est des civelles)
-#' @param h a handler
-#' @param ... Additional parameters
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @export
-hbilanMigrationConditionEnvcalc=function(h,...){
- calcule(h$action)
- # calcule(bilanMigrationConditionEnv)
-}
-#object<-bilanMigrationConditionEnv
-#' Performs the calculations of environment conditions attached to a migration monitoring station
-#'
-
-
-#' @param object An object of class \code{\link{BilanMigrationConditionEnv-class}}
-#' @param ... additional parameters
-#' @return \code{\link{BilanMigrationConditionEnv-class}}
-#' @export
-setMethod("calcule",signature=signature("BilanMigrationConditionEnv"),definition=function(object,...){
- # le chargement de bilanMigration utilise la methode calcule de BilanMigration
- # qui charge les objects et en plus fait un calcul dessus, e la fin cette methode assigne les objects
- # dans l'environnement stacomi et c'est le qu'il faut aller les chercher
- # pour eviter de lancer les calculs et d'avoir la demande de stations e la fin du bilan migration...
- if (!exists("refStationMesure",envir_stacomi)) {
- funout(gettext("You need to choose a monitoring station, clic on validate\n",domain="R-stacomiR"),arret=TRUE)
- }
- calcule(object at bilanMigration)
- object at bilanMigration=get("bilanMigration",envir=envir_stacomi)
- # j'extraie les dates de debut et de fin de l'object pas de temps de l'object bilanmigration
- # il faut stocker un ojet RefHorodate dans l'environnement envir_stacomi pour reussir e le recharger dans l'object
- # bilanCOnditionEnv
- horodatedebut=new("RefHorodate")
- horodatedebut at horodate=object at bilanMigration@pasDeTemps at dateDebut # format POSIXlt
- horodatefin=new("RefHorodate")
- horodatefin at horodate=DateFin(object at bilanMigration@pasDeTemps) # format ePOSIXct
- # tiens c'est bizarre deux classes differents (POSIXlt et POSIXt) rentrent dans horodate
- # ben oui parce que RefHorodate est un object de classe POSIXT qui dans R est le papa des deux autres...
- horodatefin at horodate=as.POSIXlt(horodatefin at horodate)
- # ces dates sont necessaire pour initialiser le bilanConditionEnv qui dans son interface
- # fournit d'une date de debut et d'une date de fin
- # normalement l'interface assigne les objects bilanConditionEnv_date_debut dans l'environnement env_stacomi
- # ces objects sont au format POSIXlt
- # ls(envir=envir_stacomi)
- # Usage assign(x, value, pos = -1, envir = as.environment(pos),..)
- assign(x="bilanConditionEnv_date_debut",horodatedebut,envir=envir_stacomi)
- assign(x="bilanConditionEnv_date_fin",horodatefin,envir=envir_stacomi)
- object at bilanConditionEnv=charge(object at bilanConditionEnv) # le ea marche
- # les objects sont maintenant charges et calcules, j'assigne BilanConditionEnv qui les contient
- # dans l'environnement envir_stacomi
- funout(gettext("Summary object is stocked into envir_stacomi environment\n",domain="R-stacomiR"))
- assign("bilanMigrationConditionEnv",object,envir=envir_stacomi)
- enabled(toolbarlist[["Graph"]])<-TRUE
- })
-
-
-
-#' plot combining one ore several qualitative parameters with the migration trend
-#' @param h A handler
-#' @param ... Additional parameters
-hbilanMigrationConditionEnvgraph = function(h,...){
-
- if (exists("bilanMigrationConditionEnv",envir_stacomi)) {
- bilanMigrationConditionEnv<-get("bilanMigrationConditionEnv",envir_stacomi)
- } else {
- funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
- } # end ifelse
-
- # dans le bilanMigration, la time.sequence est une sequence (pour l'instant bilanMigration seulement au format journalier)
- # c'est des dates en format POSIXct qui se decalent (changement d'heure)
- # je les formate au jour, il semble qu'il y ait parfois des decalages de 1 jour
- time.sequence<-as.Date(as.POSIXlt(bilanMigrationConditionEnv at bilanMigration@time.sequence,tz="GMT"))
- tableau<-bilanMigrationConditionEnv at bilanMigration@data
- tableau<-cbind("time.sequence"=time.sequence,tableau)
- tableau$time.sequencechar<-as.character(tableau$time.sequence)
- tableauCE<-bilanMigrationConditionEnv at bilanConditionEnv@data # tableau conditions environnementales
- if (nrow(tableauCE)==0) {
- funout(gettext("You don't have any environmental conditions within the time period\n",domain="R-stacomiR"),arret=TRUE)
- }
-
- stations<-bilanMigrationConditionEnv at bilanConditionEnv@stationMesure at data
-
- for (i in 1:length(unique(tableauCE$env_stm_identifiant))){
- tableauCE[unique(tableauCE$env_stm_identifiant)[i]==tableauCE$env_stm_identifiant,"stm_libelle"]<-
- stations[stations$stm_identifiant==unique(tableauCE$env_stm_identifiant)[i],"stm_libelle"]
- }
-
- # generation de donnees pour le graphe
- #tableauCE=data.frame("env_date_debut"=time.sequence, "env_stm_identifiant"="essai1","env_valeur_quantitatif"=rnorm(n=length(time.sequence),20,5))
- #tableauCE1=data.frame("env_date_debut"=time.sequence, "env_stm_identifiant"="essai2", "env_valeur_quantitatif"=sin((1:length(time.sequence))/50))
- #tableauCE=rbind(tableauCE,tableauCE1)
- tableauCE$env_date_debutchar=as.character(as.Date(tableauCE$env_date_debut))
-
- if (nrow(stations)==0) {
- funout(gettext("no selected station => simple graph\n",domain="R-stacomiR"))
- #assign(x="bilanCondition",bilanMigrationConditionEnv at bilanMigration,envir=envir_stacomi)
- hbilanMigrationgraph(h) # lancement de la fonction normale
- } else {
- for (sta in as.character(stations$stm_libelle)){
- tableauCEst<-tableauCE[tableauCE$stm_libelle==sta,] #tableau CE d'une station
- if (length(unique(tableauCEst$env_date_debutchar))!=length(tableauCEst$env_date_debutchar)) {
- funout(gettextf("Attention, on one station :%s there are several entries for the same day :%s only the first value will be incuded in the summary\n",
- sta,
- paste(unique(tableauCEst$env_date_debutchar[duplicated(tableauCEst$env_date_debutchar)]),sep="")),
- arret=FALSE)
- tableauCEst<-tableauCEst[induk(tableauCEst$env_date_debutchar),]
- }
-
- # ci dessous pas la meilleure facon de tester si la variable est quantitative ou qualitative mais je ne recupere pas le caractere de la
- # variable dans la table de jointure tj_conditionenvironnementale_env et il faudrait faire un requete supplementaire...
- if (is.na(tableauCEst$env_val_identifiant[1])){
- #variable quantitative
- tableauCEst<-tableauCEst[,c("env_date_debutchar","env_valeur_quantitatif")]
- tableauCEst<-stacomirtools::chnames(tableauCEst,"env_valeur_quantitatif",sta)
- stations[stations$stm_libelle==sta,"stm_typevar"]<-"quantitatif"
- # je renomme la colonne e rentrer par le nom de la station
- } else {
- # variable qualitative
- tableauCEst<-tableauCEst[,c("env_date_debutchar","env_val_identifiant")]
- tableauCEst$"env_val_identifiant"=as.factor(tableauCEst$"env_val_identifiant")
- tableauCEst<-stacomirtools::chnames(tableauCEst,"env_val_identifiant",sta)
-
- stations[stations$stm_libelle==sta,"stm_typevar"]<-"qualitatif"
- } # end else
- # le merge ci dessous est l'equivalent d'une jointure gauche (LEFT JOIN)
- tableau<-merge(tableau,tableauCEst,by.x = "time.sequencechar", by.y = "env_date_debutchar", all.x = TRUE)
- # les donnees sont normalement collees dans le tableau dans une nouvelle colonne et aux dates correspondantes
- if (length(time.sequence)!=nrow(tableau)) funout(gettextf("The number of lines of the environmental conditions table (%s) doesn't fit the duration of the migration summary (%s)\n",
- nrow(tableau),
- length(time.sequence)),
- arret=TRUE)
- #si la jointure e rajoute des lignes ea craint je ne sais pas comment se fera le traitement
- } # end for
- taxon= as.character(bilanMigrationConditionEnv at bilanMigration@taxons at data$tax_nom_latin)
- stade= as.character(bilanMigrationConditionEnv at bilanMigration@stades at data$std_libelle)
- fungraph_env(tableau,time.sequence,taxon,stade,stations)
- } # end else
-}# end function
-
-#######################################################################
-# handler du calcul hBilanMigrationgraph2
-# appelle les fonctions fungraph pour faire un graphe annuel des
-# cumuls de migration au cours du temps
-#######################################################################
-
-#hbilanMigrationConditionEnvgraph2 = function(h,...) {
-#
-#}
-#
-#hbilanMigrationConditionEnvstat = function(h,...) {
-#
-#}
Copied: pkg/stacomir/R/BilanMigrationMultConditionEnv.r (from rev 312, pkg/stacomir/R/BilanMigrationConditionEnv.r)
===================================================================
--- pkg/stacomir/R/BilanMigrationMultConditionEnv.r (rev 0)
+++ pkg/stacomir/R/BilanMigrationMultConditionEnv.r 2017-04-03 15:49:09 UTC (rev 334)
@@ -0,0 +1,263 @@
+#' Class "BilanMigrationMultConditionEnv"
+#'
+#' Enables to compute an annual overview of fish migration and environmental
+#' conditions in the same chart
+#'
+#' @include BilanMigrationMult.r
+#' @include BilanConditionEnv.r
+#' @include create_generic.r
+#' @include utilitaires.r
+#' @slot bilanMigrationMult \link{BilanMigrationMult-class}
+#' @slot bilanConditionEnv \link{BilanConditionEnv-class}
+#' @author cedric.briand"at"eptb-vilaine.fr marion.legrand"at"logrami.fr
+#' @family Bilan Objects
+#' @keywords classes
+#' @aliases BilanMigrationMultConditionEnv bilanmigrationmultconditionenv bmmCE
+#' @keywords classes
+#' @example inst/examples/bilanMigrationMultConditionEnv_example.R
+#' @export
+
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @family Bilan Objects
+#' @keywords classes
+#' @export
+setClass(Class="BilanMigrationMultConditionEnv",representation=
+ representation(
+ bilanMigrationMult="BilanMigrationMult",
+ bilanConditionEnv="BilanConditionEnv"
+ ),
+ prototype=prototype(
+ bilanMigrationMult=new("BilanMigrationMult"),
+ bilanConditionEnv=new("BilanConditionEnv")
+
+ )
+)
+
+
+setValidity("BilanMigrationMultConditionEnv",
+ function(object)
+ {
+ rep1=validObject(object at bilanMigrationMult, test=TRUE)
+ rep2=validObject(object at bilanConditionEnv, test=TRUE)
+ return(ifelse(rep1 & rep2 ,TRUE,c(1:2)[!c(rep1, rep2)]))
+ }
+)
+#' connect method for BilanMigrationMultConditionEnv class
+#' @param object An object of class \link{BilanMigrationMultConditionEnv-class}
+#' @param silent Default FALSE, if TRUE the program should no display messages
+#' @return an object of BilanMigrationMultConditionEnv class
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("connect",signature=signature("BilanMigrationMultConditionEnv"),definition=function(object,silent=FALSE) {
+ #object<-bmmCE
+ bmmCE at bilanMigrationMult<-connect(bmmCE at bilanMigrationMult,silent=silent)
+ bmmCE at bilanConditionEnv<-connect(bmmCE at bilanConditionEnv,silent=silent)
+ return(bmmCE)
+ }
+)
+#' command line interface for BilanConditionEnv class
+#' @param object An object of class \link{BilanConditionEnv-class}
+#' @param stationmesure A character, the code of the monitoring station, which records environmental parameters \link{choice_c,RefStationMesure-method}
+#' @param datedebut The starting date as a character, formats like \code{\%Y-\%m-\%d} or \code{\%d-\%m-\%Y} can be used as input
+#' @param datefin The finishing date of the Bilan, for this class this will be used to calculate the number of daily steps.
+#' @param silent Boolean default FALSE, if TRUE information messages not displayed.
+#' @return An object of class \link{BilanConditionEnv-class}
+#' The choice_c method fills in the data slot for RefStationMesure and and then
+#' uses the choice_c methods of these object to select the data.
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("choice_c",signature=signature("BilanMigrationMultConditionEnv"),definition=function(object,dc,taxons,stades,stationMesure,datedebut,datefin,silent=FALSE){
+ # code for debug
+ # dc=c(5,6,12); taxons=c("Anguilla anguilla");stades=c("AGJ","AGG","CIV");
+ # stationMesure=c("temp_gabion","coef_maree");
+ # datedebut="2008-01-01";datefin="2008-12-31";silent=FALSE
+ bmmCE<-object
+ bmmCE at bilanMigrationMult=
+ choice_c(bmmCE at bilanMigrationMult,
+ dc=dc,
+ taxons=taxons,
+ stades=stades,
+ datedebut=datedebut,
+ datefin=datefin)
+ bmmCE at bilanConditionEnv=choice_c(bmmCE at bilanConditionEnv,
+ stationMesure=stationMesure,
+ datedebut=datedebut,
+ datefin=datefin,
+ silent=silent)
+ return(bmmCE)
+ })
+#' charge method for BilanMigrationMultConditionEnv class
+#' @param object An object of class \link{BilanMigrationMultConditionEnv-class}
+#' @inheritDotParams charge,BilanConditionEnv-method -object
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("charge",signature=signature("BilanMigrationMultConditionEnv"),definition=function(object,silent) {
+ # silent=FALSE
+ bmmCE<-object
+ bmmCE at bilanMigrationMult<-charge(bmmCE at bilanMigrationMult,silent=silent)
+ bmmCE at bilanConditionEnv<-charge(bmmCE at bilanConditionEnv,silent=silent)
+ return(bmmCE)
+ })
+
+
+
+#' Calculation for the BilanMigrationMultConditionEnv
+#'
+#' @param object An object of class \code{\link{BilanMigrationMultConditionEnv-class}}
+#' @return \code{\link{BilanMigrationMultConditionEnv-class}}
+#' @export
+setMethod("calcule",signature=signature("BilanMigrationMultConditionEnv"),definition=function(object,silent){
+ # silent=FALSE
+ bmmCE<-object
+ bmmCE at bilanMigrationMult<-calcule(bmmCE at bilanMigrationMult)
+ funout(gettext("bmmCE object is stocked into envir_stacomi environment\n",domain="R-stacomiR"))
+ return(bmmCE)
+ })
+
+
+
+#' internal method for graphical interface
+#' @param h A handler
+hbilanMigrationMultConditionEnvgraph = function(h){
+ bmmCE<-get("bmmCE",envir_stacomi)
+ bmmCE<-charge(bmmCE)
+ bmmCE<-connect(bmmCE)
+ bmmCE<-calcule(bmmCE)
+ bmmCE<-plot(bmmCE)
+}
+
+#' Plot method for BilanMigrationMultConditionEnv
+#' @param x An object of class Bilan_carlot
+#' @param silent Stops displaying the messages.
+#' @param ... Additional arguments, see \code{plot}, \code{plot.default} and \code{par}
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @aliases plot.BilanMigrationMultConditionEnv plot.bmmCE
+#' @export
+setMethod("plot", signature(x = "BilanMigrationMultConditionEnv", y = "missing"), definition=function(x, silent=FALSE){
+ bmmCE<-object
+ plot(bmmCE at bilanMigrationMult,plot.type="multiple")
+ # on va chercher les données du graphique
+
+ time.sequence<-as.Date(as.POSIXlt(bmmCE at bilanMigrationMult@time.sequence))
+ tableau<-get("grdata",envir_stacomi)
+ tableau<-cbind("time.sequence"=time.sequence,tableau)
+ tableau$time.sequencechar<-as.character(tableau$time.sequence)
+
+ # tableau conditions environnementales
+ tableauCE<-bmmCE at bilanConditionEnv@data
+ if (nrow(tableauCE)==0) {
+ funout(gettext("You don't have any environmental conditions within the time period\n",domain="R-stacomiR"),arret=TRUE)
+ }
+
+ stations<-bmmCE at bilanConditionEnv@stationMesure at data
+
+ for (i in 1:length(unique(tableauCE$env_stm_identifiant))){
+ tableauCE[unique(tableauCE$env_stm_identifiant)[i]==tableauCE$env_stm_identifiant,"stm_libelle"]<-
+ stations[stations$stm_identifiant==unique(tableauCE$env_stm_identifiant)[i],"stm_libelle"]
+ }
+ tableauCE$env_date_debutchar=as.character(as.Date(tableauCE$env_date_debut))
+
+ for (sta in as.character(stations$stm_libelle)){
+ tableauCEst<-tableauCE[tableauCE$stm_libelle==sta,] #tableau CE d'une station
+ if (length(unique(tableauCEst$env_date_debutchar))!=length(tableauCEst$env_date_debutchar)) {
+ funout(gettextf("Attention, on one station :%s there are several entries for the same day :%s only the first value will be incuded in the summary\n",
+ sta,
+ paste(unique(tableauCEst$env_date_debutchar[duplicated(tableauCEst$env_date_debutchar)]),sep="")),
+ arret=FALSE)
+ tableauCEst<-tableauCEst[induk(tableauCEst$env_date_debutchar),]
+ }
+
+ if (is.na(tableauCEst$env_val_identifiant[1])){
+ #variable quantitative
+ tableauCEst<-tableauCEst[,c("env_date_debutchar","env_valeur_quantitatif")]
+ tableauCEst<-stacomirtools::chnames(tableauCEst,"env_valeur_quantitatif",sta)
+ stations[stations$stm_libelle==sta,"stm_typevar"]<-"quantitatif"
+ # je renomme la colonne e rentrer par le nom de la station
+ } else {
+ # variable qualitative
+ tableauCEst<-tableauCEst[,c("env_date_debutchar","env_val_identifiant")]
+ tableauCEst$"env_val_identifiant"=as.factor(tableauCEst$"env_val_identifiant")
+ tableauCEst<-stacomirtools::chnames(tableauCEst,"env_val_identifiant",sta)
+
+ stations[stations$stm_libelle==sta,"stm_typevar"]<-"qualitatif"
+ } # end else
+ # le merge ci dessous est l'equivalent d'une jointure gauche (LEFT JOIN)
+ tableau<-merge(tableau,tableauCEst,by.x = "time.sequencechar", by.y = "env_date_debutchar", all.x = TRUE)
+ # les donnees sont normalement collees dans le tableau dans une nouvelle colonne et aux dates correspondantes
+ if (length(time.sequence)!=nrow(tableau)) funout(gettextf("The number of lines of the environmental conditions table (%s) doesn't fit the duration of the migration summary (%s)\n",
+ nrow(tableau),
+ length(time.sequence)),
+ arret=TRUE)
+ #si la jointure e rajoute des lignes ea craint je ne sais pas comment se fera le traitement
+ } # end for
+ taxon= as.character(bmmCE at bilanMigration@taxons at data$tax_nom_latin)
+ stade= as.character(bmmCE at bilanMigration@stades at data$std_libelle)
+
+ bilanMigrationConditionEnv at bilanMigration@dc<-get("refDC",envir_stacomi)
+ annee=strftime(as.POSIXlt(mean(time.sequence)),"%Y")
+ dis_commentaire= as.character(bilanMigrationConditionEnv at bilanMigration@dc at data$dis_commentaires[bilanMigrationConditionEnv at bilanMigration@dc at data$dc%in%bilanMigrationConditionEnv at bilanMigration@dc at dc_selectionne]) # commentaires sur le DC
+ tableau<-funtraitementdate(tableau,
+ nom_coldt="time.sequence",
+ annee=FALSE,
+ mois=TRUE,
+ quinzaine=TRUE,
+ semaine=TRUE,
+ jour_an=TRUE,
+ jour_mois=FALSE,
+ heure=FALSE)
+ couleurs=rep(RColorBrewer::brewer.pal(8,"Accent"),2)
+ maxeff=floor(log10(max(tableau$Effectif_total,na.rm=TRUE)))
+ lab_les_stations=stations$stm_libelle
+ for (i in 1:nrow(stations)){
+ tableau[,paste("couleur",i,sep="")]<-couleurs[i]
+ if (stations$stm_typevar[i]=="quantitatif") {
+ diff=maxeff-round(log10(max(tableau[,stations$stm_libelle[i]],na.rm=TRUE)))
+
+ if (diff!=0 & !is.na(diff)){
+ tableau[,stations$stm_libelle[i]] = as.numeric(tableau[,stations$stm_libelle[i]])*10^diff
+ lab_les_stations[i]=paste(stations$stm_libelle[i],".10^",diff,sep="")
+ } # end if
+ } #end if
+ } # end for
+ tableau$yqualitatif=(10^(maxeff))/2
+ name=gettextf("Number %s",paste(lab_les_stations,collapse=", "))
+ g<-ggplot(tableau, aes(x=time.sequence,y=Effectif_total))+geom_bar(stat="identity",fill="grey50")+scale_x_date(name="Date")+
+ scale_y_continuous(name=name)+labs(title=gettextf("Number %s, %s, %s, %s",dis_commentaire,taxon,stade,annee))
+ for (i in 1:nrow(stations)){
+ if (stations$stm_typevar[i]=="quantitatif") {
+ if (all(!is.na(tableau[,stations$stm_libelle[i]]))){
+ g<-g+geom_line(aes_string(x="time.sequence",y=stations$stm_libelle[i],colour=paste("couleur",i,sep="")),size=1)+
+ scale_colour_identity(name="stations",breaks=couleurs[1:i],labels=stations$stm_libelle[1:i])
+ } else {
+ g<-g+geom_point(aes_string(x="time.sequence",y=stations$stm_libelle[i],colour=paste("couleur",i,sep="")),size=2)+
+ scale_colour_identity(name="stations",breaks=couleurs[1:i],labels=stations$stm_libelle[1:i])
+ }
+ } else if (stations$stm_typevar[i]=="qualitatif") {
+ stableau=subset(tableau, !is.na(tableau[,stations$stm_libelle[i]]))
+ stableau[,stations$stm_libelle[i]]<- as.factor(as.character( stableau[,stations$stm_libelle[i]]))
+ if (stations$stm_par_code[i]=="AAAA")# phases lunaires
+ g<-g+geom_point(aes_string(x="time.sequence",y="yqualitatif",colour=paste("couleur",i,sep=""),shape=stations$stm_libelle[i]),data=stableau,size=3)+
+ scale_colour_identity(name="stations",breaks=couleurs[1:i],labels=stations$stm_libelle[1:i])
+ } else stop("internal error")
+ } # end for
+ assign("g",g,envir_stacomi)
+ funout(gettext("Writing of the graphical object in the environment envir_stacomi : write g=get(g,envir_stacomi)\n",domain="R-stacomiR"))
+ print(g)
+
+
+}# end function
+
+
+
+#' handler du graphique BilanMigrationMultConditionEnv
+#' realise le calcul du bilan migration avec CE, l'ecrit dans l'environnement envir_stacomi
+#' traite eventuellement les quantites de lots (si c'est des civelles)
+#' @param h a handler
+#' @param ... Additional parameters
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+hbilanMigrationMultConditionEnvcalc=function(h,...){
+ calcule(h$action)
+ enabled(toolbarlist[["Graph"]])<-TRUE
+ # calcule(bilanMigrationMultConditionEnv)
+}
Deleted: pkg/stacomir/R/fungraph_env.r
===================================================================
--- pkg/stacomir/R/fungraph_env.r 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/R/fungraph_env.r 2017-04-03 15:49:09 UTC (rev 334)
@@ -1,66 +0,0 @@
-#' Function for class BilanMigrationEnv drawing both the response of
-#' environment variables...
-#'
-#' graph function for BilanMigrationEnv, draws both the response of environment
-#' variables (temperature, moon phases...) and the migration for a species and
-#' a stage
-#'
-#'
-#' @param tableau data issued from a bilanMigration
-#' @param time.sequence a vector of class POSIXt
-#' @param taxon the species
-#' @param stade the stage
-#' @param stations one or several measure stations
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-fungraph_env=function(tableau,time.sequence,taxon,stade,stations){
- bilanMigrationConditionEnv at bilanMigration@dc<-get("refDC",envir_stacomi)
- annee=strftime(as.POSIXlt(mean(time.sequence)),"%Y")
- dis_commentaire= as.character(bilanMigrationConditionEnv at bilanMigration@dc at data$dis_commentaires[bilanMigrationConditionEnv at bilanMigration@dc at data$dc%in%bilanMigrationConditionEnv at bilanMigration@dc at dc_selectionne]) # commentaires sur le DC
- tableau<-funtraitementdate(tableau,
- nom_coldt="time.sequence",
- annee=FALSE,
- mois=TRUE,
- quinzaine=TRUE,
- semaine=TRUE,
- jour_an=TRUE,
- jour_mois=FALSE,
- heure=FALSE)
- couleurs=rep(RColorBrewer::brewer.pal(8,"Accent"),2)
- maxeff=floor(log10(max(tableau$Effectif_total,na.rm=TRUE)))
- lab_les_stations=stations$stm_libelle
- for (i in 1:nrow(stations)){
- tableau[,paste("couleur",i,sep="")]<-couleurs[i]
- if (stations$stm_typevar[i]=="quantitatif") {
- diff=maxeff-round(log10(max(tableau[,stations$stm_libelle[i]],na.rm=TRUE)))
-
- if (diff!=0 & !is.na(diff)){
- tableau[,stations$stm_libelle[i]] = as.numeric(tableau[,stations$stm_libelle[i]])*10^diff
- lab_les_stations[i]=paste(stations$stm_libelle[i],".10^",diff,sep="")
- } # end if
- } #end if
- } # end for
- tableau$yqualitatif=(10^(maxeff))/2
- name=gettextf("Number %s",paste(lab_les_stations,collapse=", "))
- g<-ggplot(tableau, aes(x=time.sequence,y=Effectif_total))+geom_bar(stat="identity",fill="grey50")+scale_x_date(name="Date")+
- scale_y_continuous(name=name)+labs(title=gettextf("Number %s, %s, %s, %s",dis_commentaire,taxon,stade,annee))
- for (i in 1:nrow(stations)){
- if (stations$stm_typevar[i]=="quantitatif") {
- if (all(!is.na(tableau[,stations$stm_libelle[i]]))){
- g<-g+geom_line(aes_string(x="time.sequence",y=stations$stm_libelle[i],colour=paste("couleur",i,sep="")),size=1)+
- scale_colour_identity(name="stations",breaks=couleurs[1:i],labels=stations$stm_libelle[1:i])
- } else {
- g<-g+geom_point(aes_string(x="time.sequence",y=stations$stm_libelle[i],colour=paste("couleur",i,sep="")),size=2)+
- scale_colour_identity(name="stations",breaks=couleurs[1:i],labels=stations$stm_libelle[1:i])
- }
- } else if (stations$stm_typevar[i]=="qualitatif") {
- stableau=subset(tableau, !is.na(tableau[,stations$stm_libelle[i]]))
- stableau[,stations$stm_libelle[i]]<- as.factor(as.character( stableau[,stations$stm_libelle[i]]))
- if (stations$stm_par_code[i]=="AAAA")# phases lunaires
- g<-g+geom_point(aes_string(x="time.sequence",y="yqualitatif",colour=paste("couleur",i,sep=""),shape=stations$stm_libelle[i]),data=stableau,size=3)+
- scale_colour_identity(name="stations",breaks=couleurs[1:i],labels=stations$stm_libelle[1:i])
- } else stop("internal error")
- } # end for
- assign("g",g,envir_stacomi)
- funout(gettext("Writing of the graphical object in the environment envir_stacomi : write g=get(g,envir_stacomi)\n",domain="R-stacomiR"))
- print(g)
-}
Deleted: pkg/stacomir/R/interface_BilanMigrationConditionEnv.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigrationConditionEnv.r 2017-04-03 12:31:09 UTC (rev 333)
+++ pkg/stacomir/R/interface_BilanMigrationConditionEnv.r 2017-04-03 15:49:09 UTC (rev 334)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 334
More information about the Stacomir-commits
mailing list