[Stacomir-commits] r282 - in pkg/stacomir: R data inst/config inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Feb 3 15:15:04 CET 2017
Author: briand
Date: 2017-02-03 15:15:04 +0100 (Fri, 03 Feb 2017)
New Revision: 282
Added:
pkg/stacomir/data/bmi_vichy.rda
Modified:
pkg/stacomir/R/BilanMigrationInterAnnuelle.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/R/utilitaires.r
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R
Log:
Modified: pkg/stacomir/R/BilanMigrationInterAnnuelle.r
===================================================================
--- pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2017-02-03 11:40:59 UTC (rev 281)
+++ pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2017-02-03 14:15:04 UTC (rev 282)
@@ -36,7 +36,7 @@
data=data.frame(),
anneeDebut=new("RefAnnee"),
anneeFin=new("RefAnnee"),
- calcdata="list"
+ calcdata=list()
)
)
@@ -218,36 +218,37 @@
#' 'devenir' i.e. the destination of the fishes.
#' @return BilanMigration with calcdata slot filled.
#' @export
-setMethod("calcule",signature=signature("BilanMigrationInterannuelle"),definition=function(object,silent=FALSE){
- #bilanMigrationInterAnnuelle<-bmi;silent=FALSE
+setMethod("calcule",signature=signature("BilanMigrationInterAnnuelle"),definition=function(object,silent=FALSE,timesplit="mois"){
+ #bilanMigrationInterAnnuelle<-bmi_vichy;silent=FALSE
#require(dplyr)
- bilanMigrationInterAnnuelle<-object
- calcdata<-list()
- dic<-bilanMigrationInterAnnuelle at dc@dc_selectionne
- for (i in 1:length(dic)){
- #i=1
- station=bilanMigrationInterAnnuelle at dc@station[i]
- datadic<-bilanMigrationInterAnnuelle at data[bilanMigrationInterAnnuelle at data$bjo_dis_identifiant==dic[i]&bilanMigrationInterAnnuelle at data$bjo_labelquantite=="Effectif_total",]
- datadic<-funtraitementdate(datadic, nom_coldt = "bjo_jour", jour_an = TRUE, quinzaine = TRUE)
-
- Hmisc::wtd.mean(as.numeric(datadic$jour_365),
- weights=datadic$bjo_valeur)
-
- fnquant<-function(data, probs=c(0, .05, .5, .95, 1)){
- res<-Hmisc::wtd.quantile(x=as.numeric(data$jour_365),
- weights=data$bjo_valeur,
- probs=probs)
- return(res)
- }
- fnquant(datadic)
- dat<-dplyr::select(datadic,bjo_annee,bjo_tax_code,bjo_std_code,bjo_valeur,jour_365)%>%
- group_by(bjo_annee,bjo_tax_code,bjo_std_code)
- dat2<-dat%>% do(res=fnquant(data= .,probs=c(0, .05, .5, .95, 1)))
- dat3<-dat2%>%summarize(bjo_annee,bjo_tax_code,bjo_std_code,Q0=res[[1]],Q5=res[[2]],Q50=res[[3]])
- dat3$station<-station
- dat3$dc<-dic
- bilanMigrationInterAnnuelle at calcdata[[dic]]<-dat3
+ if (!timesplit%in%c("month","mois","week","semaine","month","mois","quinzaine","2 weeks")) stop (
+ stringr::str_c("timesplit should be one of :","month","mois","week","semaine","month","mois","quinzaine","2 weeks"))
+ # back to french labels for consistency with fundat code
+ timesplit<-switch(timesplit,"week"="semaine","month"="mois","2 weeks"="quinzaine",timesplit)
+
+ bilanMigrationInterAnnuelle<-object
+ station<-bilanMigrationInterAnnuelle at dc@station
+ if(length(unique(bilanMigrationInterAnnuelle at dc@station))!=1) stop("You have more than one station in the Bilan, the dc from the Bilan should belong to the same station")
+ datadic<-bilanMigrationInterAnnuelle at data[
+ bilanMigrationInterAnnuelle at data$bjo_labelquantite=="Effectif_total",]
+ datadic<-funtraitementdate(datadic, nom_coldt = "bjo_jour", jour_an = TRUE, quinzaine = TRUE)
+
+ fnquant<-function(data, probs=c(0, .05, .5, .95, 1)){
+ res<-Hmisc::wtd.quantile(x=as.numeric(data$jour_365),
+ weights=data$bjo_valeur,
+ probs=probs)
+ return(res)
}
+ fnquant(datadic)
+ dat<-dplyr::select(datadic,bjo_annee,bjo_dis_identifiant,bjo_tax_code,bjo_std_code,bjo_valeur,jour_365)%>%
+ dplyr::group_by(bjo_annee,bjo_tax_code,bjo_std_code)
+ dat2<-dat%>% do(res=fnquant(data= .,probs=c(0, .05, .5, .95, 1)))
+ dat3<-dat2%>%summarize(bjo_annee,bjo_tax_code,bjo_std_code,Q0=res[[1]],Q5=res[[2]],
+ Q50=res[[3]],Q95=res[[4]],Q100=res[[5]])
+
+ dat3$d90<-dat3$Q95-dat3$Q5
+ dat3$station<-unique(station)
+ bilanMigrationInterAnnuelle at calcdata<-dat3
return(bilanMigrationInterAnnuelle)
})
@@ -267,6 +268,7 @@
#' \item{plot.type="barchart": comparison of daily migration of one year against periodic migration for the other years available in the chronicle,
#' different periods can be chosen with argument timesplit}
#' \item{plot.type="pointrange": Pointrange graphs, different periods can be chosen with argument timesplit}
+#' \item{plot.type="seasonal": plot to display summary statistics about the migration period}
#' }
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @aliases plot.BilanMigrationInterAnnuelle plot.bilanMigrationInterAnnuelle plot.bmi
@@ -607,7 +609,12 @@
if (!silent) funout(gettext("Warning : you have to complete a migration summary for at least one of the selected year before launching a inter-annual summary",domain="R-stacomiR"))
}
- } else {
+ } else if (plot.type=="seasonal"){
+ if (!silent& nrow(bilanmigrationinterannuelle at calcdata)==0) stop("You should run calculation before plotting seasonal data")
+
+ }
+
+ else { # end if
stop ("plot.type argument invalid")
}
Modified: pkg/stacomir/R/stacomi.r
===================================================================
--- pkg/stacomir/R/stacomi.r 2017-02-03 11:40:59 UTC (rev 281)
+++ pkg/stacomir/R/stacomi.r 2017-02-03 14:15:04 UTC (rev 282)
@@ -309,6 +309,8 @@
#' @importFrom lubridate round_date
#' @importFrom lubridate floor_date
#' @importFrom lubridate %m+%
+#' @importFrom lubridate isoweek
+#' @importFrom Hmisc wtd.quantile
#' @importFrom mgcv gam
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @examples
Modified: pkg/stacomir/R/utilitaires.r
===================================================================
--- pkg/stacomir/R/utilitaires.r 2017-02-03 11:40:59 UTC (rev 281)
+++ pkg/stacomir/R/utilitaires.r 2017-02-03 14:15:04 UTC (rev 282)
@@ -326,6 +326,7 @@
mois=TRUE,
quinzaine=FALSE,
semaine=TRUE,
+ semaine_std=FALSE,
jour_an=FALSE,
jour_mois=TRUE,
heure=FALSE
@@ -344,5 +345,6 @@
# %d : Day of the month as decimal number (01e31).
if (heure)data$jour_mois=as.factor(strftime(as.POSIXlt(data[,nom_coldt]),format="%H"))
#%H Hours as decimal number (00e23).
+ if (semaine_std) data$semaine_std=lubridate::isoweek(as.POSIXlt(data[,nom_coldt]))
return(data)
}
\ No newline at end of file
Added: pkg/stacomir/data/bmi_vichy.rda
===================================================================
(Binary files differ)
Property changes on: pkg/stacomir/data/bmi_vichy.rda
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Modified: pkg/stacomir/inst/config/generate_data.R
===================================================================
--- pkg/stacomir/inst/config/generate_data.R 2017-02-03 11:40:59 UTC (rev 281)
+++ pkg/stacomir/inst/config/generate_data.R 2017-02-03 14:15:04 UTC (rev 282)
@@ -456,3 +456,34 @@
bilan_adm at dc@data[,"dif_localisation"]<-iconv(bilan_adm at dc@data[,"dif_localisation"],from="latin1",to="UTF8")
bilan_adm at data[,"car_valeur_quantitatif"]<-bilan_adm at data[,"car_valeur_quantitatif"]*10
devtools::use_data(bilan_adm,internal=FALSE,overwrite=TRUE)
+
+
+#################################
+# generates dataset for BilanMigrationInterannuelle with two dc
+##################################
+setwd("F:/workspace/stacomir/pkg/stacomir")
+require(stacomiR)
+stacomi(gr_interface=FALSE,
+ login_window=FALSE,
+ database_expected=FALSE)
+bmi_vichy<-new("BilanMigrationInterAnnuelle")
+baseODBC<-get("baseODBC",envir=envir_stacomi)
+baseODBC[c(2,3)]<-rep("logrami",2)
+assign("baseODBC",baseODBC,envir_stacomi)
+sch<-get("sch",envir=envir_stacomi)
+assign("sch","logrami.",envir_stacomi)
+
+bmi_vichy<-choice_c(bmi_vichy,
+ dc=c(107,108),
+ taxons=c("Salmo salar"),
+ stades=c("5"),
+ anneedebut="1997",
+ anneefin="2012",
+ silent=FALSE)
+bmi_vichy<-connect(bmi_vichy)
+bmi_vichy at dc@data[,"ouv_libelle"]<-iconv(bmi_vichy at dc@data[,"ouv_libelle"],from="latin1",to="UTF8")
+bmi_vichy at dc@data[,"dis_commentaires"]<-iconv(bmi_vichy at dc@data[,"dis_commentaires"],from="latin1",to="UTF8")
+bmi_vichy at dc@data[,"type_df"]<-iconv(bmi_vichy at dc@data[,"type_df"],from="latin1",to="UTF8")
+bmi_vichy at dc@data[,"type_dc"]<-iconv(bmi_vichy at dc@data[,"type_dc"],from="latin1",to="UTF8")
+bmi_vichy at dc@data[,"dif_localisation"]<-iconv(bmi_vichy at dc@data[,"dif_localisation"],from="latin1",to="UTF8")
+devtools::use_data(bmi_vichy,internal=FALSE,overwrite=TRUE)
Modified: pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R 2017-02-03 11:40:59 UTC (rev 281)
+++ pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R 2017-02-03 14:15:04 UTC (rev 282)
@@ -95,4 +95,6 @@
ggplot2::ggtitle("Cumulated migration step plot at les Enfrenaux eel trap")
}
-}
\ No newline at end of file
+}
+data("bmi_vichy")
+bmi_vichy<-calcule(bmi_vichy)
More information about the Stacomir-commits
mailing list