[Stacomir-commits] r393 - in pkg/stacomir: . R inst/config inst/examples inst/tests/testthat man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Jun 10 21:44:34 CEST 2017
Author: briand
Date: 2017-06-10 21:44:33 +0200 (Sat, 10 Jun 2017)
New Revision: 393
Added:
pkg/stacomir/R/interface_BilanEspeces.r
pkg/stacomir/inst/examples/bilanEspeces_example.R
pkg/stacomir/inst/tests/testthat/test-13BilanAnnuels.R
pkg/stacomir/inst/tests/testthat/test-14BilanEspeces.R
pkg/stacomir/man/calcule-BilanEspeces-method.Rd
pkg/stacomir/man/choice_c-BilanEspeces-method.Rd
pkg/stacomir/man/hbilespcalc.Rd
pkg/stacomir/man/hplotbilesp.Rd
pkg/stacomir/man/hsummarybilesp.Rd
pkg/stacomir/man/plot-BilanEspeces-missing-method.Rd
pkg/stacomir/man/summary-BilanEspeces-method.Rd
Removed:
pkg/stacomir/man/hBilanEspecescalc.Rd
pkg/stacomir/man/hCamembert.Rd
pkg/stacomir/man/hTableBilanEspeces.Rd
Modified:
pkg/stacomir/DESCRIPTION
pkg/stacomir/NAMESPACE
pkg/stacomir/R/BilanEspeces.r
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/Bilan_poids_moyen.r
pkg/stacomir/R/RefAnnee.r
pkg/stacomir/R/interface_BilanMigrationMultConditionEnv.r
pkg/stacomir/inst/config/generate_Roxygen2.R
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/config/testthat.R
pkg/stacomir/man/BilanEspeces-class.Rd
pkg/stacomir/man/calcule-BilanMigration-method.Rd
pkg/stacomir/man/charge-BilanEspeces-method.Rd
pkg/stacomir/man/connect-BilanEspeces-method.Rd
pkg/stacomir/man/interface_BilanEspeces.Rd
pkg/stacomir/man/write_database-Bilan_poids_moyen-method.Rd
Log:
BilanEspeces developpement finished and final check for the package
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2017-06-09 13:55:49 UTC (rev 392)
+++ pkg/stacomir/DESCRIPTION 2017-06-10 19:44:33 UTC (rev 393)
@@ -61,6 +61,7 @@
'interface_BilanAnnuels.r'
'interface_BilanArgentee.r'
'interface_BilanConditionEnv.r'
+ 'interface_BilanEspeces.r'
'interface_BilanFonctionnementDC.r'
'interface_BilanFonctionnementDF.r'
'interface_BilanMigration.r'
Modified: pkg/stacomir/NAMESPACE
===================================================================
--- pkg/stacomir/NAMESPACE 2017-06-09 13:55:49 UTC (rev 392)
+++ pkg/stacomir/NAMESPACE 2017-06-10 19:44:33 UTC (rev 393)
@@ -20,10 +20,6 @@
export(funtableBilan_carlot)
export(funtraitement_poids)
export(funtraitementdate)
-export(hBilanEspecescalc)
-export(hCamembert)
-export(hTableBilanEspeces)
-export(interface_BilanEspeces)
export(mygtkProgressBar)
export(split_per_day)
export(stacomi)
Modified: pkg/stacomir/R/BilanEspeces.r
===================================================================
--- pkg/stacomir/R/BilanEspeces.r 2017-06-09 13:55:49 UTC (rev 392)
+++ pkg/stacomir/R/BilanEspeces.r 2017-06-10 19:44:33 UTC (rev 393)
@@ -1,24 +1,22 @@
-# Nom fichier : BilanEspeces (classe)
-# Projet : controle migrateur calmig/prog/classe
-# Date de creation : 31/03/2008 17:21:18
-
-#' Class "BilanEspeces" Report of the species present at a counting device for
-#' a given period
+#' Class "BilanEspeces" simple migration / number report
#'
-#' this class is used to make the assessment of all species, and their number,
-#' per month it writes either an histogram or a pie chart of number per
-#' year/week/month
-#' @slot dc an object of class \link{RefDC-class} inherited from \link{BilanMigration-class}
-#' @slot horodate \link{RefHorodate-class}
-#' @slot datedebut A \link[base]{-.POSIXt} value
-#' @slot datefin A \link[base]{-.POSIXt} value
+#' This class is used to make the assessment of all species, and their number. It is intended
+#' as a simple way to check what fishes are present (taxa + development stage). Unlike the BilanAnnuels,
+#' it is not restricted on chosen taxa or stages but gives counts for all species present. The taxa is reported unless
+#' a taxa has several case, in which case the different stages for the taxa will be reported
+#' Using the split arguments
+#' the calc method of the class will count numbers, subsamples are not accounted for in the Overview.
+#' The split argument currently takes values year or month. The class is intended to be used over long periods
+#' e.g years. The plot method writes either an histogram or a pie chart of number per
+#' year/week/month.
+#' @slot dc an object of class \link{RefDC-class}
+#' @slot anneedebut Object of class \code{\link{RefAnnee-class}}
+#' @slot anneefin Object of class \code{\link{RefAnnee-class}}
#' @slot data \code{data.frame}
-#' @slot liste Object of class \code{\link{RefListe-class}} RefListe referential
-#' class choose within a list
+#' @slot calcdata \code{data.frame} with data processed by the calc method
+#' @slot split Object of class \code{\link{RefListe-class}} RefListe referential class choose within a list
#' @include RefDC.r
#' @include RefListe.r
-#' @section Objects from the Class: Objects can be created by calls of the form
-#' \code{new("BilanEspeces", ...)}.
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @seealso Other Bilan Classes
#' \code{\linkS4class{Bilan_carlot}},
@@ -31,44 +29,40 @@
#' \code{\linkS4class{BilanMigrationInterAnnuelle}},
#' \code{\linkS4class{BilanMigrationCar}}
#' @family Bilan Objects
+#' @aliases bilanEspeces
#' @keywords classes
#' @export
setClass(Class="BilanEspeces",
representation=
representation(dc="RefDC",
- horodate="RefHorodate",
- datedebut="POSIXlt",
- datefin="POSIXlt",
+ anneedebut="RefAnnee",
+ anneefin="RefAnnee",
data="data.frame",
- liste="RefListe"),
+ calcdata="data.frame",
+ split="RefListe"),
prototype=prototype(dc=new("RefDC"),
- horodate=new("RefHorodate"),
+ anneedebut=new("RefAnnee"),
+ anneefin=new("RefAnnee"),
data=data.frame(),
- liste=new("RefListe")
+ calcdata=data.frame(),
+ split=new("RefListe")
)
)
-setValidity("BilanEspeces",function(object)
- {
- rep1=length(object at dc)==1
- return(ifelse(rep1, TRUE ,c(1:6)[!c(rep1)]))
- }
-)
#' connect method for BilanEspeces
-#' @param object An object of class \link{BilanEspeces-class}
-#' @return bilanEspeces instance with request corresponding to the user choices
+#' @param object An object of class BilanEspeces
+#' @param silent Boolean, if TRUE, information messages are not displayed
+#' @return An object of class BilanEspeces with data slot filled
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("connect",signature=signature("BilanEspeces"),definition=function(object) {
- bilanEspeces<-object # pour faciliter la debug, l'argument formel de la classe doit etre forcement object !
- requete=new("RequeteODBCwheredate")
+setMethod("connect",signature=signature("BilanEspeces"),definition=function(object,silent=FALSE) {
+ bilesp<-object
+ requete=new("RequeteODBC")
requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at datedebut=bilanEspeces at datedebut
- requete at datefin=bilanEspeces at datefin
- requete at colonnedebut="ope_date_debut"
- requete at colonnefin="ope_date_fin"
- requete at select= paste("SELECT lot_identifiant, ope_date_debut, ope_date_fin,",
+ anneedebut= bilesp at anneedebut@annee_selectionnee
+ anneefin=bilesp at anneefin@annee_selectionnee
+ requete at sql= paste("SELECT lot_identifiant, ope_date_debut, ope_date_fin,",
" lot_effectif, lot_tax_code, lot_std_code, tax_nom_latin, std_libelle,",
" date_part('year', ope_date_debut) as annee,",
" date_part('month',ope_date_debut) as mois,",
@@ -77,215 +71,267 @@
" INNER JOIN ",get("sch",envir=envir_stacomi),"t_lot_lot ON ope_identifiant=lot_ope_identifiant",
" INNER JOIN ref.tr_taxon_tax on tax_code=lot_tax_code",
" INNER JOIN ref.tr_stadedeveloppement_std on std_code=lot_std_code",
- sep="")
- requete at and=paste(" AND ope_dic_identifiant=",
- bilanEspeces at dc@dc_selectionne,
+ " WHERE extract(year from ope_date_debut)>=",anneedebut,
+ " AND extract(year from ope_date_debut)<=", anneefin,
+ " AND ope_dic_identifiant in",
+ vector_to_listsql(bilesp at dc@dc_selectionne),
" AND lot_lot_identifiant IS NULL",
" AND lot_effectif IS NOT NULL",
sep="")
requete<-stacomirtools::connect(requete)
- if (requete at etat!="Requete reussie \n") funout(gettext("Query failed for the view vue_ope_lot_car \n",domain="R-stacomiR"),arret=TRUE)
- bilanEspeces at data<-requete at query
- return(bilanEspeces)
+ if (requete at etat!="success") funout(gettext("Query failed for the view vue_ope_lot_car \n",domain="R-stacomiR"),arret=TRUE)
+ bilesp at data<-requete at query
+ if (!silent) funout(gettext("data loaded from the database for BilanEspece"))
+ assign("bilesp",bilesp,envir=envir_stacomi)
+ return(bilesp)
})
-#' handler du calcul du BilanEspeces
-#' realise le calcul du bilan especes, l'ecrit dans l'environnement envir_stacomi
-#' traite eventuellement les quantites de lots (si c'est des civelles)
+
+#' command line interface for \link{BilanEspeces-class}
+#' @param object An object of class \link{BilanEspeces-class}
+#' @param dc A numeric or integer, the code of the dc, coerced to integer,see \link{choice_c,RefDC-method}
+#' @param anneedebut The starting the first year, passed as character or integer
+#' @param anneefin the finishing year
+#' @param split one of c("none","week","month","year")
+#' @param silent Boolean, if TRUE, information messages are not displayed
+#' @return An object of class \link{BilanEspeces-class}
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("choice_c",signature=signature("BilanEspeces"),definition=function(object,
+ dc,
+ split="none",
+ anneedebut,
+ anneefin,
+ silent=FALSE){
+ # code for debug using example
+ #dc=c(5,6);anneedebut="1996";anneefin="2016";split="none";silent=TRUE
+ bilesp<-object
+ bilesp at dc=charge(bilesp at dc)
+ # loads and verifies the dc
+ # this will set dc_selectionne slot
+ bilesp at dc<-choice_c(object=bilesp at dc,dc)
+ # only taxa present in the bilanMigration are used
+ bilesp at split=charge(object=bilesp at split,listechoice=c("none","week","month","year"),label=gettext("choice of number in sample (one, several,all)",domain="R-stacomiR"))# choix de la categorie d'effectif)
+ bilesp at split<-choice_c(bilesp at split,selectedvalue=split)
+ # by default choice_c returns reflist but usefull to mimic gr.interface
+ assign("refliste",bilesp at split,envir_stacomi)
+ bilesp at anneedebut<-charge(object=bilesp at anneedebut,
+ objectBilan="BilanEspeces")
+ bilesp at anneedebut<-choice_c(object=bilesp at anneedebut,
+ nomassign="anneeDebut",
+ annee=anneedebut,
+ silent=silent)
+ bilesp at anneefin@data<-bilesp at anneedebut@data
+ bilesp at anneefin<-choice_c(object=bilesp at anneefin,
+ nomassign="anneeFin",
+ annee=anneefin,
+ silent=silent)
+ assign("bilesp",bilesp,envir=envir_stacomi)
+ return(bilesp)
+ })
+
+#' handler for calculation
+#'
+#' internal use
#' @param h a handler
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @export
-hBilanEspecescalc=function(h,...){
- charge(h$action)
+hbilespcalc=function(h,...){
+ if (exists("bilesp",envir_stacomi)) {
+ bilesp<-get("bilesp",envir_stacomi)
+ } else {
+ funout(gettext("No data named bilesp in envir_stacomi",domain="R-stacomiR"),arret=TRUE)
+ }
+ bilesp<-charge(bilesp)
+ bilesp<-connect(bilesp)
+ bilesp<-calcule(bilesp)
}
#' charge method for BilanEspeces
#' verifies the content of objects and calls the connect method
#' @param object An object of class \link{BilanEspeces-class}
+#' @param silent Stops displaying the messages.
#' @return BilanEspeces with slots filled by user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("charge",signature=signature("BilanEspeces"),definition=function(object){
- funout(gettext("Checking objects and launching query\n",domain="R-stacomiR"))
- bilanEspeces<-object
+setMethod("charge",signature=signature("BilanEspeces"),definition=function(object, silent=FALSE){
+ if (!silent) funout(gettext("Checking objects and launching query\n",domain="R-stacomiR"))
+ bilesp<-object
if (exists("refDC",envir_stacomi)) {
- bilanEspeces at dc<-get("refDC",envir_stacomi)
+ bilesp at dc<-get("refDC",envir_stacomi)
} else {
funout(gettext("You need to choose a counting device, clic on validate\n",domain="R-stacomiR"),arret=TRUE)
}
- # rem pas tres satisfaisant car ce nom est choisi dans l'interface
- if (exists("bilanEspeces_date_debut",envir_stacomi)) {
- bilanEspeces at datedebut<-get("bilanEspeces_date_debut",envir_stacomi)@horodate
+ if (exists("anneeDebut",envir_stacomi)) {
+ bilesp at anneedebut<-get("anneeDebut",envir_stacomi)
} else {
- funout(gettext("You need to choose the starting date\n",domain="R-stacomiR"),arret=TRUE)
+ funout(gettext("You need to choose the starting year\n",domain="R-stacomiR"),arret=TRUE)
+ }
+ if (exists("anneeFin",envir_stacomi)) {
+ bilesp at anneefin<-get("anneeFin",envir_stacomi)
+ } else {
+ funout(gettext("You need to choose the ending year\n",domain="R-stacomiR"),arret=TRUE)
}
- # rem id
- if (exists("bilanEspeces_date_fin",envir_stacomi)) {
- bilanEspeces at datefin<-get("bilanEspeces_date_fin",envir_stacomi)@horodate
- } else {
- funout(gettext("You need to choose the ending date\n",domain="R-stacomiR"),arret=TRUE)
- }
+
if (exists("refliste",envir_stacomi)) {
- bilanEspeces at liste<-get("refliste",envir_stacomi)
+ bilesp at split<-get("refliste",envir_stacomi)
} else {
funout(gettext("You need to choose a size class\n",domain="R-stacomiR"), arret=TRUE)
}
- bilanEspeces<-connect(bilanEspeces)
-
- assign("bilanEspeces",bilanEspeces,envir_stacomi)
- funout(gettext("Summary object is stocked into envir_stacomi environment : write bilanEspeces=get('bilanEspeces',envir_stacomi)\n",domain="R-stacomiR"))
+ assign("bilesp",bilesp,envir_stacomi)
+ if (!silent) funout(gettext("A BilanEspeces object was stored into envir_stacomi environment : write bilesp=get('bilesp',envir_stacomi)",domain="R-stacomiR"))
+ return(bilesp)
})
-#' handler for pie chart
-#' draws a pie chart of species or a pie chart per period
-#' @note no need to re-run calculation if another list has been loaded, negative numbers are converted to positive
+#' handler for plot internal use
#' @param h Handler
-#' @param ... Other parameters passed to the function
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+hplotbilesp = function(h) {
+ bilesp<-get("bilesp",envir_stacomi)
+ plot(bilesp,plot.type=h$action)
+}
+
+#' calcule method for BilanEspeces
+#'
+#' ' the number will be split according to the split argument passed to the class, e.g.
+#' per year or month or week. Data from different DC will be grouped. Counts are given per taxa,
+#' unless there are several stages, in which case the counts correspond to taxa + stage.
+#' @param object An object of class \code{\link{BilanEspeces-class}}
+#' @param silent Boolean, if TRUE, information messages are not displayed, only warnings and errors
+#' @return with calcdata slot filled.
+#' @aliases calcule.BilanEspeces calcule.bilesp
#' @export
+setMethod("calcule",signature=signature("BilanEspeces"),definition=function(object,silent=FALSE){
+ bilesp<-object
+ DC=as.numeric(bilesp at dc@dc_selectionne)
+ # update of refliste which does not need calcul button pushed
+ tableEspeces=bilesp at data
+ if (nrow(tableEspeces)==0) funout(gettext("No fish in the database for this period\n",domain="R-stacomiR"),arret=TRUE)
+ tableEspeces$taxon_stades=paste(tableEspeces$tax_nom_latin,tableEspeces$std_libelle,sep="_")
+ # only keeping taxon stage for species with several stages
+ nbstades=tapply(tableEspeces$tax_nom_latin,tableEspeces$taxon_stades,function(X)(length(unique(X))))
+ # we currently have taxa+stage, below this is replaces with taxa unless there are more than one stage per species
+ if (length(nbstades[nbstades>1])>0){
+ les_multiples=names(nbstades[nbstades>1])
+ tableEspeces[!tableEspeces$taxon_stades%in%les_multiples,"taxon_stades"]<-tableEspeces$tax_nom_latin[!tableEspeces$taxon_stades%in%les_multiples]
+ } else tableEspeces$taxon_stades<-tableEspeces$tax_nom_latin
+ if (min(tableEspeces$lot_effectif)<0) {
+ if (!silent) funout(gettext("Some negative counts are transformed into positive ones\n",domain="R-stacomiR"))
+ tableEspeces$lot_effectif=abs(tableEspeces$lot_effectif)
+ }
+ sumEspeces=switch(bilesp at split@selectedvalue,
+ "year"=as.data.frame(xtabs(lot_effectif~taxon_stades+annee,data=tableEspeces)),
+ "month"=as.data.frame(xtabs(lot_effectif~taxon_stades+mois,data=tableEspeces)),
+ "week"=as.data.frame(xtabs(lot_effectif~taxon_stades+semaine,data=tableEspeces)),
+ "none"=as.data.frame(xtabs(lot_effectif~taxon_stades,data=tableEspeces)))
+ colnames(sumEspeces)[colnames(sumEspeces)=="Freq"]<-"Effectif" # pas forcement le m nb de colonnes
+ if (bilesp at split@selectedvalue!="none"){
+ colnames(sumEspeces)[2]<-bilesp at split@selectedvalue
+ }
+ bilesp at calcdata<-sumEspeces
+ assign("bilesp",bilesp,envir_stacomi)
+ return(bilesp)
+ })
-hCamembert = function(h,...) {
- if (exists("bilanEspeces",envir_stacomi)) {
- bilanEspeces<-get("bilanEspeces",envir_stacomi)
- } else {
- funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
- }
- DC=as.numeric(bilanEspeces at dc@dc_selectionne)
- # update of refliste which does not need calcul button pushed
- bilanEspeces at liste<-get("refliste",envir_stacomi)
-
- tableEspeces=bilanEspeces at data
- if (nrow(tableEspeces)==0) funout(gettext("No fish in the database for this period\n",domain="R-stacomiR"),arret=TRUE)
- tableEspeces$taxon_stades=paste(tableEspeces$tax_nom_latin,tableEspeces$std_libelle,sep="_")
- # only keeping taxon stage for species with several stages
- nbstades=tapply(tableEspeces$tax_nom_latin,tableEspeces$taxon_stades,function(X)(length(unique(X))))
- if (length(nbstades[nbstades>1])>0){
- les_multiples=names(nbstades[nbstades>1])
- tableEspeces[!tableEspeces$taxon_stades%in%les_multiples,"taxon_stades"]<-tableEspeces$tax_nom_latin[!tableEspeces$taxon_stades%in%les_multiples]
- } else tableEspeces$taxon_stades<-tableEspeces$tax_nom_latin
- # TODO ajouter les effectifs en fin de taxons_stades ???
- nb=length(unique(tableEspeces$taxon_stade))
- if (min(tableEspeces$lot_effectif)<0) {funout(gettext("Warning, some negative counts are transformed into positive ones\n",domain="R-stacomiR"))
- tableEspeces$lot_effectif=abs(tableEspeces$lot_effectif)
- }
- sumEspeces=switch(bilanEspeces at liste@listechoice,
- "annee"=as.data.frame(xtabs(lot_effectif~taxon_stades+annee,data=tableEspeces)),
- "mois"=as.data.frame(xtabs(lot_effectif~taxon_stades+mois,data=tableEspeces)),
- "semaine"=as.data.frame(xtabs(lot_effectif~taxon_stades+semaine,data=tableEspeces)),
- "aucun"=as.data.frame(xtabs(lot_effectif~taxon_stades,data=tableEspeces)))
- colnames(sumEspeces)[colnames(sumEspeces)=="Freq"]<-"Effectif" # pas forcement le m nb de colonnes
-# graphique ggplot
-
- g<-ggplot(sumEspeces)
- g<-g+geom_bar(aes(x="",y=Effectif,fill=taxon_stades,width=1),stat="identity") +
- ggtitle(paste("Bilan Especes, DC",bilanEspeces at dc@dc_selectionne,"\n",bilanEspeces at datedebut,"=>",bilanEspeces at datefin))
+#' Plot method for BilanEspeces
+#'
+#' @param x An object of class \link{BilanEspeces-class}
+#' @param plot.type Default pie
+#' #' \itemize{
+#' \item{plot.type="pie": A pie}'
+#' \item{plot.type="barchart" : A barchart}
+#' }
+#' @param color Default NULL, a vector of colors of length corresponding to the number of taxa-stage
+#' different values, use unique(bilesp at calcdata$taxon_stade) to get that number. The color applies to both
+#' pie and barchart plots
+#' @param silent Stops displaying the messages.
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @aliases plot.BilanBilanEspeces plot.bilesp
+#' @export
+setMethod("plot",signature(x = "BilanEspeces", y = "missing"),definition=function(x,
+ plot.type="pie",
+ color=NULL,
+ silent=FALSE)
+ {
+ bilesp<-x
+ if (nrow(bilesp at calcdata)==0) stop("No data in the calcdata slot, did you forget to run calculations ?")
+ nb=length(unique(bilesp at calcdata$taxon_stade))
+ g<-ggplot(bilesp at calcdata)
+ g<-g+geom_col(aes(x="",y=Effectif,fill=taxon_stades)) +
+ ggtitle(paste("Bilan Especes, DC",
+ str_c(bilesp at dc@dc_selectionne,collapse="+"),
+ bilesp at anneedebut@annee_selectionnee,"=>",
+ bilesp at anneefin@annee_selectionnee))+
+ xlab("")+
+ ylab(gettext("Number",domain="R-stacomiR"))
#theme(axis.line.x=element_line("none"))+theme(axis.title.x= element_text("none"))
- if (bilanEspeces at liste@listechoice!="aucun"){
- facet<-switch(bilanEspeces at liste@listechoice,
- "annee"=as.formula(~annee),
- "mois"=as.formula(~mois),
- "semaine"=as.formula(~semaine))
- g<-g+facet_wrap(facet,scales="fixed")
- }
- if (nb<=8) {
- g<-g+scale_fill_brewer(palette="Accent",name="Taxa")
- } else if (nb<=12){
- p<-g+scale_fill_brewer(palette="Set3",name="Taxa")
- }else{
- g<-g+scale_fill_manual(values=grDevices::rainbow(nb))
- }
- if(h$action=="pie"){
- g<-g+ coord_polar(theta="y", start=pi)+xlab('') +ylab('')
- }
- print(g)
- g<<-g
-}
+ if (bilesp at split@selectedvalue!="none"){
+ facet<-switch(bilesp at split@selectedvalue,
+ "year"=as.formula(~year),
+ "month"=as.formula(~month),
+ "week"=as.formula(~week))
+ g<-g+facet_wrap(facet,scales="fixed")
+ }
+ if (is.null(color)){
+ if (nb<=8) {
+ g<-g+scale_fill_brewer(palette="Accent",name=gettext("Taxa-stage",domain="R-stacomiR"))
+ } else if (nb<=12){
+ p<-g+scale_fill_brewer(palette="Set3",name=gettext("Taxa-stage",domain="R-stacomiR"))
+ }else{
+ g<-g+scale_fill_manual(values=grDevices::rainbow(nb),name=gettext("Taxa-stage",domain="R-stacomiR"))
+ }
+ } else { #color is not null
+ if (length(color)!=nb) stop(gettextf("The vector of color should be of length %s",domain="R-stacomiR",nb))
+ g<-g+scale_fill_manual(values=color,gettext("Taxa-stage",domain="R-stacomiR"))
+ }
+ if (plot.type=="barplot"){
+ print(g)
+ assign("g",g,envir=envir_stacomi)
+ } else if(plot.type=="pie"){
+ g<-g+ coord_polar(theta="y",start=pi) +xlab('') +ylab('')
+ print(g)
+ assign("g",g,envir=envir_stacomi)
+ } else {
+ funout(gettext("plot.type should be one of barplot or pie",domain="R-stacomiR"),arret=TRUE)
+ }
+ if (! silent) funout(gettext("the object g has been assigned to envir_stacomi",domain="R-stacomiR"))
+
+ return(invisible(NULL))
+ }
+)
-#' handler du calcul BilanEspeces : traitements
-#' appelle les fonctions funstat et funtable pour faire le bilan des migrations
-#' dans des fichiers csv
+#' handler for summary BilanEspeces, internal use
#' @param h a handler
-#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @export
-hTableBilanEspeces=function(h,...) {
- if (exists("bilanEspeces",envir_stacomi)) {
- bilanEspeces<-get("bilanEspeces",envir_stacomi)
+hsummarybilesp=function(h) {
+ if (exists("bilesp",envir_stacomi)) {
+ bilesp<-get("bilesp",envir_stacomi)
} else {
- funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
+ funout(gettext("No data named bilesp in envir_stacomi",domain="R-stacomiR"),arret=TRUE)
}
- DC=as.numeric(bilanEspeces at dc@dc_selectionne)
- # update of refliste which does not need calcul button pushed
- bilanEspeces at liste<-get("refliste",envir_stacomi)
-
- tableEspeces=bilanEspeces at data
- if (nrow(tableEspeces)==0) funout(gettext("No fish in the database for this period\n",domain="R-stacomiR"),arret=TRUE)
- tableEspeces$taxon_stades=paste(tableEspeces$tax_nom_latin,tableEspeces$std_libelle,sep="_")
- nbstades=tapply(tableEspeces$tax_nom_latin,tableEspeces$taxon_stades,function(X)(length(unique(X))))
- if (length(nbstades[nbstades>1])>0){
- les_multiples=names(nbstades[nbstades>1])
- tableEspeces[!tableEspeces$taxon_stades%in%les_multiples,"taxon_stades"]<-tableEspeces$tax_nom_latin[!tableEspeces$taxon_stades%in%les_multiples]
- } else tableEspeces$taxon_stades<-tableEspeces$tax_nom_latin
- # TODO ajouter les effectifs en fin de taxons_stades ???
- nb=length(unique(tableEspeces$taxon_stade))
- if (min(tableEspeces$lot_effectif)<0) {funout(gettext("Warning, some negative counts are transformed into positive ones\n",domain="R-stacomiR"))
- tableEspeces$lot_effectif=abs(tableEspeces$lot_effectif)
- }
- now<-bilanEspeces at horodate@horodate
- sumEspeces=switch(bilanEspeces at liste@listechoice,
- "annee"=as.data.frame(xtabs(lot_effectif~taxon_stades+annee,data=tableEspeces)),
- "mois"=as.data.frame(xtabs(lot_effectif~taxon_stades+mois,data=tableEspeces)),
- "semaine"=as.data.frame(xtabs(lot_effectif~taxon_stades+semaine,data=tableEspeces)),
- "aucun"=as.data.frame(xtabs(lot_effectif~taxon_stades,data=tableEspeces)))
- colnames(sumEspeces)[colnames(sumEspeces)=="Freq"]<-"Effectif" # pas forcement le m nb de colonnes
- path=file.path(normalizePath(path.expand(get("datawd",envir=envir_stacomi))),paste("tableEspece",now,".csv",sep=""),fsep ="\\")
- write.table(sumEspeces,path,row.names=TRUE,col.names=TRUE,sep=";",append=FALSE)
- funout(gettextf("writing of %s \n",path))
}
-#' Interface for BilanEspece class
+#' summary for BilanEspeces
+#' generate csv and html output in the user data directory
+#' @param object An object of class \code{\link{BilanEspeces-class}}
+#' @param silent Should the program stay silent or display messages, default FALSE
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @aliases summary.bilesp
#' @export
-interface_BilanEspeces=function(){
- bilanEspeces=new("BilanEspeces")
- assign("bilanEspeces",bilanEspeces,envir = envir_stacomi)
- funout(gettext("Summary of encountered species for the counting device\n",domain="R-stacomiR"))
- bilanEspeces at dc=charge(bilanEspeces at dc)
- bilanEspeces at liste=charge(object=bilanEspeces at liste,
- vecteur=c("aucun","semaine","mois","annee"),
- label=gettext("Choice of cutting",domain="R-stacomiR"))
- quitte()
- group <- gWidgets::ggroup(horizontal=FALSE) # doit toujours s'appeller group
- assign("group",group,envir = envir_stacomi)
- gl=glabel(text=gettext("Species summary",domain="R-stacomiR"),container=group)
- ggroupboutons<-get("ggroupboutons",envir=envir_stacomi)
- add(ggroupboutons,group)
- choice(bilanEspeces at horodate,
- label=gettext("Start of timestamp",domain="R-stacomiR"),
- nomassign="bilanEspeces_date_debut",
- funoutlabel=gettext("Beginning date has been chosen\n",domain="R-stacomiR"),
- decal=-2,
- affichecal=FALSE)
- choice(bilanEspeces at horodate,
- label=gettext("End of timestamp",domain="R-stacomiR"),
- nomassign="bilanEspeces_date_fin",
- funoutlabel=gettext("Ending date has been chosen\n",domain="R-stacomiR"),
- decal=-1,
- affichecal=FALSE)
- choice(bilanEspeces at dc,objectBilan=bilanEspeces,is.enabled=TRUE)
- choice(bilanEspeces at liste)
- ggroupboutonsbas = gWidgets::ggroup(horizontal=FALSE)
- assign("ggroupboutonsbas",ggroupboutonsbas, envir=envir_stacomi)
- gWidgets::add(ggroupboutons,ggroupboutonsbas)
- toolbarlist = list(
- Calc=gWidgets::gaction(handler=hBilanEspecescalc, action=bilanEspeces, icon="new", label="calcul", tooltip=gettext("Loading",domain="R-stacomiR")),
- Graph=gWidgets::gaction(label="pie",tooltip=gettext("Pie chart graphic",domain="R-stacomiR"),icon="bubbles",handler=hCamembert,action="pie"),
- Graph2=gWidgets::gaction(handler=hCamembert, icon="barplot", label="histo", tooltip=gettext("barplot",domain="R-stacomiR"),action="graph"),
- Stat=gWidgets::gaction(handler=hTableBilanEspeces, icon="dataframe", label="stat", tooltip=gettext("Summary tables in .csv and XML",domain="R-stacomiR")),
- annuler=gWidgets::gaction(handler= quitte,icon = "close",label=gettext("exit",domain="R-stacomiR"))
- )
-}
\ No newline at end of file
+setMethod("summary",signature=signature(object="BilanEspeces"),definition=function(object,silent=FALSE){
+ bilesp<-object
+ if (nrow(bilesp at calcdata)==0) stop("No data in the calcdata slot, did you forget to run calculations ?")
+ str_c(str_c(bilesp at dc@dc_selectionne,collapse="+"),
+ bilesp at anneedebut@annee_selectionnee,
+ bilesp at anneefin@annee_selectionnee,sep="_")
+ path=file.path(normalizePath(path.expand(get("datawd",envir=envir_stacomi))),paste("tableEspece",dc,".csv",sep=""),fsep ="\\")
+ write.table(bilesp at calcdata,path,row.names=TRUE,col.names=TRUE,sep=";",append=FALSE)
+ if (!silent){
+ funout(gettextf("writing of %s \n",path))
+ funout(gettextf("attention, negative numbers were transformed into positive numbers"))
+ }
+ })
+
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2017-06-09 13:55:49 UTC (rev 392)
+++ pkg/stacomir/R/BilanMigration.r 2017-06-10 19:44:33 UTC (rev 393)
@@ -195,7 +195,7 @@
#' calcule method for BilanMigration
#'
-#' does the calculation once data are filled,. It also performs conversion from weight to numbers
+#' does the calculation once data are filled by the connect method. It also performs conversion from weight to numbers
#' in with the connect method
#' @param object An object of class \code{\link{BilanMigration-class}}
#' @param negative a boolean indicating if a separate sum must be done for positive and negative values, if true, positive and negative counts return
Modified: pkg/stacomir/R/Bilan_poids_moyen.r
===================================================================
--- pkg/stacomir/R/Bilan_poids_moyen.r 2017-06-09 13:55:49 UTC (rev 392)
+++ pkg/stacomir/R/Bilan_poids_moyen.r 2017-06-10 19:44:33 UTC (rev 393)
@@ -548,7 +548,7 @@
#' @return An object of class \link{Bilan_poids_moyen-class}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("write_database",signature=signature("Bilan_poids_moyen"),definition=function(object,silent=FALSE,dbname="bd_contmig_nat"){
+setMethod("write_database",signature=signature("Bilan_poids_moyen"),definition=function(object,silent=FALSE){
#silent=FALSE;dbname="bd_contmig_nat";host="localhost";port=5432
host=get("sqldf.options",envir=envir_stacomi)["sqldf.host"]
port=get("sqldf.options",envir=envir_stacomi)["sqldf.port"]
Modified: pkg/stacomir/R/RefAnnee.r
===================================================================
--- pkg/stacomir/R/RefAnnee.r 2017-06-09 13:55:49 UTC (rev 392)
+++ pkg/stacomir/R/RefAnnee.r 2017-06-10 19:44:33 UTC (rev 393)
@@ -78,7 +78,7 @@
requete at sql=paste("select DISTINCT ON (year) year from( select date_part('year', ope_date_debut) as year from ",
get("sch",envir=envir_stacomi),
"t_operation_ope) as tabletemp",sep="")
- } else if (objectBilan=="BilanAnnuels") {
+ } else if (objectBilan=="BilanAnnuels"|objectBilan=="BilanEspeces") {
if (exists("refDC",envir_stacomi)) {
dc<-get("refDC",envir_stacomi)
and1<-paste(" AND ope_dic_identifiant in ",vector_to_listsql(dc at dc_selectionne))
@@ -104,8 +104,8 @@
get("sch",envir=envir_stacomi),
"t_lot_lot on lot_ope_identifiant=ope_identifiant",
" WHERE lot_lot_identifiant is null",
- and1,and2,and3, ") as tabletemp", sep="")
- } else {
+ and1,and2,and3, ") as tabletemp", sep="")
+ } else {
funout(gettextf("Not implemented for objectBilan = %s",objectBilan),arret=TRUE)
}
requete<-stacomirtools::connect(requete) # appel de la methode connect de l'object requeteODBC
Added: pkg/stacomir/R/interface_BilanEspeces.r
===================================================================
--- pkg/stacomir/R/interface_BilanEspeces.r (rev 0)
+++ pkg/stacomir/R/interface_BilanEspeces.r 2017-06-10 19:44:33 UTC (rev 393)
@@ -0,0 +1,44 @@
+#' Interface for BilanEspece class
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+interface_BilanEspeces=function(){
+ bilesp=new("BilanEspeces")
+ assign("bilesp",bilesp,envir = envir_stacomi)
+ funout(gettext("Summary of encountered species for the counting device\n",domain="R-stacomiR"))
+ bilesp at dc=charge(bilesp at dc)
+ bilesp at split=charge(object=bilesp at split,
+ listechoice=c("none","week","month","year"),
+ label=gettext("Choice of cutting",domain="R-stacomiR"))
+ bilesp at anneedebut=charge(bilesp at anneedebut,objectBilan="BilanEspeces")
+ bilesp at anneefin=charge(bilesp at anneefin,objectBilan="BilanEspeces")
+ quitte()
+ group <- gWidgets::ggroup(horizontal=FALSE) # doit toujours s'appeller group
+ assign("group",group,envir = envir_stacomi)
+ gl=glabel(text=gettext("Species summary",domain="R-stacomiR"),container=group)
+ ggroupboutons<-get("ggroupboutons",envir=envir_stacomi)
+ add(ggroupboutons,group)
+ choice(bilesp at anneedebut,
+ nomassign="anneedebut",
+ funoutlabel=gettext("The year of beginning has been chosen\n",domain="R-stacomiR"),
+ titleFrame=gettext("First year",domain="R-stacomiR"),
+ preselect=which(bilesp at anneedebut@data==min(bilesp at anneedebut@data)))
+ choice(bilesp at anneefin,
+ nomassign="anneefin",
+ funoutlabel=gettext("The last year has been chosen\n",domain="R-stacomiR"),
+ titleFrame=gettext("Last year",domain="R-stacomiR"),
+ preselect=which(bilesp at anneefin@data==max(bilesp at anneefin@data)))
+
+ choice(bilesp at dc,objectBilan=bilesp,is.enabled=TRUE)
+ choice(bilesp at split)
+ ggroupboutonsbas = gWidgets::ggroup(horizontal=FALSE)
+ assign("ggroupboutonsbas",ggroupboutonsbas, envir=envir_stacomi)
+ gWidgets::add(ggroupboutons,ggroupboutonsbas)
+ toolbarlist = list(
+ Calc=gWidgets::gaction(handler=hbilespcalc, icon="new", label="calcul", tooltip=gettext("Loading",domain="R-stacomiR")),
+ Graph=gWidgets::gaction(label="pie",tooltip=gettext("Pie chart graphic",domain="R-stacomiR"),icon="bubbles",handler=hplotbilesp,action="pie"),
+ Graph2=gWidgets::gaction(handler=hplotbilesp, icon="barplot", label="histo", tooltip=gettext("barplot",domain="R-stacomiR"),action="barplot"),
+ Stat=gWidgets::gaction(handler=hsummarybilesp, icon="dataframe", label="summary", tooltip=gettext("Summary tables in .csv and XML",domain="R-stacomiR")),
+ annuler=gWidgets::gaction(handler= quitte,icon = "close",label=gettext("exit",domain="R-stacomiR"))
+ )
+ add(ggroupboutonsbas, gtoolbar(toolbarlist))
+ gWidgets::addSpring(group)
+}
\ No newline at end of file
Modified: pkg/stacomir/R/interface_BilanMigrationMultConditionEnv.r
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 393
More information about the Stacomir-commits
mailing list