[Stacomir-commits] r228 - in pkg/stacomir: . R data inst/config inst/examples inst/tests/testthat man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 5 14:43:08 CEST 2016
Author: briand
Date: 2016-10-05 14:43:07 +0200 (Wed, 05 Oct 2016)
New Revision: 228
Added:
pkg/stacomir/data/b_carlot.rda
pkg/stacomir/inst/examples/bilancarlot_example.R
pkg/stacomir/inst/tests/testthat/test-05Bilan_carlot.R
pkg/stacomir/man/b_carlot.Rd
pkg/stacomir/man/choice_c-Bilan_carlot-method.Rd
pkg/stacomir/man/choice_c-Refpar-method.Rd
pkg/stacomir/man/plot-Bilan_carlot-missing-method.Rd
pkg/stacomir/man/print-Bilan_carlot-method.Rd
pkg/stacomir/man/summary-Bilan_carlot-method.Rd
Modified:
pkg/stacomir/DESCRIPTION
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/Bilan_carlot.r
pkg/stacomir/R/Refpar.r
pkg/stacomir/R/create_generic.r
pkg/stacomir/R/data.r
pkg/stacomir/R/interface_BilanMigration.r
pkg/stacomir/R/interface_BilanMigrationMult.r
pkg/stacomir/R/interface_Bilan_carlot.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/data/msg.rda
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/config/testthat.R
pkg/stacomir/inst/tests/testthat/test-00stacomir.R
pkg/stacomir/inst/tests/testthat/test-00zRefclasses.R
pkg/stacomir/inst/tests/testthat/test-01BilanMigrationMult.R
pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R
pkg/stacomir/man/BilanFonctionnementDC-class.Rd
pkg/stacomir/man/BilanFonctionnementDF-class.Rd
pkg/stacomir/man/Bilan_carlot-class.Rd
pkg/stacomir/man/Refpar-class.Rd
pkg/stacomir/man/calcule-BilanMigration-method.Rd
pkg/stacomir/man/calcule-Bilan_carlot-method.Rd
pkg/stacomir/man/charge_avec_filtre-Refpar-method.Rd
pkg/stacomir/man/connect-Bilan_carlot-method.Rd
pkg/stacomir/man/plot-BilanFonctionnementDC-ANY-method.Rd
pkg/stacomir/man/plot-BilanFonctionnementDF-ANY-method.Rd
Log:
class Bilan-carlot => version 0.5
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/DESCRIPTION 2016-10-05 12:43:07 UTC (rev 228)
@@ -1,6 +1,6 @@
Package: stacomiR
Version: 0.5.0
-Date: 2016-09-01
+Date: 2016-10-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"))
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/BilanMigration.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -207,7 +207,7 @@
#' @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
#' different rows
-#' @param silent Boolean, if true, information messages are not displays, only warnings and errors
+#' @param silent Boolean, if TRUE, information messages are not displayed, only warnings and errors
#' @note The class BilanMigration does not handle escapement rates nor
#' 'devenir' i.e. the destination of the fishes.
#' @return BilanMigration with calcdata slot filled.
@@ -315,7 +315,7 @@
#' @author cedric.briand
#' @export
setMethod("print",signature=signature("BilanMigration"),definition=function(x,...){
- sortie1<-"bilanMigration=new(bilanMigration)\n"
+ sortie1<-"bilanMigration=new('bilanMigration')\n"
sortie2<-stringr::str_c("bilanMigration=choice_c(bilanMigration,",
"dc=c(",stringr::str_c(x at dc@dc_selectionne,collapse=","),"),",
"taxons=c(",stringr::str_c(shQuote(x at taxons@data$tax_nom_latin),collapse=","),"),",
@@ -351,7 +351,7 @@
#' @export
setMethod("plot",signature(x = "BilanMigration", y = "ANY"),definition=function(x, y,plot.type="standard",silent=FALSE,...){
#bilanMigration<-bM_Arzal
- bilanMigration<-x
+ #bilanMigration<-x
if (exists("bilanMigration",envir_stacomi)) {
bilanMigration<-get("bilanMigration",envir_stacomi)
} else {
Modified: pkg/stacomir/R/Bilan_carlot.r
===================================================================
--- pkg/stacomir/R/Bilan_carlot.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/Bilan_carlot.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -4,7 +4,14 @@
#' results of a categorical variable, or quantitative variable attached for lot, for instance,
#' it can be used to analyse size or sex
#'
-#' @note This class is displayed by interface_bilan_lot
+#' @note This class is displayed by interface_bilan_carlot
+#' @slot data A data frame
+#' @slot dc Object of class \link{RefDC-class}: the control devices
+#' @slot taxons Object of class \link{RefTaxon-class}: the speciess
+#' @slot stades Object of class \link{RefStades-class} : the stages of the fish
+#' @slot par Object of class \link{Refpar-class}: the parameters used
+#' @slot horodatedebut An object of class \code{RefHorodate-class}
+#' @slot horodatefin An object of class \code{RefHorodate-class}
#' @section Objects from the Class: Objects can be created by calls of the form
#' \code{new("Bilan_carlot", ...)}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
@@ -22,11 +29,7 @@
#' \code{\linkS4class{BilanMigrationPar}}
#' @concept Bilan Object
#' @keywords classes
-#' @examples
-#' \dontrun{
-#' showClass("Bilan_carlot")
-#' object=new("Bilan_carlot")
-#' }
+#' @example inst/examples/bilancarlot_example.R
#' @export
setClass(Class="Bilan_carlot",
representation= representation(
@@ -35,41 +38,41 @@
taxons="RefTaxon",
stades="RefStades",
par="Refpar",
- horodate="RefHorodate",
- requete="RequeteODBCwheredate"),
+ horodatedebut="RefHorodate",
+ horodatefin="RefHorodate"
+ ),
prototype=prototype(data=data.frame(),
dc=new("RefDC"),
taxons=new("RefTaxon"),
stades=new("RefStades"),
par=new("Refpar"),
- horodate=new("RefHorodate"),
- requete=new("RequeteODBCwheredate")
+ horodatedebut=new("RefHorodate"),
+ horodatefin=new("RefHorodate")
))
-#
#' connect method for Bilan_carlot
#'
-#' @return An object of class \link{Bilan_carlot-class}
#' @param object An object of class \link{Bilan_carlot-class}
-#' @param h a handler
-#' @param ... additional parameters passed to the method
+#' @param silent Boolean if TRUE messages are not displayed
+#' @return An object of class \link{Bilan_carlot-class}
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
-setMethod("connect",signature=signature("Bilan_carlot"),definition=function(object,h,...) {
-# construit une requete ODBCwheredate
- object at requete@baseODBC=get("baseODBC",envir=envir_stacomi)
- object at requete@select= paste("SELECT * FROM ",get("sch",envir=envir_stacomi),"vue_lot_ope_car",sep="")
- object at requete@colonnedebut="ope_date_debut"
- object at requete@colonnefin="ope_date_fin"
- object at requete@order_by="ORDER BY ope_date_debut"
- object at requete@and=paste(" AND ope_dic_identifiant=",object at dc@dc_selectionne,
- " AND lot_tax_code= '", object at taxons@data$tax_code,
- "' AND lot_std_code= '", object at stades@data$std_code,
- "' AND car_par_code='", object at par@data$par_code, "'",sep="")
-#object at requete@where=#defini dans la methode ODBCwheredate
- object at requete<-stacomirtools::connect(object at requete) # appel de la methode connect de l'object ODBCWHEREDATE
- object at data<-object at requete@query
- funout(get("msg",envir_stacomi)$Bilan_carlot.1)
+setMethod("connect",signature=signature("Bilan_carlot"),definition=function(object,silent=FALSE) {
+ requete<-new("RequeteODBCwheredate")
+ requete at baseODBC=get("baseODBC",envir=envir_stacomi)
+ requete at select= paste("SELECT * FROM ",get("sch",envir=envir_stacomi),"vue_lot_ope_car",sep="")
+ requete at colonnedebut="ope_date_debut"
+ requete at colonnefin="ope_date_fin"
+ requete at datedebut<-object at horodatedebut@horodate
+ requete at datefin<-object at horodatefin@horodate
+ requete at order_by="ORDER BY ope_date_debut"
+ requete at and=paste(" AND ope_dic_identifiant in ",vector_to_listsql(object at dc@dc_selectionne),
+ " AND lot_tax_code in ", vector_to_listsql(object at taxons@data$tax_code),
+ " AND lot_std_code in ", vector_to_listsql(object at stades@data$std_code),
+ " AND car_par_code in ", vector_to_listsql(object at par@par_selectionne), sep="")
+ requete<-stacomirtools::connect(requete)
+ object at data<-requete at query
+ if (!silent) funout(get("msg",envir_stacomi)$Bilan_carlot.1)
return(object)
})
@@ -106,35 +109,85 @@
funout(get("msg",envir_stacomi)$ref.4,arret=TRUE)
}
# rem pas tres satisfaisant car ce nom est choisi dans l'interface
- if (exists("bilan_lot_date_debut",envir_stacomi)) {
- object at requete@datedebut<-get("bilan_lot_date_debut",envir_stacomi)@horodate
+ if (exists("bilan_carlot_date_debut",envir_stacomi)) {
+ object at horodatedebut<-get("bilan_carlot_date_debut",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.5,arret=TRUE)
}
# rem id
- if (exists("bilan_lot_date_fin",envir_stacomi)) {
- object at requete@datefin<-get("bilan_lot_date_fin",envir_stacomi)@horodate
+ if (exists("bilan_carlot_date_fin",envir_stacomi)) {
+ object at horodatefin<-get("bilan_carlot_date_fin",envir_stacomi)
} else {
funout(get("msg",envir_stacomi)$ref.6,arret=TRUE)
- }
- object<-connect(object)
+ }
return(object)
})
+
+#' command line interface for Bilan_carlot class
+#' @param object An object of class \link{Bilan_carlot-class}
+#' @param dc A numeric or integer, the code of the dc, coerced to integer,see \link{choice_c,RefDC-method}
+#' @param taxons Either a species name in latin or the SANDRE code for species (ie 2038=Anguilla anguilla),
+#' these should match the ref.tr_taxon_tax referential table in the stacomi database, see \link{choice_c,RefTaxon-method}
+#' @param stades A stage code matching the ref.tr_stadedeveloppement_std table in the stacomi database, see \link{choice_c,RefStades-method}
+#' @param par A parameter matching th ref.tg_parametre_par table in the stacomi database, see \link{choice_c,Refpar-method}
+#' @param horodatedebut The starting date as a character, formats like \code{\%Y-\%m-\%d} or \code{\%d-\%m-\%Y} can be used as input
+#' @param horodatefin The finishing date of the Bilan, for this class this will be used to calculate the number of daily steps.
+#' @param silent Boolean, if TRUE, information messages are not displayed
+#' @return An object of class \link{BilanMigration-class}
+#' The choice_c method fills in the data slot for classes \link{RefDC-class}, \link{RefTaxon-class}, \link{RefStades-class}, \link{Refpar-class} and two slots of \link{RefHorodate-class} 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("Bilan_carlot"),definition=function(object,
+ dc,
+ taxons,
+ stades,
+ par,
+ horodatedebut,
+ horodatefin,
+ silent=FALSE){
+ # code for debug using example
+ #bilan_carlot<-b_carlot;dc=c(5,6);taxons="Anguilla anguilla";stades=c("CIV","AGJ");par=c(1785,1786,1787,"C001");horodatedebut="2010-01-01";horodatefin="2015-12-31"
+ bilan_carlot<-object
+ bilan_carlot at dc=charge(bilan_carlot at dc)
+ # loads and verifies the dc
+ # this will set dc_selectionne slot
+ bilan_carlot at dc<-choice_c(object=bilan_carlot at dc,dc)
+ # only taxa present in the bilanMigration are used
+ bilan_carlot at taxons<-charge_avec_filtre(object=bilan_carlot at taxons,bilan_carlot at dc@dc_selectionne)
+ bilan_carlot at taxons<-choice_c(bilan_carlot at taxons,taxons)
+ bilan_carlot at stades<-charge_avec_filtre(object=bilan_carlot at stades,bilan_carlot at dc@dc_selectionne,bilan_carlot at taxons@data$tax_code)
+ bilan_carlot at stades<-choice_c(bilan_carlot at stades,stades)
+ bilan_carlot at par<-charge_avec_filtre(object=bilan_carlot at par,bilan_carlot at dc@dc_selectionne,bilan_carlot at taxons@data$tax_code,bilan_carlot at stades@data$std_code)
+ bilan_carlot at par<-choice_c(bilan_carlot at par,par,silent=silent)
+ bilan_carlot at horodatedebut<-choice_c(object=bilan_carlot at horodatedebut,
+ nomassign="bilan_carlot_date_debut",
+ funoutlabel=get("msg",envir=envir_stacomi)$interface_Bilan_lot.5,
+ horodate=horodatedebut,
+ silent=silent)
+ bilanFonctionnementDC at horodatefin<-choice_c(bilanFonctionnementDC at horodatefin,
+ nomassign="bilan_carlot_date_fin",
+ funoutlabel=get("msg",envir=envir_stacomi)$interface_Bilan_lot.6,
+ horodate=horodatefin,
+ silent=silent)
+ return(bilan_carlot)
+ })
#' Calcule method for Bilan_carlot
#'
#' @param object An object of class \code{\link{Bilan_carlot-class}}
-#' @param h a handler
+#' @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_carlot"),definition=function(object,h) {
- bilan_lot<-object
- if(nrow(bilan_lot at data)==0) {
+setMethod("calcule",signature=signature("Bilan_carlot"),definition=function(object,silent) {
+ #bilan_carlot<-b_carlot
+ bilan_carlot<-object
+ if(nrow(bilan_carlot at data)==0) {
funout(get("msg",envir_stacomi)$Bilan_carlot.2, arret=TRUE)
}
- vue_ope_lot=bilan_lot at requete@query # on recupere le data.frame
- nom_variable=bilan_lot at par@data$par_nom
- stopifnot(length(nom_variable)==1)
+ vue_ope_lot=bilan_carlot at data # on recupere le data.frame
+ nom_variable=bilan_carlot at par@data$par_nom[bilan_carlot at par@data$par_code%in%bilan_carlot at par@par_selectionne]
+ #stopifnot(length(nom_variable)==1)
vue_ope_lot$ope_dic_identifiant=as.factor(vue_ope_lot$ope_dic_identifiant)
vue_ope_lot$dev_code=as.factor(vue_ope_lot$dev_code)
vue_ope_lot$car_val_identifiant=as.factor(vue_ope_lot$car_val_identifiant)
@@ -152,20 +205,108 @@
jour_an=TRUE,
jour_mois=FALSE,
heure=FALSE)
- vue_ope_lot=stacomirtools::chnames(vue_ope_lot,
- c("ope_identifiant","lot_identifiant","ope_dic_identifiant","lot_pere",
- "ope_date_debut","ope_date_fin","lot_effectif","lot_quantite","lot_tax_code","lot_std_code","tax_nom_latin","std_libelle","dev_code","dev_libelle","par_nom","car_par_code","car_methode_obtention","car_val_identifiant", "car_valeur_quantitatif","val_libelle", "annee","mois","quinzaine","semaine","jour_365"),
- c("ope","lot","dic","lot_pere",
- "date","date_fin","effectif","quantite","lot_tax_code","lot_std_code","tax","std","dev_code","dev","par","car_par_code","meth","val","val_quant","val_libelle", "annee","mois","quinzaine","semaine","jour"))
- vue_ope_lot=vue_ope_lot[,c("ope","lot","dic","lot_pere","date","effectif","quantite","tax","std","dev","par","meth","val","val_quant","val_libelle", "annee","mois","quinzaine","semaine","jour")]
- bilan_lot at data<-vue_ope_lot
- assign("bilan_lot",bilan_lot,envir_stacomi)#assign("bilan_lot",vue_ope_lot,envir_stacomi)
- assign("vue_ope_lot",vue_ope_lot,envir=.GlobalEnv)
+# vue_ope_lot=stacomirtools::chnames(vue_ope_lot,
+# c("ope_identifiant","lot_identifiant","ope_dic_identifiant","lot_pere",
+# "ope_date_debut","ope_date_fin","lot_effectif","lot_quantite","lot_tax_code","lot_std_code","tax_nom_latin","std_libelle","dev_code","dev_libelle","par_nom","car_par_code","car_methode_obtention","car_val_identifiant", "car_valeur_quantitatif","val_libelle", "annee","mois","quinzaine","semaine","jour_365"),
+# c("ope","lot","dic","lot_pere",
+# "date","date_fin","effectif","quantite","lot_tax_code","lot_std_code","tax","std","dev_code","dev","par","car_par_code","meth","val","val_quant","val_libelle", "annee","mois","quinzaine","semaine","jour"))
+ #vue_ope_lot=vue_ope_lot[,c("ope","lot","dic","lot_pere","date","effectif","quantite","tax","std","dev","par","meth","val","val_quant","val_libelle", "annee","mois","quinzaine","semaine","jour")]
+ bilan_carlot at data<-vue_ope_lot
+ assign("bilan_carlot",bilan_carlot,envir_stacomi)#assign("bilan_carlot",vue_ope_lot,envir_stacomi)
funout(get("msg",envir_stacomi)$Bilan_carlot.3)
- return(bilan_lot)
+ return(bilan_carlot)
})
+#' Plots of various type for BilanMigration, and performs writing to the database of daily values.
+#'
+#' \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)}
+#' }
+#' @note When plotting the "standard" plot, the user will be prompted to "write" the daily migration and monthly migration in the database.
+#' these entries are necessary to run the Interannual Migration class. If the stacomi has been launched with database_expected=FALSE,
+#' then no entry will be written to the database
+#' @param x An object of class BilanMigrationMult
+#' @param plot.type One of "1","violin plot". Defaut to \code{1} , can also be \code{2} boxplot or
+#' \code{3} points.
+#' @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}
+#' @export
+setMethod("plot", signature(x = "Bilan_carlot", y = "missing"), definition=function(x, plot.type="1", silent=FALSE){
+ #bilan_carlot<-b_carlot;require(ggplot2);plot.type="1"
+ #browser()
+ bilan_carlot<-x
+ plot.type<-as.character(plot.type)# to pass also characters
+ if (!plot.type%in%c("1","2","3")) stop('plot.type must be 1,2,3')
+ if (exists("bilan_carlot",envir_stacomi)) {
+ bilan_carlot<-get("bilan_carlot",envir_stacomi)
+ } else {
+ if (!silent) funout(get("msg",envir_stacomi)$BilanMigration.5,arret=TRUE)
+ }
+ if (plot.type==1){
+ g<-ggplot(bilan_carlot at data,aes(x=car_valeur_quantitatif))
+ g<-g+stat_density(aes(ymax = ..density.., ymin = -..density..),
+ fill = "grey50", colour = "grey10",
+ geom = "ribbon", position = "identity") +
+ facet_grid(. ~ annee) +
+ coord_flip()
+ print(g)
+ assign("g",g,envir_stacomi)
+ if (!silent) funout(get("msg",envir_stacomi)$Bilan_carlot.4)
+ } else if (plot.type==2){
+ g<-ggplot(bilan_carlot at data)
+ g<-g+geom_boxplot(aes(x=mois,y=car_valeur_quantitatif,fill=std_libelle))+
+ facet_grid(annee ~ .)
+ print(g)
+ assign("g",g,envir_stacomi)
+ if (!silent) funout(get("msg",envir_stacomi)$Bilan_carlot.4)
+
+ }else if (plot.type==3){
+ g<-ggplot(bilan_carlot at data)
+ g<-g+geom_point(aes(x=ope_date_debut,y=car_valeur_quantitatif))
+ print(g)
+ assign("g",g,envir_stacomi)
+ if (!silent) funout(get("msg",envir_stacomi)$Bilan_carlot.4)
+ }
+ return(invisible(NULL))
+ })
+
+#' summary for Bilan_carlot
+#' @param object An object of class \code{\link{Bilan_carlot-class}}
+#' @param silent Should the program stay silent or display messages, default FALSE
+#' @param ... Additional parameters
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @export
+setMethod("summary",signature=signature(object="Bilan_carlot"),definition=function(object,silent=FALSE,...){
+ Hmisc::describe(object at data)
+ })
+
+#' Method to print the command line of the object
+#' @param x An object of class Bilan_carlot
+#' @param ... Additional parameters passed to print
+#' @return NULL
+#' @author cedric.briand
+#' @export
+setMethod("print",signature=signature("Bilan_carlot"),definition=function(x,...){
+ sortie1<-"bilan_carlot=new('Bilan_carlot')"
+ sortie2<-stringr::str_c("bilan_carlot=choice_c(bilan_carlot,",
+ "dc=c(",stringr::str_c(x at dc@dc_selectionne,collapse=","),"),",
+ "taxons=c(",stringr::str_c(shQuote(x at taxons@data$tax_nom_latin),collapse=","),"),",
+ "stades=c(",stringr::str_c(shQuote(x at stades@data$std_code),collapse=","),"),",
+ "par=c(",stringr::str_c(shQuote(x at par@par_selectionne),collapse=","),"),",
+ "horodatedebut=",shQuote(strftime(x at horodatedebut@horodate,format="%d/%m/%Y %H-%M-%S")),
+ ",horodatefin=",shQuote(strftime(x at horodatefin@horodate,format="%d/%m/%Y %H-%M-%S")),")")
+ # removing backslashes
+ funout(sortie1)
+ funout(stringr::str_c(sortie2,...))
+ return(invisible(NULL))
+ })
+
+
#' fundensityBilan_carlot uses ggplot2 to draw density plots
#'
#' assigns an object g in envir_stacomi for eventual modification of the plot
@@ -174,17 +315,10 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
fundensityBilan_carlot = function(h,...) {
- bilan_lot<-charge(bilan_lot)
- bilan_lot<-calcule(bilan_lot)
- g<-ggplot(bilan_lot at data,aes(x=val_quant))
- g<-g+stat_density(aes(ymax = ..density.., ymin = -..density..),
- fill = "grey50", colour = "grey10",
- geom = "ribbon", position = "identity") +
- facet_grid(. ~ annee) +
- coord_flip()
- print(g)
- assign("g",g,envir_stacomi)
- funout(get("msg",envir_stacomi)$Bilan_carlot.4)
+ bilan_carlot<-charge(bilan_carlot)
+ bilan_carlot<-connect(bilan_carlot)
+ bilan_carlot<-calcule(bilan_carlot)
+ bilan_carlot<-plot(bilan_carlot,plot.type="1")
}
#' Boxplots for ggplot2
@@ -195,13 +329,10 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
funboxplotBilan_carlot = function(h,...) {
- bilan_lot<-charge(bilan_lot)
- bilan_lot<-calcule(bilan_lot)
- g<-ggplot(bilan_lot at data)
- g<-g+geom_boxplot(aes(x=quinzaine,y=val_quant))
- print(g)
- assign("g",g,envir_stacomi)
- funout(get("msg",envir_stacomi)$Bilan_carlot.4)
+ bilan_carlot<-charge(bilan_carlot)
+ bilan_carlot<-connect(bilan_carlot)
+ bilan_carlot<-calcule(bilan_carlot)
+ bilan_carlot<-plot(bilan_carlot,plot.type="2")
}
@@ -213,14 +344,9 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
funpointBilan_carlot = function(h,...) {
- bilan_lot<-charge(bilan_lot)
- bilan_lot<-calcule(bilan_lot)
- g<-ggplot(bilan_lot at data)
- g<-g+geom_point(aes(x=date,y=val_quant))
- print(g)
- assign("g",g,envir_stacomi)
- funout(get("msg",envir_stacomi)$Bilan_carlot.4)
-
+ bilan_carlot<-charge(bilan_carlot)
+ bilan_carlot<-connect(bilan_carlot)
+ bilan_carlot<-calcule(bilan_carlot)
}
#' table function
@@ -231,9 +357,10 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
funtableBilan_carlot = function(h,...) {
- bilan_lot=charge(bilan_lot)
- vue_ope_lot=bilan_lot at requete@query # on recupere le data.frame
- assign("bilan_lot",bilan_lot,envir_stacomi)#assign("bilan_lot",vue_ope_lot,envir_stacomi)
+ bilan_carlot=charge(bilan_carlot)
+ bilan_carlot<-connect(bilan_carlot)
+ vue_ope_lot=bilan_carlot at requete@query # on recupere le data.frame
+ assign("bilan_carlot",bilan_carlot,envir_stacomi)#assign("bilan_carlot",vue_ope_lot,envir_stacomi)
funout(get("msg",envir_stacomi)$Bilan_carlot.3)
vue_ope_lot[is.na(vue_ope_lot)]<-""
vue_ope_lot$ope_date_debut=as.character(vue_ope_lot$ope_date_debut)
Modified: pkg/stacomir/R/Refpar.r
===================================================================
--- pkg/stacomir/R/Refpar.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/Refpar.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -7,7 +7,8 @@
#'
#' Class enabling to load the list of parameters and select one of them
#'
-#'
+#' @slot data A data.frame
+#' @slot par_selectionne A character vector corresponding to par_code
#' @section Objects from the Class: Objects can be created by calls of the form
#' \code{new("Refpar", data)}. \describe{ \item{list("data")}{Object of class
#' \code{"data.frame"} ~ All the parameters stored in the
@@ -17,8 +18,26 @@
#' @keywords classes
#' @slot data="data.frame" the list of parameters
#' @family Referential objects
-setClass(Class="Refpar",representation= representation(data="data.frame"))
+setClass(Class="Refpar",representation= representation(data="data.frame",par_selectionne="character"))
+
+setValidity("Refpar",method=function(object){
+ if (length(object at par_selectionne)!=0){
+ if (nrow(object at data)>0) {
+ concord<-object at par_selectionne%in%object at data$par_code
+ if (any(!concord)){
+ return(paste("No data for par",object at par_selectionne[!concord]))
+
+ } else {
+ return(TRUE)
+ }
+ } else {
+ return("You tried to set a value for par_selectionne without initializing the data slot")
+ }
+ } else return(TRUE)
+
+ }
+)
#' Loading method for Repar referential objects
#' @param object An object of class \link{Refpar-class}
#' @return An S4 object of class Refpar
@@ -47,7 +66,7 @@
#' @examples
#' \dontrun{
#' object=new("Refpar")
-#' charge_avec_filtre(object,dc_selectionne=6,taxon_selectionne=2038,stade_selectionne="CIV")
+#' charge_avec_filtre(object,dc_selectionne=6,taxon_selectionne=2038,stade_selectionne=c("AGJ","CIV")
#' }
setMethod("charge_avec_filtre",signature=signature("Refpar"),definition=function(object,dc_selectionne,
taxon_selectionne,
@@ -61,8 +80,9 @@
" JOIN ",get("sch",envir=envir_stacomi),"t_lot_lot on lot_ope_identifiant=ope_identifiant",
" JOIN ",get("sch",envir=envir_stacomi),"tj_caracteristiquelot_car on car_lot_identifiant=lot_identifiant",
" JOIN ref.tg_parametre_par on par_code=car_par_code",sep="")
- requete at where=paste("where dis_identifiant=",dc_selectionne)
- requete at and=paste("and lot_tax_code='",taxon_selectionne,"' and lot_std_code='",stade_selectionne,"'",sep="")
+ requete at where=paste("where dis_identifiant in ",vector_to_listsql(dc_selectionne))
+ requete at and=paste("and lot_tax_code in",vector_to_listsql(taxon_selectionne),
+ " and lot_std_code in ",vector_to_listsql(stade_selectionne),sep="")
requete at order_by="ORDER BY par_code"
requete<-stacomirtools::connect(requete) # appel de la methode connect de l'object requeteODBC
object at data<-requete at query
@@ -95,12 +115,13 @@
if (nrow(object at data) > 0){
hcar=function(h,...){
carchoisi=svalue(choice)
- object at data<-object at data[car_libelle%in%carchoisi ,]
+ object at par_selectionne<-carchoisi
+ #object at data<-object at data[car_libelle%in%carchoisi ,]
assign(nomassign,object,envir_stacomi)
- funout(get("msg",envir=envir_stacomi)$Refpar.3)
+ funout(get("msg",envir=envir_stacomi)$Refpar.3)
}
#frame_par<<-gframe(label)
- assign(frameassign,gframe(label,horizontal=FALSE),envir= .GlobalEnv)
+ assign(frameassign,gframe(label,horizontal=FALSE),envir= .GlobalEnv)
# pour pouvoir la supprimer ensuite
add(group,get(eval(frameassign),envir= .GlobalEnv))
car_libelle=fun_char_spe(object at data$par_nom)
@@ -109,3 +130,36 @@
gbutton("OK", container=get(eval(frameassign),envir= .GlobalEnv),handler=hcar)
} else funout(get("msg",envir=envir_stacomi)$Refpar.4,arret=TRUE)
})
+
+
+#' Command line interface to select a parameter
+#'
+#' the choice_c method is intented to have the same behaviour as choice (which creates a
+#' widget in the graphical interface) but from the command line.
+#' If an objectBilan is passed as a parameter, the method will do a charge_avec_filtre to select only the taxa present in the counting devices
+#' @param object an object of class \link{Refpar-class}
+#' @param par A character vector of par
+#' @param silent Default FALSE but not used there
+#' @return An object of class \link{Refpar-class}
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+setMethod("choice_c",signature=signature("Refpar"),definition=function(object,par,silent=FALSE) {
+ if (class(par)=="numeric") {
+ par<-as.character(par)
+ }
+ if (any(is.na(par))) stop ("NA values par")
+ object at par_selectionne<-par
+ if (nrow(object at data)==0){
+ stop ("Internal error : tried to set a value for par_selectionne without initializing the data slot")
+ }
+ #validObject(object,test=FALSE)
+ #here I don't want to generate an error if parm is not present
+ #so I'm not using the validObject which will throw and error
+ concord<-object at par_selectionne%in%object at data$par_code
+
+ if (any(!concord)){
+ warning(paste("No data for par",object at par_selectionne[!concord]))
+ }
+
+ assign("refpar",object,envir=envir_stacomi)
+ return(object)
+ })
\ No newline at end of file
Modified: pkg/stacomir/R/create_generic.r
===================================================================
--- pkg/stacomir/R/create_generic.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/create_generic.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -1,10 +1,4 @@
-# creation des fonctions generiques...
-# la clasee baseODBC n'a plus besoin d'un baseODBC par defaut
-#liste_chemins=chargecsv()
-#baseODBC=liste_chemins[["baseODBC"]]
-#listes de connection e la base de donnee (programmation S4)
-
#' Generic method for choice (using the gwidget graphical interface)
#' @param object Object
#' @param ... Additional parms
Modified: pkg/stacomir/R/data.r
===================================================================
--- pkg/stacomir/R/data.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/data.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -195,3 +195,12 @@
#' @keywords data
"bilanOperation_bM"
+#' An object of class \link{Bilan_carlot-class} with data loaded
+#'
+#' This dataset corresponds to the data collected at two different control devices
+#' at the Arzal control station (see example in \link{Bilan_carlot-class}), all body size
+#' parameters (total size, size converted from pixel in video control) are used in example
+#' @format An object of class Bilan_carlot
+#' @keywords data
+"b_carlot"
+
Modified: pkg/stacomir/R/interface_BilanMigration.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigration.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/interface_BilanMigration.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -13,7 +13,7 @@
bilanFonctionnementDF=new("BilanFonctionnementDF")
assign("bilanFonctionnementDF",bilanFonctionnementDF,envir = envir_stacomi)
bilanOperation=new("BilanOperation")
- assign("bilanOperation", envir=envir_stacomi)
+ assign("bilanOperation",bilanOperation, envir=envir_stacomi)
bilanMigration=new("BilanMigration")
assign("bilanMigration",bilanMigration,envir = envir_stacomi)
# see bilanMigrationMult for explaination
Modified: pkg/stacomir/R/interface_BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigrationMult.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/interface_BilanMigrationMult.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -20,7 +20,7 @@
bilanFonctionnementDF=new("BilanFonctionnementDF")
assign("bilanFonctionnementDF",bilanFonctionnementDF,envir = envir_stacomi)
bilanOperation=new("BilanOperation")
- assign("bilanOperation", envir=envir_stacomi)
+ assign("bilanOperation",bilanOperation, envir=envir_stacomi)
bilanMigration=new("BilanMigration")
assign("bilanMigration",bilanMigration,envir = envir_stacomi)
bilanMigrationMult at taxons=charge(bilanMigrationMult at taxons)
Modified: pkg/stacomir/R/interface_Bilan_carlot.r
===================================================================
--- pkg/stacomir/R/interface_Bilan_carlot.r 2016-10-02 18:45:00 UTC (rev 227)
+++ pkg/stacomir/R/interface_Bilan_carlot.r 2016-10-05 12:43:07 UTC (rev 228)
@@ -1,5 +1,3 @@
-# Nom fichier : interface_Bilan_carlot.R (interface)
-
#' An interface that calls the object to build the user interface
#' @note always has to be called within a group constructed and deleted using quitte()
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
@@ -7,45 +5,45 @@
{
quitte() # vidange de l'interface
bilan_carlot=new("Bilan_carlot")
- assign("bilan_carlot",bilan_carlot,envir = envir_stacomi)
-
- funout(get("msg",envir=envir_stacomi)$interface_Bilan_lot.1)
- bilan_carlot at dc=charge(bilan_carlot at dc)
- bilan_carlot at taxons=charge(bilan_carlot at taxons)
- bilan_carlot at stades=charge(bilan_carlot at stades)
- bilan_carlot at par=charge(bilan_carlot at par)
-
- group <- gWidgets::ggroup(horizontal=FALSE) # doit toujours s'appeller group
-
- assign("group",group,envir = .GlobalEnv)
- gWidgets::add(ggroupboutons,group)
- gl=glabel(text=get("msg",envir=envir_stacomi)$interface_Bilan_lot.2,container=group)
- # dans l'ordre
- # dans le handler, modifier le contenu de l'object fils si il existe
- # supprimer les widgets fils si ils existent (appel de la methode delete)
- # appeller la methode choice pour l'affichage du fils si il existe
-
-
- choice(bilan_carlot at horodate,label=get("msg",envir=envir_stacomi)$interface_Bilan_lot.3,
+ assign("bilan_carlot",bilan_carlot,envir = envir_stacomi)
+
+ funout(get("msg",envir=envir_stacomi)$interface_Bilan_lot.1)
+ bilan_carlot at dc=charge(bilan_carlot at dc)
+ bilan_carlot at taxons=charge(bilan_carlot at taxons)
+ bilan_carlot at stades=charge(bilan_carlot at stades)
+ bilan_carlot at par=charge(bilan_carlot at par)
+
+ group <- gWidgets::ggroup(horizontal=FALSE) # doit toujours s'appeller group
+
+ assign("group",group,envir = .GlobalEnv)
+ gWidgets::add(ggroupboutons,group)
+ gl=glabel(text=get("msg",envir=envir_stacomi)$interface_Bilan_lot.2,container=group)
+ # dans l'ordre
+ # dans le handler, modifier le contenu de l'object fils si il existe
+ # supprimer les widgets fils si ils existent (appel de la methode delete)
+ # appeller la methode choice pour l'affichage du fils si il existe
+
+
+ choice(bilan_carlot at horodate,label=get("msg",envir=envir_stacomi)$interface_Bilan_lot.3,
nomassign="bilan_carlot_date_debut",
funoutlabel=get("msg",envir=envir_stacomi)$interface_Bilan_lot.5,
decal=-2,
affichecal=FALSE)
- choice(bilan_carlot at horodate,label=get("msg",envir=envir_stacomi)$interface_Bilan_lot.4,
+ choice(bilan_carlot at horodate,label=get("msg",envir=envir_stacomi)$interface_Bilan_lot.4,
nomassign="bilan_carlot_date_fin",
funoutlabel=get("msg",envir=envir_stacomi)$interface_Bilan_lot.6,
decal=-1,
affichecal=FALSE)
-
- choice(bilan_carlot at dc,objectBilan=bilan_carlot,is.enabled=TRUE)
- # Les methodes choice suivantes sont passees en cascade e l'interieur des methodes choice
- #choice(bilan_carlot at taxons,is.enabled=FALSE)
- #choice(bilan_carlot at stades,is.enabled=FALSE)
- #choice(bilan_carlot at par,is.enabled=FALSE)
- #toolbarlist$Calc$handler = connect(bilanFonctionnementDC)
- #toolbarlist$Calc$icon = "dataframe"
- #getStockIcons(toolkit=guiToolkit())
-
+
+ choice(bilan_carlot at dc,objectBilan=bilan_carlot,is.enabled=TRUE)
+ # Les methodes choice suivantes sont passees en cascade e l'interieur des methodes choice
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 228
More information about the Stacomir-commits
mailing list