[Stacomir-commits] r176 - in pkg/stacomir: . R data examples/01_BilanMigrationMult inst/config inst/tests/testthat man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Aug 24 17:20:59 CEST 2016
Author: briand
Date: 2016-08-24 17:20:59 +0200 (Wed, 24 Aug 2016)
New Revision: 176
Added:
pkg/stacomir/man/plot-BilanMigrationPar-missing-method.Rd
Removed:
pkg/stacomir/man/BilanMigration_functions.Rd
pkg/stacomir/man/cumplot-BilanMigrationMult-method.Rd
pkg/stacomir/man/plot-BilanMigrationPar-ANY-method.Rd
pkg/stacomir/man/plot1-BilanMigrationMult-method.Rd
Modified:
pkg/stacomir/NAMESPACE
pkg/stacomir/R/BilanFonctionnementDC.r
pkg/stacomir/R/BilanFonctionnementDF.r
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/BilanMigrationConditionEnv.r
pkg/stacomir/R/BilanMigrationInterAnnuelle.r
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/BilanMigrationPar.r
pkg/stacomir/R/Bilan_poids_moyen.r
pkg/stacomir/R/Bilan_stades_pigm.r
pkg/stacomir/R/Bilan_taille.r
pkg/stacomir/R/PasDeTempsJournalier.r
pkg/stacomir/R/PasdeTemps.r
pkg/stacomir/R/RefCheckBox.r
pkg/stacomir/R/RefDC.r
pkg/stacomir/R/RefHorodate.r
pkg/stacomir/R/RefListe.r
pkg/stacomir/R/RefPoidsMoyenPeche.r
pkg/stacomir/R/RefStades.r
pkg/stacomir/R/RefTaxon.r
pkg/stacomir/R/create_generic.r
pkg/stacomir/R/fn_EcritBilanJournalier.r
pkg/stacomir/R/fn_EcritBilanMensuel.r
pkg/stacomir/R/funSousListeBilanMigration.r
pkg/stacomir/R/funSousListeBilanMigrationPar.r
pkg/stacomir/R/fungraph.r
pkg/stacomir/R/fungraph_civelle.r
pkg/stacomir/R/fungraph_env.r
pkg/stacomir/R/funtable.r
pkg/stacomir/R/funtraitement_poids.r
pkg/stacomir/R/funtraitementdate.r
pkg/stacomir/R/interface_Bilan_lot.r
pkg/stacomir/R/interface_bilan_poids_moyen.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/R/utilitaires.r
pkg/stacomir/data/bMM_Arzal.rda
pkg/stacomir/examples/01_BilanMigrationMult/bilanMigrationMult_Arzal.R
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/config/testfile.R
pkg/stacomir/inst/tests/testthat/test-00stacomir.R
pkg/stacomir/inst/tests/testthat/test-01BilanMigrationMult.R
pkg/stacomir/man/BilanMigrationMult-class.Rd
pkg/stacomir/man/PasDeTemps-class.Rd
pkg/stacomir/man/PasDeTempsJournalier-class.Rd
pkg/stacomir/man/envir_stacomi.Rd
pkg/stacomir/man/fun_weight_conversion.Rd
pkg/stacomir/man/fungraph.Rd
pkg/stacomir/man/fungraph_civelle.Rd
pkg/stacomir/man/fungraph_env.Rd
pkg/stacomir/man/fungraphstades.Rd
pkg/stacomir/man/funphi.Rd
pkg/stacomir/man/funtable.Rd
pkg/stacomir/man/funtraitement_poids.Rd
pkg/stacomir/man/hbilanMigrationPargraph.Rd
pkg/stacomir/man/hbilanMigrationPargraph2.Rd
pkg/stacomir/man/hbilanMigrationParstat.Rd
pkg/stacomir/man/plot-BilanMigrationMult-ANY-method.Rd
pkg/stacomir/man/stacomi.Rd
Log:
Modified: pkg/stacomir/NAMESPACE
===================================================================
--- pkg/stacomir/NAMESPACE 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/NAMESPACE 2016-08-24 15:20:59 UTC (rev 176)
@@ -11,6 +11,7 @@
export(funboxDF)
export(funboxplotBilan_carlot)
export(fundensityBilan_carlot)
+export(funout)
export(funpointBilan_carlot)
export(funstat)
export(funstatJournalier)
@@ -46,8 +47,7 @@
exportMethods(choice_c)
exportMethods(connect)
exportMethods(createmessage)
-exportMethods(cumplot)
-exportMethods(plot1)
+exportMethods(plot)
exportMethods(print)
exportMethods(setRefHorodate)
exportMethods(summary)
Modified: pkg/stacomir/R/BilanFonctionnementDC.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDC.r 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/R/BilanFonctionnementDC.r 2016-08-24 15:20:59 UTC (rev 176)
@@ -111,7 +111,7 @@
}
t_periodefonctdispositif_per<-fonctionnementDC at requete@query # on recupere le data.frame
- # l'objectif du programme ci dessous est de calculer la duree mensuelle de fonctionnement du dispositif.
+ # l'objectif du programme ci dessous est de calculer la time.sequence mensuelle de fonctionnement du dispositif.
tempsdebut<-strptime(t_periodefonctdispositif_per$per_date_debut,"%Y-%m-%d %H:%M:%S", tz = "GMT")
tempsfin<-strptime(t_periodefonctdispositif_per$per_date_fin,"%Y-%m-%d %H:%M:%S", tz = "GMT")
# test la premiere horodate peut etre avant le choice de temps de debut, remplacer cette date par requete at datedebut
@@ -128,7 +128,7 @@
for(j in 1:nrow(t_periodefonctdispositif_per)){ # pour toutes les lignes du ResultSet...
#cat( j )
if (j>1) t_periodefonctdispositif_per_mois=rbind(t_periodefonctdispositif_per_mois, t_periodefonctdispositif_per[j,])
- lemoissuivant<-seqmois[seqmois>tempsdebut[j]][1] # le premier mois superieur � tempsdebut
+ lemoissuivant<-seqmois[seqmois>tempsdebut[j]][1] # le premier mois superieur e tempsdebut
# on est a cheval sur deux periodes
while (tempsfin[j]>lemoissuivant)
@@ -142,7 +142,7 @@
if (is.na(lemoissuivant) ) break
}
}
- t_periodefonctdispositif_per_mois$sumduree<-as.numeric(difftime(t_periodefonctdispositif_per_mois$tempsfin, t_periodefonctdispositif_per_mois$tempsdebut,units = "hours"))
+ t_periodefonctdispositif_per_mois$sumtime.sequence<-as.numeric(difftime(t_periodefonctdispositif_per_mois$tempsfin, t_periodefonctdispositif_per_mois$tempsdebut,units = "hours"))
t_periodefonctdispositif_per_mois$mois1<-strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%b")
t_periodefonctdispositif_per_mois$mois<-strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%m")
t_periodefonctdispositif_per_mois$annee<-strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%Y")
@@ -151,7 +151,7 @@
superpose.polygon$border<-FALSE
lattice::trellis.par.set("superpose.polygon",superpose.polygon)
bar<-lattice::barchart(
- as.numeric(t_periodefonctdispositif_per_mois$sumduree)~as.factor(t_periodefonctdispositif_per_mois$mois)|as.factor(t_periodefonctdispositif_per_mois$annee),
+ as.numeric(t_periodefonctdispositif_per_mois$sumtime.sequence)~as.factor(t_periodefonctdispositif_per_mois$mois)|as.factor(t_periodefonctdispositif_per_mois$annee),
groups=t_periodefonctdispositif_per_mois$per_tar_code,
stack=TRUE,
xlab=get("msg",envir_stacomi)$BilanFonctionnementDC.3,
@@ -180,9 +180,9 @@
funout(get("msg",envir_stacomi)$BilanFonctionnementDC.2, arret=TRUE)
}
t_periodefonctdispositif_per<-fonctionnementDC at requete@query # on recupere le data.frame
- duree<-seq.POSIXt(from=fonctionnementDC at requete@datedebut,to=fonctionnementDC at requete@datefin,by="day")
- debut<-unclass(as.Date(duree[1]))[[1]]
- fin<-unclass(as.Date(duree[length(duree)]))[[1]]
+ time.sequence<-seq.POSIXt(from=fonctionnementDC at requete@datedebut,to=fonctionnementDC at requete@datefin,by="day")
+ debut<-unclass(as.Date(time.sequence[1]))[[1]]
+ fin<-unclass(as.Date(time.sequence[length(time.sequence)]))[[1]]
mypalette<-RColorBrewer::brewer.pal(12,"Paired")
#display.brewer.all()
mypalette1<-c("#1B9E77","#AE017E","orange", RColorBrewer::brewer.pal(12,"Paired"))
@@ -194,8 +194,8 @@
###################################
# creation d'un graphique vide (2)
###################################
- plot( as.Date(duree),
- seq(0,1,length.out=length(duree)),
+ plot( as.Date(time.sequence),
+ seq(0,1,length.out=length(time.sequence)),
xlim=c(debut,fin),
type= "n",
xlab="",
@@ -204,7 +204,7 @@
ylab=get("msg",envir_stacomi)$BilanFonctionnementDC.9,
#bty="n",
cex=0.8)
- r <- as.Date(round(range(duree), "day"))
+ r <- as.Date(round(range(time.sequence), "day"))
graphics::axis.Date(1, at=seq(r[1], r[2], by="weeks"),format="%d-%b")
if (dim(t_periodefonctdispositif_per)[1]==0 ) { # s'il n'y a pas de periode de fontionnement dans la base
graphics::rect( xleft=debut,
Modified: pkg/stacomir/R/BilanFonctionnementDF.r
===================================================================
--- pkg/stacomir/R/BilanFonctionnementDF.r 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/R/BilanFonctionnementDF.r 2016-08-24 15:20:59 UTC (rev 176)
@@ -111,7 +111,7 @@
funout(get("msg",envir=envir_stacomi)$BilanFonctionnementDF.3)
t_periodefonctdispositif_per=fonctionnementDF at requete@query # on recupere le data.frame
- # l'objectif du programme ci dessous est de calculer la duree mensuelle de fonctionnement du dispositif.
+ # l'objectif du programme ci dessous est de calculer la time.sequence mensuelle de fonctionnement du dispositif.
#tempsdebut<-strptime(t_periodefonctdispositif_per$per_date_debut,"%Y-%m-%d %H:%M:%S", tz = "GMT")
#tempsfin<-strptime(t_periodefonctdispositif_per$per_date_fin,"%Y-%m-%d %H:%M:%S", tz = "GMT")
tempsdebut<-t_periodefonctdispositif_per$per_date_debut
@@ -151,7 +151,7 @@
if (is.na(lemoissuivant) ) break
}
}
- t_periodefonctdispositif_per_mois$sumduree<-as.numeric(difftime(t_periodefonctdispositif_per_mois$tempsfin, t_periodefonctdispositif_per_mois$tempsdebut,units = "hours"))
+ t_periodefonctdispositif_per_mois$sumtime.sequence<-as.numeric(difftime(t_periodefonctdispositif_per_mois$tempsfin, t_periodefonctdispositif_per_mois$tempsdebut,units = "hours"))
t_periodefonctdispositif_per_mois$mois1= strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%b")
t_periodefonctdispositif_per_mois$mois=strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%m")
t_periodefonctdispositif_per_mois$annee=strftime(as.POSIXlt(t_periodefonctdispositif_per_mois$tempsdebut),"%Y")
@@ -159,20 +159,20 @@
close(progres)
# graphique
- t_periodefonctdispositif_per_mois<-stacomirtools::chnames(t_periodefonctdispositif_per_mois, old_variable_name=c("sumduree","per_tar_code","per_etat_fonctionnement"),
+ t_periodefonctdispositif_per_mois<-stacomirtools::chnames(t_periodefonctdispositif_per_mois, old_variable_name=c("sumtime.sequence","per_tar_code","per_etat_fonctionnement"),
new_variable_name=get("msg",envir_stacomi)$BilanFonctionnementDF.6)
#modif de l'ordre pour apparence graphique
t_periodefonctdispositif_per_mois=t_periodefonctdispositif_per_mois[order(t_periodefonctdispositif_per_mois$type_fonct., decreasing = TRUE),]
g<- ggplot(t_periodefonctdispositif_per_mois,
- aes(x=mois,y=duree,fill=libelle))+
+ aes(x=mois,y=time.sequence,fill=libelle))+
facet_grid(annee~.)+ggtitle(paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,fonctionnementDF at df@df_selectionne))
g<-g+geom_bar(stat='identity')+
scale_fill_manual(values = c("#E41A1C","#E6AB02", "#9E0142","#1B9E77","#999999"))
#modif de l'ordre pour apparence graphique
t_periodefonctdispositif_per_mois=t_periodefonctdispositif_per_mois[order(t_periodefonctdispositif_per_mois$fonctionnement),]
t_periodefonctdispositif_per_mois$fonctionnement=as.factor( t_periodefonctdispositif_per_mois$fonctionnement)
- g1<- ggplot(t_periodefonctdispositif_per_mois,aes(x=mois,y=duree))+facet_grid(annee~.)+ggtitle(paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,fonctionnementDF at df@df_selectionne))
+ g1<- ggplot(t_periodefonctdispositif_per_mois,aes(x=mois,y=time.sequence))+facet_grid(annee~.)+ggtitle(paste(get("msg",envir_stacomi)$BilanFonctionnementDF.7,fonctionnementDF at df@df_selectionne))
g1<-g1+
geom_bar(stat='identity',aes(fill=fonctionnement))+
scale_fill_manual(values = c("#E41A1C","#4DAF4A"))
@@ -211,9 +211,9 @@
unclass(vectordate)
return(vectordate)
}
- duree=seq.POSIXt(from=fonctionnementDF at requete@datedebut,to=fonctionnementDF at requete@datefin,by="day")
- debut=graphdate(duree[1])
- fin=graphdate(duree[length(duree)])
+ time.sequence=seq.POSIXt(from=fonctionnementDF at requete@datedebut,to=fonctionnementDF at requete@datefin,by="day")
+ debut=graphdate(time.sequence[1])
+ fin=graphdate(time.sequence[length(time.sequence)])
mypalette<-RColorBrewer::brewer.pal(12,"Paired")
#display.brewer.all()
mypalette1<-c("#1B9E77","#AE017E","orange", RColorBrewer::brewer.pal(12,"Paired"))
@@ -221,8 +221,8 @@
###################################
# creation d'un graphique vide (2)
###################################
- plot( graphdate(duree),
- seq(0,1,length.out=length(duree)),
+ plot( graphdate(time.sequence),
+ seq(0,1,length.out=length(time.sequence)),
xlim=c(debut,fin),
type= "n",
xlab="",
@@ -231,7 +231,7 @@
ylab=get("msg",envir=envir_stacomi)$BilanFonctionnementDF.9,
#bty="n",
cex=0.8)
- r <- round(range(duree), "day")
+ r <- round(range(time.sequence), "day")
graphics::axis(1, at=graphdate(seq(r[1], r[2], by="weeks")),labels=strftime(as.POSIXlt(seq(r[1], r[2], by="weeks")),format="%d-%b"))
if (dim(t_periodefonctdispositif_per)[1]==0 ) {
rect( xleft=debut,
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/R/BilanMigration.r 2016-08-24 15:20:59 UTC (rev 176)
@@ -67,7 +67,7 @@
rep2=length(object at taxons)==1
rep3=length(object at stades)==1
rep3=length(object at pasDeTemps)==1
- rep4=(object at pasDeTemps@nbPas==365) # contrainte : pendant 365j
+ 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
@@ -142,7 +142,7 @@
tableau$coe_valeur_coefficient=as.numeric(tableau$coe_valeur_coefficient)
tableau$coe_valeur_coefficient[is.na(tableau$coe_valeur_coefficient)]=0
bilanMigration at time.sequence=seq.POSIXt(from=as.POSIXlt(min(data$debut_pas)),to=max(data$debut_pas),
- by=as.numeric(bilanMigration at pasDeTemps@time.sequencePas)) # il peut y avoir des lignes repetees poids effectif
+ by=as.numeric(bilanMigration at pasDeTemps@stepDuration)) # il peut y avoir des lignes repetees poids effectif
# traitement des coefficients de conversion poids effectif
if (bilanMigration at taxons@data$tax_nom_latin=="Anguilla anguilla"& bilanMigration at stades@data$std_libelle=="civelle")
@@ -180,7 +180,7 @@
funout(get("msg",envir_stacomi)$BilanMigration.9)
# si le bilan est journalier
- if (bilanMigration at pasDeTemps@time.sequencePas==86400 & bilanMigration at pasDeTemps@time.sequencePas==86400) {
+ if (bilanMigration at pasDeTemps@stepDuration==86400 & bilanMigration at pasDeTemps@stepDuration==86400) {
# pour sauvegarder sous excel
if (taxon=="Anguilla anguilla"& stade=="civelle") {
@@ -213,7 +213,7 @@
taxon= as.character(bilanMigration at taxons@data$tax_nom_latin)
stade= as.character(bilanMigration at stades@data$std_libelle)
DC=as.numeric(bilanMigration at dc@dc_selectionne)
- if (bilanMigration at pasDeTemps@time.sequencePas==86400 & bilanMigration at pasDeTemps@time.sequencePas==86400) {
+ if (bilanMigration at pasDeTemps@stepDuration==86400 & bilanMigration at pasDeTemps@stepDuration==86400) {
bilanMigration at data$time.sequence=bilanMigration at time.sequence
# pour sauvegarder sous excel
bilanMigration at data<-funtraitementdate(bilanMigration at data,
Modified: pkg/stacomir/R/BilanMigrationConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanMigrationConditionEnv.r 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/R/BilanMigrationConditionEnv.r 2016-08-24 15:20:59 UTC (rev 176)
@@ -66,21 +66,21 @@
#object<-bilanMigrationConditionEnv
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, � la fin cette methode assigne les objects
- # dans l'environnement stacomi et c'est l� qu'il faut aller les chercher
- # pour eviter de lancer les calculs et d'avoir la demande de stations � la fin du bilan migration...
+ # 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(get("msg",envir=envir_stacomi)$BilanCondtionEnv.2,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 � le recharger dans l'object
+ # 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 �POSIXct
+ 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)
@@ -92,7 +92,7 @@
# 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) # l� �a marche
+ 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(get("msg",envir=envir_stacomi)$BilanMigrationConditionEnv.1)
@@ -121,13 +121,13 @@
funout(get("msg",envir=envir_stacomi)$BilanMigrationConditionEnv.2,arret=TRUE)
} # end ifelse
- # dans le bilanMigration, la duree est une sequence (pour l'instant bilanMigration seulement au format journalier)
+ # 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
- duree<-as.Date(as.POSIXlt(bilanMigrationConditionEnv at bilanMigration@duree,tz="GMT"))
+ time.sequence<-as.Date(as.POSIXlt(bilanMigrationConditionEnv at bilanMigration@time.sequence,tz="GMT"))
tableau<-bilanMigrationConditionEnv at bilanMigration@data
- tableau<-cbind("duree"=duree,tableau)
- tableau$dureechar<-as.character(tableau$duree)
+ 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(get("msg",envir=envir_stacomi)$BilanMigrationConditionEnv.3,arret=TRUE)
@@ -141,8 +141,8 @@
}
# generation de donnees pour le graphe
- #tableauCE=data.frame("env_date_debut"=duree, "env_stm_identifiant"="essai1","env_valeur_quantitatif"=rnorm(n=length(duree),20,5))
- #tableauCE1=data.frame("env_date_debut"=duree, "env_stm_identifiant"="essai2", "env_valeur_quantitatif"=sin((1:length(duree))/50))
+ #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))
@@ -169,7 +169,7 @@
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 � rentrer par le nom de la station
+ # je renomme la colonne e rentrer par le nom de la station
} else {
# variable qualitative
tableauCEst<-tableauCEst[,c("env_date_debutchar","env_val_identifiant")]
@@ -179,18 +179,18 @@
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 = "dureechar", by.y = "env_date_debutchar", all.x = TRUE)
+ 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(duree)!=nrow(tableau)) funout(paste(get("msg",envir=envir_stacomi)$BilanMigrationConditionEnv.5,
+ if (length(time.sequence)!=nrow(tableau)) funout(paste(get("msg",envir=envir_stacomi)$BilanMigrationConditionEnv.5,
nrow(tableau),
get("msg",envir=envir_stacomi)$BilanMigrationConditionEnv.6,
- length(duree),
+ length(time.sequence),
")\n"),arret=TRUE)
- #si la jointure � rajoute des lignes �a craint je ne sais pas comment se fera le traitement
+ #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,duree,taxon,stade,stations)
+ fungraph_env(tableau,time.sequence,taxon,stade,stations)
} # end else
}# end function
Modified: pkg/stacomir/R/BilanMigrationInterAnnuelle.r
===================================================================
--- pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2016-08-24 15:20:59 UTC (rev 176)
@@ -160,7 +160,7 @@
dat=bilanMigrationInterAnnuelle at data
dat<-dat[dat$bjo_labelquantite=="Effectif_total",]
dat<-stacomirtools::chnames(dat,c("bjo_annee","bjo_jour","bjo_labelquantite","bjo_valeur"), c("annee","jour","labelquantite","valeur"))
- # il faut un champ date, on ramene tout les monde �
+ # il faut un champ date, on ramene tout les monde e
dat$jour = as.POSIXct(strptime(strftime(dat$jour,'2000-%m-%d %H:%M:%S'),format='%Y-%m-%d %H:%M:%S'),tz="GMT")
dat$annee=as.factor(dat$annee)
@@ -276,11 +276,11 @@
to=strptime("2000-12-31",format='%Y-%m-%d'),
by=getvalue(new("Refperiode"),timesplit))
seq_timesplit<-as.Date(trunc(seq_timesplit, digits='days'))
- # utilise la classe Refperiode pour avoir la correspondance entre le nom fran�ais et la variable utilisee par seq.POSIXt
+ # utilise la classe Refperiode pour avoir la correspondance entre le nom franeais et la variable utilisee par seq.POSIXt
#datc=data.frame(rep(seq_timesplit,length(unique(dat$annee))),sort(rep(unique(dat$annee),length(seq_timesplit)))) # dataframe pour cumuls par periodes
#colnames(datc)<-c(timesplit,"annee")
# calcul des sommes par annee et par periode
- dat[,timesplit]<-dat$jour # pour avoir le format sinon renvoit un num�rique
+ dat[,timesplit]<-dat$jour # pour avoir le format sinon renvoit un numerique
# ci dessous on remplace une double boucle par un truc plus rapide
for (j in 1:(length(seq_timesplit)-1)){
dat[dat$jour>=seq_timesplit[j]&dat$jour<seq_timesplit[j+1],timesplit]<-seq_timesplit[j]
@@ -298,7 +298,7 @@
jour2000=as.Date(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'))
for (j in unique(dat$annee)){
- # les jours qui n'ont pas de bilan journalier pour ce jour sont rajout�s avec z�ro
+ # 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"]]
dat0=data.frame("jour"=jour2000restant,"annee"=j, "valeur"=NA)
dat=rbind(dat,dat0)
@@ -314,7 +314,7 @@
datsummary[,timesplit]<-names(maxdat)[!is.infinite(maxdat)]
dat[,timesplit]<-as.character(dat[,timesplit])
dat<-merge(dat,datsummary,by=timesplit)
- dat[,timesplit]<-as.POSIXct(strptime(dat[,timesplit],format='%Y-%m-%d')) # le format Posixct est n�cessaire pour les ggplot
+ dat[,timesplit]<-as.POSIXct(strptime(dat[,timesplit],format='%Y-%m-%d')) # le format Posixct est necessaire pour les ggplot
rm(maxdat,mindat,meandat)
dat<-dat[order(dat$annee,dat[,timesplit]),]
# renvoit la premiere occurence qui correspond, pour n'importe quel jour min, max et moyenne sont OK
@@ -447,7 +447,7 @@
########################################
-# Fonction similaire � la pr�c�dente mais pointrange et geom_bar
+# Fonction similaire e la precedente mais pointrange et geom_bar
# interannuelle hebdomadaire. fonctionne pour mensuelle et quizaine et hebdomadaire
############################################
hgraphBilanMigrationInterAnnuelle5 = function(h,...)
@@ -470,8 +470,8 @@
# 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 ann�es pour le calcul de range qui s'ajoutent
- # et viennent d'autres ann�es, il faut donc r�ordonner.
+ newdat=newdat[order(newdat[,"keeptimesplit"]),] # il peut y avoir des annees pour le calcul de range qui s'ajoutent
+ # et viennent d'autres annees, il faut donc reordonner.
# dat[,timesplit]<-gdata::reorder(dat[,timesplit], new.order=match(levels(dat[,timesplit]),newdat[,timesplit]))
# levels(dat[,timesplit])<-newdat[,timesplit]
# levels(newdat[,timesplit])<-newdat[,timesplit]
@@ -510,8 +510,8 @@
} # end if
} # end function
-# graphique des cumuls interannuels pour distinguer des tendances saisonni�res, les donn�es sont calcul�es par
-# quinzaine puis centr�es r�duites
+# graphique des cumuls interannuels pour distinguer des tendances saisonnieres, les donnees sont calculees par
+# quinzaine puis centrees reduites
hgraphBilanMigrationInterAnnuelle7 = function(h,...)
{
bilanMigrationInterAnnuelle = charge(bilanMigrationInterAnnuelle)
Modified: pkg/stacomir/R/BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMult.r 2016-08-23 09:58:46 UTC (rev 175)
+++ pkg/stacomir/R/BilanMigrationMult.r 2016-08-24 15:20:59 UTC (rev 176)
@@ -54,7 +54,7 @@
rep2=length(object at taxons)>=1
rep3=length(object at stades)>=1
# rep3=length(object at pasDeTemps)==1
- #rep4=(object at pasDeTemps@nbPas==365) # contrainte : pendant 365j
+ #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)]))
@@ -160,24 +160,24 @@
bilanMigrationMult=connect(bilanMigrationMult)
cat(stringr::str_c("nrow=",nrow(bilanMigrationMult at data)))
- bilanMigrationMult at data$duree=difftime(bilanMigrationMult at data$ope_date_fin,
+ bilanMigrationMult at data$time.sequence=difftime(bilanMigrationMult at data$ope_date_fin,
bilanMigrationMult at data$ope_date_debut,
units="days")
debut=bilanMigrationMult at pasDeTemps@dateDebut
fin=DateFin(bilanMigrationMult at pasDeTemps)
time.sequence<-seq.POSIXt(from=debut,to=fin,
- by=as.numeric(bilanMigrationMult at pasDeTemps@dureePas))
+ by=as.numeric(bilanMigrationMult at pasDeTemps@stepDuration))
bilanMigrationMult at time.sequence<-time.sequence
lestableaux<-list()
for (dic in unique(bilanMigrationMult at data$ope_dic_identifiant)) {
datasub<-bilanMigrationMult at data[bilanMigrationMult at data$ope_dic_identifiant==dic,]
- if (any(datasub$duree>(bilanMigrationMult at pasDeTemps@dureePas/86400))){
+ if (any(datasub$time.sequence>(bilanMigrationMult at pasDeTemps@stepDuration/86400))){
#----------------------
# bilans avec overlaps
#----------------------
data<-fun_bilanMigrationMult_Overlaps(time.sequence = time.sequence, datasub = datasub,negative=negative)
- # pour compatibilit� avec les bilanMigration
+ # pour compatibilite avec les bilanMigration
data$taux_d_echappement=-1
lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
lestableaux[[stringr::str_c("dc_",dic)]][["method"]]<-"overlaps"
@@ -189,7 +189,7 @@
data$coe_date_debut<-as.Date(data$debut_pas)
data<-merge(data,coe,by="coe_date_debut")
data<-data[,-1] # removing coe_date_debut
- data <-fun_weight_conversion(tableau=data,duree=bilanMigrationMult at time.sequence)
+ data <-fun_weight_conversion(tableau=data,time.sequence=bilanMigrationMult at time.sequence)
}
lestableaux[[stringr::str_c("dc_",dic)]][["data"]]<-data
@@ -208,7 +208,7 @@
lestableaux[[stringr::str_c("dc_",dic)]][["negative"]]<-negative
}
} # end for dic
- # TODO developper une m�thode pour sumneg
+ # TODO developper une methode pour sumneg
bilanMigrationMult at calcdata<-lestableaux
assign("bilanMigrationMult",bilanMigrationMult,envir_stacomi)
funout(get("msg",envir_stacomi)$BilanMigrationMult.3)
@@ -223,7 +223,7 @@
#' @return BilanMigrationMult with slot @data filled from the database
#' @export
setMethod("connect",signature=signature("BilanMigrationMult"),definition=function(object,...){
- # r�cuperation du BilanMigration
+ # recuperation du BilanMigration
bilanMigrationMult<-object
# retrieve the argument of the function and passes it to bilanMigrationMult
# easier to debug
@@ -266,7 +266,7 @@
req<-stacomirtools::connect(req)
bilanMigrationMult at data=req at query
- # r�cuperation des coefficients si il y a des civelles dans le bilan
+ # recuperation des coefficients si il y a des civelles dans le bilan
if (2038%in%bilanMigrationMult at taxons@data$tax_code&'CIV'%in%bilanMigrationMult at stades@data$std_code){
req=new("RequeteODBCwheredate")
req at baseODBC<-get("baseODBC",envir=envir_stacomi)
@@ -288,7 +288,7 @@
})
-
+
#' handler for graphe method in BilanMigrationMult class
#'
#' internal use
@@ -301,95 +301,218 @@
} else {
funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
}
- plot(bilanMigrationMult)
+ plot(x=bilanMigrationMult,type="standard")
}
#' Main plot method
#'
-#' calls \link{fungraph} et \link{fungraph_civelle} functions to plot as many "bilanmigration"
-#' as needed
-#' @note the function will test for the existence of data for one dc, one taxa, and one stage
-#' before running
-#' @param x the bilanMigration
-#' @param y=null to conform with plot method
-#' @param ...
+#' \itemize{
+#' \item{plot.type="standard"}{calls \code{\link{fungraph}} and \code{\link{fungraph_civelle}} functions to plot as many "bilanmigration"
+#' as needed, the function will test for the existence of data for one dc, one taxa, and one stage}
+#' \item{plot.type="step"}{creates Cumulated graphs for BilanMigrationMult. Data are summed per day for different dc taxa and stages}
+#' \item{plot.type="multiple"}{Method to overlay graphs for BilanMigrationMult (multiple dc/taxa/stage in the same plot)}
+#' }
+#' @usage plot(x,y,plot.type=c("standard","step","multiple"))
+#' @param x An object of class BilanMigrationMult
+#' @param y From the formals but missing
+#' @param plot.type Defaut to \code{standard} the standard BilanMigration with dc and operation displayed, can also be \code{step} or
+#' \code{multiple}
+#' @param ... Additional arguments, see \code{plot}, \code{plot.default} and \code{par}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-setMethod("plot",signature=signature("BilanMigrationMult"),definition=function(x,y=null,...){
- bilanMigrationMult<-x
- 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)
- #&&&&&&&&&&&&&&&&&&&&&&&&&debut de boucle&&&&&&&&&&&&&&&&&&&&&&&&&&&
- for (dcnum in 1:length(lesdc)){
- for (taxonnum in 1:nrow(lestaxons)){
- for (stadenum in 1:nrow(lesstades)){
+#' @export
+#method.skeleton("plot", "BilanMigrationMult")
+# getGeneric("plot")
+# showMethods("plot")
+# methods("plot")
+setMethod("plot",signature(x = "BilanMigrationMult",y = "ANY"),definition=function(x, y="standard",...){
+ #browser()
+ print("entering plot function")
+ #bilanMigrationMult<-bMM_Arzal
+ plot.type<-y
+ bilanMigrationMult<-x
+ lestaxons= bilanMigrationMult at taxons@data
+ lesstades= bilanMigrationMult at stades@data
+ lesdc=as.numeric(bilanMigrationMult at dc@dc_selectionne)
+ #==========================type=1=============================
+ if (plot.type=="standard"){
+ print("plot type standard")
+ funout(get("msg",envir_stacomi)$BilanMigration.9)
+ #dcnum=2
+ #&&&&&&&&&&&&&&&&&&&&&&&&&debut de boucle&&&&&&&&&&&&&&&&&&&&&&&&&&&
+ for (dcnum in 1:length(lesdc)){
+ for (taxonnum in 1:nrow(lestaxons)){
+ for (stadenum in 1:nrow(lesstades)){
+
+ taxon=lestaxons[taxonnum,"tax_nom_latin"]
+ stade=lesstades[stadenum,"std_libelle"]
+ dc=lesdc[dcnum]
+ print(paste(taxon,stade,dc))
+ # preparation du jeu de donnees pour la fonction fungraph_civ
+ #developpee pour la classe BilanMigration
+ data<-bilanMigrationMult at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
+ data<-data[data$lot_tax_code==lestaxons[taxonnum,"tax_code"] &
+ data$lot_std_code==lesstades[stadenum,"std_code"],]
+
+ if (!is.null(data)){
+ if (nrow(data)>0){
+
+ funout(paste("dc=",dc,
+ taxon,
+ stade))
+ if (any(duplicated(data$No.pas))) stop("duplicated values in No.pas")
+ data_without_hole<-merge(
+ data.frame(No.pas=as.numeric(strftime(bilanMigrationMult at time.sequence,format="%j"))-1,
+ debut_pas=bilanMigrationMult at time.sequence),
+ data,
+ by=c("No.pas","debut_pas"),
+ all.x=TRUE
+ )
+ data_without_hole$CALCULE[is.na(data_without_hole$CALCULE)]<-0
+ data_without_hole$MESURE[is.na(data_without_hole$MESURE)]<-0
+ data_without_hole$EXPERT[is.na(data_without_hole$EXPERT)]<-0
+ data_without_hole$PONCTUEL[is.na(data_without_hole$PONCTUEL)]<-0
+ if (bilanMigrationMult at calcdata[[stringr::str_c("dc_",dc)]][["contient_poids"]]&
+ taxon=="Anguilla anguilla"&
+ stade=="civelle") {
+ #----------------------------------
+ # bilan migration avec poids (civelles
+ #-----------------------------------------
+ grDevices::X11()
+ fungraph_civelle(bilanMigration=bilanMigrationMult,
+ table=data_without_hole,
+ time.sequence=bilanMigrationMult at time.sequence,
+ taxon=taxon,
+ stade=stade,
+ dc=dc,
+ ...)
+ } else {
+ #----------------------------------
+ # bilan migration standard
+ #-----------------------------------------
+ grDevices::X11()
+ fungraph(bilanMigration=bilanMigrationMult,
+ tableau=data_without_hole,
+ time.sequence=bilanMigrationMult at time.sequence,
+ taxon,
+ stade,
+ dc,
+ ...)
+ }
+ } # end nrow(data)>0
+ # ecriture du bilan journalier, ecrit aussi le bilan mensuel
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 176
More information about the Stacomir-commits
mailing list