[Stacomir-commits] r348 - in pkg/stacomir: . R inst/config inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Apr 7 14:06:56 CEST 2017
Author: briand
Date: 2017-04-07 14:06:56 +0200 (Fri, 07 Apr 2017)
New Revision: 348
Modified:
pkg/stacomir/DESCRIPTION
pkg/stacomir/R/BilanAgedemer.r
pkg/stacomir/R/BilanConditionEnv.r
pkg/stacomir/R/BilanMigrationCar.r
pkg/stacomir/R/BilanMigrationMultConditionEnv.r
pkg/stacomir/R/data.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/R/utilitaires.r
pkg/stacomir/inst/config/generate_Roxygen2.R
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/examples/bilanMigrationCar-example.R
Log:
Modified: pkg/stacomir/DESCRIPTION
===================================================================
--- pkg/stacomir/DESCRIPTION 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/DESCRIPTION 2017-04-07 12:06:56 UTC (rev 348)
@@ -33,15 +33,15 @@
'PasdeTemps.r'
'PasDeTempsJournalier.r'
'BilanMigration.r'
- 'BilanMigrationConditionEnv.r'
- 'BilanMigrationInterAnnuelle.r'
- 'BilanMigrationMult.r'
+ 'Bilan_carlot.r'
'RefChoix.r'
'Refparqual.r'
'Refparquan.r'
- 'BilanMigrationPar.r'
+ 'BilanMigrationCar.r'
+ 'BilanMigrationInterAnnuelle.r'
+ 'BilanMigrationMult.r'
+ 'BilanMigrationMultConditionEnv.r'
'BilanOperation.r'
- 'Bilan_carlot.r'
'RefCoe.r'
'Bilan_poids_moyen.r'
'RefCheckBox.r'
@@ -53,7 +53,6 @@
'funSousListeBilanMigrationPar.r'
'fungraph.r'
'fungraph_civelle.r'
- 'fungraph_env.r'
'funstat.r'
'funstatJournalier.r'
'funtable.r'
@@ -65,10 +64,10 @@
'interface_BilanFonctionnementDC.r'
'interface_BilanFonctionnementDF.r'
'interface_BilanMigration.r'
- 'interface_BilanMigrationConditionEnv.r'
+ 'interface_BilanMigrationCar.r'
'interface_BilanMigrationInterannuelle.r'
'interface_BilanMigrationMult.r'
- 'interface_BilanMigrationPar.r'
+ 'interface_BilanMigrationMultConditionEnv.r'
'interface_Bilan_carlot.r'
'interface_Bilan_taille.r'
'interface_bilan_poids_moyen.r'
Modified: pkg/stacomir/R/BilanAgedemer.r
===================================================================
--- pkg/stacomir/R/BilanAgedemer.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/BilanAgedemer.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -348,7 +348,7 @@
#'
#' The sea age caracteristic is calculated from the mesured or calculated size of salmon and with a size/age rule
#' defined by the user
-#' @param object an object of class \link{BilanAgedemer-class}}
+#' @param object an object of class \link{BilanAgedemer-class}
#' @param silent : Default FALSE, if TRUE the program should no display messages.
#' @param dbname : the name of the database, defaults to "bd_contmig_nat"
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
Modified: pkg/stacomir/R/BilanConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanConditionEnv.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/BilanConditionEnv.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -8,11 +8,10 @@
#' @include RefStationMesure.r
#' @include create_generic.r
#' @include utilitaires.r
-#' @slot horodate \link{RefHorodate-class}
+#' @slot horodatedebut \link{RefHorodate-class}
+#' @slot horodatefin \link{RefHorodate-class}
#' @slot stationMesure \link{RefStationMesure-class}
#' @slot data \code{data.frame}
-#' @slot datedebut A \link[base]{-.POSIXt} value
-#' @slot datefin A \link[base]{-.POSIXt} value
#' @author cedric.briand"at"eptb-vilaine.fr
#' @family Bilan Objects
#' @keywords classes
@@ -142,7 +141,7 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @aliases plot.BilanConditionEnv plot.bilanConditionEnv plot.bilanconditionenv
#' @export
-setMethod("plot", signature(x = "BilanConditionEnv", y = "missing"), definition=function(x, silent=FALSE){
+setMethod("plot", signature(x = "BilanConditionEnv", y = "missing"), definition=function(x,silent=FALSE){
# le dataframe contenant le res de la requete
bil_CE<-x
dat<-bil_CE at data
Modified: pkg/stacomir/R/BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/BilanMigrationCar.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/BilanMigrationCar.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -11,6 +11,7 @@
#' @include Refparquan.r
#' @include Refparqual.r
#' @include RefChoix.r
+#' @include Bilan_carlot.r
#' @note The main difference between this class and \link{Bilan_carlot} is that this class allows to
#' select (or not) the samples, and that it handles quantitative and qualitative parameters separately.
#' @section Objects from the Class: Objects can be created by calls of the form
@@ -370,7 +371,7 @@
#' @param ... Additional parameters
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
setMethod("plot",signature=signature(x="BilanMigrationCar",y="missing"),definition=function(x,color_parm=NULL,plot.type="barplot",...){
- bmC<-object
+ bmC<-x
# transformation du tableau de donnees
# color_parm<-c("age 1"="red","age 2"="blue","age 3"="green")
# color_parm<-c("C001"="red")
@@ -443,19 +444,73 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("summary",signature=signature(object="BilanMigrationCar"),definition=function(object,silent=FALSE,...){
+ bmC<-object
+ bm<-bmC at calcdata
+ if (nrow(bm)==0) stop("No data in slot calcdata, did you forget to run the calcule method ?")
+ if (length(unique(bm$annee))==1){
+ table=round(tapply(bm$lot_effectif,list(bm$mois,bm$car_par_code_qual),sum),1)
+ table<-rbind(table,
+ colSums(table,na.rm=TRUE))
+ rownames(table)[nrow(table)]<-gettext("Sum")
+ if (!silent) print(table)
+ table<-as.data.frame(table)
+ } else {
+ table=round(tapply(bm$lot_effectif,list(bm$annee,bm$mois,bm$car_par_code_qual),sum),1)
+ if (!silent) print(table)
+ }
- if (plot.type=="summary") {
- table=round(tapply(mb$sum,list(mb$mois,mb$variable),sum),1)
- table=as.data.frame(table)
- table[,"total"]<-rowSums(table)
- gdf(table, container=TRUE)
- nomdc=bmC at dc@data$df_code[match(bmC at dc@dc_selectionne,bmC at dc@data$dc)]
- annee=unique(strftime(as.POSIXlt(bmC at time.sequence),"%Y"))
- path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste(nmvarqan,"_mensuel_",nomdc,"_",bmC at taxons@data$tax_nom_commun,"_",bmC at stades@data$std_libelle,"_",annee,".csv",sep=""),fsep ="\\")
- write.table(table,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
- funout(gettextf("Writing of %s",path1))
- path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste(nmvarqan,"_journalier_",nomdc,"_",bmC at taxons@data$tax_nom_commun,"_",bmC at stades@data$std_libelle,"_",annee,".csv",sep=""),fsep ="\\")
- write.table(bmC at data,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
- funout(gettextf("Writing of %s",path1))
- } # end plot.type summary
+# TODO
+# nomdc=bmC at dc@data$df_code[match(bmC at dc@dc_selectionne,bmC at dc@data$dc)]
+# path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste(nmvarqan,"_mensuel_",nomdc,"_",bmC at taxons@data$tax_nom_commun,"_",bmC at stades@data$std_libelle,"_",annee,".csv",sep=""),fsep ="\\")
+# write.table(table,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
+# if (!silent) funout(gettextf("Writing of %s",path1))
+# path1=file.path(path.expand(get("datawd",envir=envir_stacomi)),paste(nmvarqan,"_journalier_",nomdc,"_",bmC at taxons@data$tax_nom_commun,"_",bmC at stades@data$std_libelle,"_",annee,".csv",sep=""),fsep ="\\")
+# write.table(bmC at data,file=path1,row.names=FALSE,col.names=TRUE,sep=";")
+# if (!silent) funout(gettextf("Writing of %s",path1))
+ return(table)
})
+
+
+#' xtable funciton for \link{BilanMigrationCar-class}
+#' create an xtable objet but also assigns an add.to.column argument in envir_stacomi,
+#' for later use by the print.xtable method.
+#' @param x, an object of class "BilanAnnuels"
+#' @param caption, see xtable
+#' @param label, see xtable
+#' @param align, see xtable, overidden if NULL
+#' @param digits default 0
+#' @param display see xtable
+#' @param auto see xtable
+#' @param dc_name A string indicating the names of the DC, in the order of x at dc@dc_selectionne
+#' if not provided DC codes are used.
+#' @param tax_name A string indicating the names of the taxa, if not provided latin names are used
+#' @param std_name A string indicating the stages names, if not provided then std_libelle are used
+#' @export
+setMethod("xtable",signature=signature("BilanMigrationCar"),definition=function(x,...){
+ bmC<-x
+ dat=bmC at data
+ dc=stringr::str_c(bmC at dc@dc_selectionne,collapse=" ")
+ tax=stringr::str_c(bmC at taxons@data$tax_code,collapse=" ")
+ std=stringr::str_c(bmC at stades@data$std_code,collapse=" ")
+
+ dat<-summary(bmC,silent=TRUE)
+ if (class(dat)=="data.frame"){
+ xt<-xtable::xtable(dat,...)
+ if (is.null(align)) {
+ align<-c("l",rep("r",ncol(dat)))
+ align(xt)<-align
+ }
+ if (is.null(display)) {
+ display=c("s",rep("f",ncol(dat)))
+ display(xt)<-display
+ }
+ if (is.null(caption)) {
+ caption=gettextf("Summary for dc %s, taxa %s, stage %s.",dc,tax,std)
+ caption(xt)<-caption
+ }
+ return(xt)} else
+ {
+ #TODO tester et développer pour plusieurs années}
+ }
+ })
+
Modified: pkg/stacomir/R/BilanMigrationMultConditionEnv.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMultConditionEnv.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/BilanMigrationMultConditionEnv.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -16,7 +16,6 @@
#' @keywords classes
#' @example inst/examples/bilanMigrationMultConditionEnv_example.R
#' @export
-
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @family Bilan Objects
#' @keywords classes
@@ -161,6 +160,7 @@
taxons= as.character(bmmCE at bilanMigrationMult@taxons at data$tax_nom_latin)
stades= as.character(bmmCE at bilanMigrationMult@stades at data$std_libelle)
dc<-unique(grdata$DC)
+ stations<-bmmCE at bilanConditionEnv@stationMesure at data
# pour avoir dans le graphique le dc_code des dc
# ggplot passe les dc dans l'ordre dans lequel ils apparaissent dans le tableau
# et unique fait ça aussi .... OUIIIII
@@ -248,7 +248,7 @@
#######################
# color scheme for station
#######################
- stations<-bmmCE at bilanConditionEnv@stationMesure at data
+
cs<-colortable(color=color_station,vec=stations$stm_libelle,palette="Accent")
cs<-stacomirtools::chnames(cs,"name","stm_libelle")
#######################
@@ -272,7 +272,7 @@
y=yqualitatif,data=tableauCEqual,size=3)+
scale_fill_identity(name=gettext("DC"),labels=dc_code,guide = "legend")+
scale_colour_identity(name=gettext("stations"),
- labels=names(cs[,"color"]),
+ labels=cs[,"stm_libelle"],
breaks=cs[,"color"],
guide = "legend")+
scale_shape(guide="legend",name=gettext("Qualitative parm"))+
Modified: pkg/stacomir/R/data.r
===================================================================
--- pkg/stacomir/R/data.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/data.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -304,7 +304,7 @@
#' An object of class BilanAgedemer with data loaded
#'
#' This data corresponds to the data collected at Vichy (left and right bank fishways) and Decize-Saint
-#' Léger des Vignes fishways (respectively on the Allier and Loire river) in 2012 on the size structure of Salmo salar.
+#' Leger des Vignes fishways (respectively on the Allier and Loire river) in 2012 on the size structure of Salmo salar.
#' This dataset has been kindly provided by Loire Grands Migrateurs.
#'
#' @format An object of class \link{BilanAgedemer-class} with 8 slots:
Modified: pkg/stacomir/R/stacomi.r
===================================================================
--- pkg/stacomir/R/stacomi.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/stacomi.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -403,8 +403,6 @@
#' Program launch, this function launches the GwidgetRgtk graphical
#' interface to stacomi. To be able to run, some widgets (win, grouptotal, group...)
#' are assigned in the user environment \code{.GlobalEnv}.
-#'
-#'
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
interface_graphique=function(){
msg=get("msg",envir=envir_stacomi) # appel dans chaque sous fonction
Modified: pkg/stacomir/R/utilitaires.r
===================================================================
--- pkg/stacomir/R/utilitaires.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/R/utilitaires.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -372,7 +372,7 @@
colortable<-function(color=NULL,vec,palette="Set2",color_function="brewer.pal"){
if (is.null(color)) {
if (color_function=="brewer.pal") {
- color=RColorBrewer::brewer.pal(length(vec),name=palette)
+ color=RColorBrewer::brewer.pal(length(vec),name=palette)[1:length(vec)]
} else if (color_function=="gray.colors"){
color=grDevices::gray.colors(length(vec))
}
Modified: pkg/stacomir/inst/config/generate_Roxygen2.R
===================================================================
--- pkg/stacomir/inst/config/generate_Roxygen2.R 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/inst/config/generate_Roxygen2.R 2017-04-07 12:06:56 UTC (rev 348)
@@ -20,9 +20,10 @@
##########################
## Building documentation
#######################
+# devtools::install_version(package = 'roxygen2',version = '5.0.1', repos = c(CRAN = "https://cran.rstudio.com"))
##use either :
#require(devtools)
-#document("F:/workspace/stacomir/branch0.5/stacomir")
+#document("F:/workspace/stacomir/pkg/stacomir")
## or :
##vignette("roxygen2")
setwd("F:/workspace/stacomir/pkg/stacomir")
@@ -34,4 +35,6 @@
require(stacomiR)
stacomi(FALSE,FALSE,FALSE)
require(roxygen2)
-roxygen2::roxygenise("F:/workspace/stacomir/pkg/stacomir");warnings()[1:10]
\ No newline at end of file
+roxygen2::roxygenise("F:/workspace/stacomir/pkg/stacomir");warnings()[1:10]
+
+roxygen2::roxygenise("F:/workspace/stacomir/pkg/stacomir",roclets=c("Bilan_carlot"))
Modified: pkg/stacomir/inst/config/stacomi_manual_launch.r
===================================================================
--- pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-04-07 12:06:56 UTC (rev 348)
@@ -62,12 +62,13 @@
source("BilanMigrationMult.r")
source("BilanConditionEnv.r")
source("BilanMigrationMultConditionEnv.r")
-source("BilanMigrationPar.r")
+source("Bilan_carlot.r")
+source("BilanMigrationCar.r")
source("BilanMigrationInterAnnuelle.r")
require(xtable)
source("BilanAnnuels.r")
source("BilanArgentee.r")
-source("Bilan_carlot.r")
+
#source("Bilan_taille.r")
source("Bilan_poids_moyen.r")
source("BilanEspeces.r")
Modified: pkg/stacomir/inst/examples/bilanMigrationCar-example.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationCar-example.R 2017-04-07 09:22:02 UTC (rev 347)
+++ pkg/stacomir/inst/examples/bilanMigrationCar-example.R 2017-04-07 12:06:56 UTC (rev 348)
@@ -29,49 +29,10 @@
data("bmC")
bmC<-setasqualitative(bmC,par='A124',breaks=c(0,1.5,2.5,10),label=c("age 1","age 2","age 3"))
bmC<-calcule(bmC,silent=TRUE)
-# A "violin" plot
-plot(bmC,plot.type="quan",silent=TRUE)
-# get the plot from envir_stacomi to change labels for name
-# if you use require(ggplot2) the :: argument is not needed
-# e.g. write require(ggplot2);g<-get("g",envir=envir_stacomi)
-# g+xlab("size")+ylab("year")
-if (requireNamespace("ggplot2", quietly = TRUE)){
- g<-get("g",envir=envir_stacomi)
- g+ggplot2::xlab("size")+ggplot2::ylab("year")
-}
-# A boxplot per month
-plot(bmC,plot.type="2",silent=TRUE)
-# A xyplot
-plot(bmC,plot.type="3",silent=TRUE)
-#####################################
-# an example graph created manually from data
-#####################################
-# two variables one on DC, one on stage
-# passing dc information to the stage variable
-bmC at data$std_libelle[bmC at data$ope_dic_identifiant==5]<-"Yellow eel (vert. slot fishway)"
-bmC at data$std_libelle[bmC at data$std_libelle=="Anguille jaune"]<-"Yellow eel (ramp)"
-bmC at data$std_libelle[bmC at data$std_libelle=="civelle"]<-"Glass eel (ramp)"
-# creating a boxplot with custom output : an example
-# again if you use require(ggplot2) the :: argument is not needed
-
-if (requireNamespace("ggplot2", quietly = TRUE)){
- g<-ggplot2::ggplot(bmC at data)+
- ggplot2::geom_boxplot(ggplot2::aes(x=annee,
- y =car_valeur_quantitatif,
- fill = std_libelle))+
- ggplot2::xlab("size")+ggplot2::ylab("year")+
- ggplot2::scale_fill_manual("stage & fishway",
- values=c("Yellow eel (vert. slot fishway)"="blue",
- "Yellow eel (ramp)"="turquoise3",
- "Glass eel (ramp)"="Cyan"))+
- ggplot2::theme_bw()
- print(g)
-}
-
-# get a simple summary using Hmisc::describe
-\dontrun{
-summary(bmC)
-# get the command line to create the object using choice_c
-# when the graphical interface has been used
-print(bmC)
-}
\ No newline at end of file
+plot(bmC,plot.type="quant",silent=TRUE)
+# one quantitative parameter found, manual choice of color
+plot(bmC,plot.type="quant",color_parm=c("C001"="red"),silent=TRUE)
+plot(bmC,plot.type="qual",silent=TRUE)
+plot(bmC,plot.type="crossed")
+plot(bmC,plot.type="crossed",color_parm=c("age 1"="#379ec6","age 2"="#173957","age 3"="#b09953"))
+xt<-xtable(bmC)
More information about the Stacomir-commits
mailing list