[Stacomir-commits] r271 - in pkg/stacomir: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Feb 2 10:49:32 CET 2017
Author: briand
Date: 2017-02-02 10:49:32 +0100 (Thu, 02 Feb 2017)
New Revision: 271
Modified:
pkg/stacomir/DESCRIPTION
pkg/stacomir/R/Bilan_poids_moyen.r
pkg/stacomir/R/RefListe.r
pkg/stacomir/R/fungraph.r
pkg/stacomir/R/interface_bilan_poids_moyen.r
Log:
corrections for bilanpoidsmoyen, bug in graph bilanmigration (fungraph)
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2017-02-01 12:48:12 UTC (rev 270)
+++ pkg/stacomir/DESCRIPTION 2017-02-02 09:49:32 UTC (rev 271)
@@ -1,12 +1,13 @@
Package: stacomiR
-Version: 0.5.0
-Date: 2017-01-24
+Version: 0.5.1
+Date: 2017-02-01
Title: Fish Migration Monitoring (stacomiR)
Authors at R: c(person("Cedric", "Briand", role = c("aut", "cre"), email = "cedric.briand00 at gmail.com"),
- person("Marion", "Legrand", role = "aut", email="tableau-salt-loire at logrami.fr"))
+ person("Marion", "Legrand", role = "aut", email="tableau-salt-loire at logrami.fr"),
+ person("Timothee", "Besse", role = "aut", email="tableau-ang-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.5.0 is
+ monitoring. It is a part of the STACOMI open source project developed in France by the ONEMA
+ institute to centralize data obtained by fishway monitoring. Version 0.5.1 is
available in French English and Spanish.
License: GPL (>= 2)
Collate:
@@ -110,6 +111,7 @@
viridis
Author: Cedric Briand [aut, cre],
Marion Legrand [aut]
+ Timothee Besse [aut]
Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
RoxygenNote: 5.0.1
NeedsCompilation: no
Modified: pkg/stacomir/R/Bilan_poids_moyen.r
===================================================================
--- pkg/stacomir/R/Bilan_poids_moyen.r 2017-02-01 12:48:12 UTC (rev 270)
+++ pkg/stacomir/R/Bilan_poids_moyen.r 2017-02-02 09:49:32 UTC (rev 271)
@@ -175,18 +175,20 @@
bilPM<-charge(bilPM)
bilPM<-connect(bilPM)
bilPM<-calcule(bilPM)
+
}
+
#' Calcule method for Bilan_poids_moyen
#' @param object An object of class \code{\link{Bilan_poids_moyen-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}
setMethod("calcule",signature=signature("Bilan_poids_moyen"),definition=function(object,silent=FALSE) {
+ bilPM<-object
donnees <-bilPM at data
coeff <-bilPM at coe@data
coeff$w <-1/coeff$coe_valeur_coefficient
coeff$date <-as.POSIXct(coeff$coe_date_debut)
- assign("bilan_poids_moyen",bilPM,envir_stacomi)
if (!silent) funout(gettext("To obtain the table, type : bilan_poids_moyen=get('bilan_poids_moyen',envir_stacomi)@data\n",domain="R-stacomiR"))
# changement des noms
donnees<-stacomirtools::chnames(donnees,c("lot_identifiant","ope_date_debut","ope_date_fin",
@@ -228,6 +230,7 @@
plot.type="point",
silent=FALSE) {
#plot.type="1";silent=FALSE
+ #bilPM=get('bilan_poids_moyen',envir_stacomi)
bilPM<-x
don<-bilPM at calcdata$data
coe<-bilPM at calcdata$coe
@@ -243,6 +246,7 @@
# standard plot
##################
} else if (plot.type==2){
+ if (length(bilPM at liste@selectedvalue)==0) stop("Internal error, the value has not been selected before launching plot")
type_poids= switch (bilPM at liste@selectedvalue,
">1"=gettext("wet weights",domain="R-stacomiR"),
"=1"=gettext("dry weights",domain="R-stacomiR"),
@@ -254,7 +258,9 @@
main=gettextf("Seasonal trend of %s, from %s to %s",
type_poids,
bilPM at anneedebut@annee_selectionnee,
- bilPM at anneefin@annee_selectionnee,domain="R-stacomiR"))
+ bilPM at anneefin@annee_selectionnee,domain="R-stacomiR"),
+ sub="Trend of wet weights")
+ coe<-coe[order(coe$date),]
points(coe$date,coe$w,type="l",col="black",lty=2)
#legend("topright",c("Obs.", "Coeff base"), col=c("black","cyan"),pch="o",cex = 0.8)
@@ -268,6 +274,16 @@
if (!silent) funout(gettext("object p assigned to envir_stacomi",domain="R-stacomiR"))
}
})
+
+
+#' Internal handler for reg, class \code{\link{Bilan_poids_moyen-class}}.
+#' @param h handler
+#' @param \dots additional arguments passed to the function
+ hreg = function(h,...) {
+ bilPM<-get("bilan_poids_moyen",envir=envir_stacomi)
+ model(bilPM,model.type=h$action)
+ }
+
#' model method for Bilan_poids_moyen'
#' this method uses samples collected over the season to model the variation in weight of
@@ -306,16 +322,14 @@
don<-bilPM at calcdata$data
coe<-bilPM at calcdata$coe
seq=seq(as.Date(bilPM at coe@datedebut),as.Date(bilPM at coe@datefin),by="day")
- origine<-as.POSIXct(trunc(min(don$date),"day"))
-
+ origine<-as.POSIXct(trunc(min(don$date),"day"))
# season starting in november
fndate<-function(data){
if (!"date"%in%colnames(data)) stop ("date should be in colnames(data)")
if (!class(data$date)[1]=="POSIXct") stop("date should be POSIXct")
data$year<-lubridate::year(data$date)
data$yday=lubridate::yday(data$date)
- data$doy=data$yday-305 # year begins in november
-
+ data$doy=data$yday-305 # year begins in november
data$season<-stringr::str_c(lubridate::year(data$date)-1,"-",lubridate::year(data$date)) # year-1-year
data$season[data$doy>0]<-stringr::str_c(lubridate::year(data$date),"-",lubridate::year(data$date)+1)[data$doy>0] # for november and december it's year - year+1
data$yearbis<-data$year # same as season but with a numeric
@@ -475,9 +489,7 @@
assign("import_coe",import_coe,envir=envir_stacomi)
funout(gettext("To obtain the table, type : import_coe=get(import_coe\",envir_stacomi",domain="R-stacomiR"))
funout(paste(gettextf("data directory :%s",fileout,domain="R-stacomiR")))
- bilPM at calcdata[["import_coe"]]<-import_coe
-
-
+ bilPM at calcdata[["import_coe"]]<-import_coe
})
Modified: pkg/stacomir/R/RefListe.r
===================================================================
--- pkg/stacomir/R/RefListe.r 2017-02-01 12:48:12 UTC (rev 270)
+++ pkg/stacomir/R/RefListe.r 2017-02-02 09:49:32 UTC (rev 271)
@@ -51,7 +51,7 @@
setMethod("choice",signature=signature("RefListe"),definition=function(object,is.enabled=TRUE) {
hlist=function(h,...){
valeurchoisie=svalue(choice)
- object at listechoice<-object at listechoice[list_libelle%in%valeurchoisie]
+ object at selectedvalue<-object at listechoice[list_libelle%in%valeurchoisie]
assign("refliste",object,envir_stacomi)
funout(paste(object at label,"\n"))
}
Modified: pkg/stacomir/R/fungraph.r
===================================================================
--- pkg/stacomir/R/fungraph.r 2017-02-01 12:48:12 UTC (rev 270)
+++ pkg/stacomir/R/fungraph.r 2017-02-02 09:49:32 UTC (rev 271)
@@ -57,7 +57,7 @@
bty="l",
ylab=gettext("Number",domain="R-stacomiR"),
xlab=gettext("Date",domain="R-stacomiR"),
- main=gettextf("estimated number, %s, %s, %s, %s",dis_commentaire,taxon,stade,annee),
+ main=gettextf("estimated number, %s, %s, %s, %s",dis_commentaire,taxon,stade,annee,domain="R-stacomiR"),
cex.main=1)
if(bilanMigration at pasDeTemps@stepDuration=="86400"){ # pas de temps journalier
index=as.vector(x[jmois==15])
@@ -68,7 +68,7 @@
axis(side=1)
}
mtext(text=gettextf("Sum of numbers =%s",
- round(sum(tableau$MESURE,tableau$CALCULE,tableau$EXPERT,tableau$PONCTUEL,na.rm=TRUE))),
+ round(sum(tableau$MESURE,tableau$CALCULE,tableau$EXPERT,tableau$PONCTUEL,na.rm=TRUE),domain="R-stacomiR")),
side=3,
col=RColorBrewer::brewer.pal(5,"Paired")[5],
cex=0.8)
@@ -84,9 +84,9 @@
if (!silent){
funout(ngettext(nrow(t_operation_ope),"%d operation \n", "%d operations \n",domain="R-stacomiR"))
- funout(gettextf("average trapping time = %s days\n",round(mean(as.numeric(dif)),2)))
- funout(gettextf("maximum term = %s",round(max(as.numeric(dif)),2)))
- funout(gettextf("minimum term = %s",round(min(as.numeric(dif)),2)))
+ funout(gettextf("average trapping time = %s days\n",round(mean(as.numeric(dif)),2),domain="R-stacomiR"))
+ funout(gettextf("maximum term = %s",round(max(as.numeric(dif)),2),domain="R-stacomiR"))
+ funout(gettextf("minimum term = %s",round(min(as.numeric(dif)),2),domain="R-stacomiR"))
}
@@ -198,7 +198,7 @@
legend (x= debut,
y=1.2,
- legend= c(gettext("stop"),nomperiode,domain="R-stacomiR"),
+ legend= c(gettext("stop",domain="R-stacomiR"),nomperiode),
pch=c(15,15),
col=c(mypalette[4],mypalette[6],mypalette[1:length(listeperiode)]),
bty="n",
Modified: pkg/stacomir/R/interface_bilan_poids_moyen.r
===================================================================
--- pkg/stacomir/R/interface_bilan_poids_moyen.r 2017-02-01 12:48:12 UTC (rev 270)
+++ pkg/stacomir/R/interface_bilan_poids_moyen.r 2017-02-02 09:49:32 UTC (rev 271)
@@ -8,7 +8,7 @@
bilPM at dc=charge(bilPM at dc)
bilPM at anneedebut=charge(bilPM at anneedebut)
bilPM at anneefin=charge(bilPM at anneefin)
- bilPM at liste=charge(object=bilPM at liste,listechoice=c("=1",">1",gettext("all"),domain="R-stacomiR"),label=gettext("choice of number in sample (one, several, all",domain="R-stacomiR"))
+ bilPM at liste=charge(object=bilPM at liste,listechoice=c("=1",">1",gettext("all",domain="R-stacomiR")),label=gettext("choice of number in sample (one, several, both)",domain="R-stacomiR"))
# choice of number type
group <- gWidgets::ggroup(horizontal=FALSE) # must always be named group
assign("group",group,envir = .GlobalEnv)
@@ -42,14 +42,22 @@
add(group, gmenu(toolbarlist))
### second toobar
- aGra=gWidgets::gaction(label=gettext("Gra",domain="R-stacomiR"),action="1",icon="lines",handler=hplot)
- aCoe=gWidgets::gaction(label=gettext("Coe",domain="R-stacomiR"),icon="Coe",handler=hplot,action="2")
- aSize=gWidgets::gaction(label=gettext("Leng",domain="R-stacomiR"),action="3",icon="gWidgetsRGtk2-bubbles",handler=hplot)
- aReg=gWidgets::gaction(label=gettext("Reg",domain="R-stacomiR"),icon="gWidgetsRGtk2-function1",handler=hreg,action="reg")
+ aGra=gWidgets::gaction(label=gettext("Gra",domain="R-stacomiR"),icon="lines",handler=hplot,action="1",
+ tooltip=gettext("plot.type='1', plot of mean weight of glass eel against the mean date of operation",domain="R-stacomiR"))
+ aCoe=gWidgets::gaction(label=gettext("Coe",domain="R-stacomiR"),icon="newplot",handler=hplot,action="2",
+ tooltip=gettext("plot.type=2, standard plot of current coefficent",domain="R-stacomiR"))
+ aSize=gWidgets::gaction(label=gettext("Leng",domain="R-stacomiR"),icon="gWidgetsRGtk2-bubbles",handler=hplot,action="3",
+ tooltip=gettext("plot.type=3, same as 1 but size of the bubble according to number",domain="R-stacomiR"))
+ aReg=gWidgets::gaction(label=gettext("seasonal",domain="R-stacomiR"),icon="function",handler=hreg,action="seasonal",
+ tooltip=gettext("model.type='seasonal', sine wave curve for a cyclic variation fitted with nls",domain="R-stacomiR"))
+ aReg1=gWidgets::gaction(label=gettext("seasonal1",domain="R-stacomiR"),icon="function1",handler=hreg,action="seasonal1",
+ tooltip=gettext("model.type='seasonal1', long term variation along with seasonal variation fitted with gam",domain="R-stacomiR"))
+ aReg2=gWidgets::gaction(label=gettext("seasonal2",domain="R-stacomiR"),icon="function",handler=hreg,action="seasonal2",
+ tooltip=gettext("model.type='seasonal2', long term variation + seasonal component fitted with sine curve",domain="R-stacomiR"))
aExp=gWidgets::gaction(label=gettext("export",domain="R-stacomiR"),icon="gtk-harddisk",handler=hexp)
toolbarlistgraph <- gmenu(list(gra=aGra,coe=aCoe,size=aSize))
assign("toolbarlistgraph",toolbarlistgraph,.GlobalEnv)
- toolbarlistgraph1<-gmenu(list(reg=aReg,exp=aExp))
+ toolbarlistgraph1<-gmenu(list(reg=aReg,reg1=aReg1,reg2=aReg2,exp=aExp))
assign("toolbarlistgraph1",toolbarlistgraph1,.GlobalEnv)
add(group,toolbarlistgraph)
add(group,toolbarlistgraph1)
More information about the Stacomir-commits
mailing list