[Stacomir-commits] r359 - in pkg/stacomir: R inst/config inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 8 22:07:03 CEST 2017
Author: briand
Date: 2017-05-08 22:07:03 +0200 (Mon, 08 May 2017)
New Revision: 359
Removed:
pkg/stacomir/R/interface_Bilan_taille.r
Modified:
pkg/stacomir/R/BilanMigrationCar.r
pkg/stacomir/R/RefChoix.r
pkg/stacomir/R/RefHorodate.r
pkg/stacomir/R/interface_BilanMigrationCar.r
pkg/stacomir/R/interface_BilanMigrationMult.r
pkg/stacomir/R/stacomi.r
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/examples/bilanMigrationCar-example.R
Log:
Modified: pkg/stacomir/R/BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/BilanMigrationCar.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/BilanMigrationCar.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -335,30 +335,42 @@
assign("bmC",bmC,envir_stacomi)
return(bmC)
})
-#' le handler appelle la methode generique graphe sur l'object plot.type=1
+#' handler for plot
#'
#' @param h handler
#' @param ... Additional parameters
-hbmCgraph = function(h,...) {
+hbmCplotquan = function(h,...) {
if (exists("bmC",envir_stacomi)) {
bmC<-get("bmC",envir_stacomi)
- plot(bmC,plot.type="barplot")
+ plot(bmC,plot.type="quan")
} else {
funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
}
}
-#' le handler appelle la methode generique graphe sur l'object plot.type=2
+#' handler for plot
#'
#' @param h handler
#' @param ... Additional parameters
-hbmCgraph2=function(h,...){
+hbmCplotqual=function(h,...){
if (exists("bmC",envir_stacomi)) {
bmC<-get("bmC",envir_stacomi)
- plot(bmC,plot.type="xyplot")
+ plot(bmC,plot.type="qual")
} else {
funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
}
}
+#' handler for plot
+#'
+#' @param h handler
+#' @param ... Additional parameters
+hbmCplotcrossed=function(h,...){
+ if (exists("bmC",envir_stacomi)) {
+ bmC<-get("bmC",envir_stacomi)
+ plot(bmC,plot.type="crossed")
+ } else {
+ funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
+ }
+}
#' This handler calls the generic method graphe on object plot.type 3
#'
#'
@@ -385,6 +397,7 @@
#' @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="qual",...){
bmC<-x
+ if (nrow(bmC at calcdata)==0) stop("no data in calcdata, have you forgotten to run calculations")
# transformation du tableau de donnees
# color_parm<-c("age 1"="red","age 2"="blue","age 3"="green")
# color_parm<-c("C001"="red")
@@ -461,45 +474,31 @@
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=round(tapply(bm$lot_effectif,list(bm$mois,bm$car_val_identifiant),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)
+ table=round(tapply(bm$lot_effectif,list(bm$annee,bm$mois,bm$car_val_identifiant),sum),1)
+
+ if (!silent) print(ftable(table))
}
-
-# 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"
+#' create an xtable objet to be later used by the print.xtable method.
+#' @param x, an object of class "BilanMigrationCar"
#' @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,...){
+setMethod("xtable",signature=signature("BilanMigrationCar"),definition=function(x,caption=NULL, label=NULL,align=NULL,...){
bmC<-x
dat=bmC at data
dc=stringr::str_c(bmC at dc@dc_selectionne,collapse=" ")
@@ -521,9 +520,23 @@
caption=gettextf("Summary for dc %s, taxa %s, stage %s.",dc,tax,std)
caption(xt)<-caption
}
- return(xt)} else
- {
- #TODO test and develop for several year}
+ return(xt)
+ } else {
+ # class is an array
+ xt<-xtable::xtable(MIfuns::ftable2data.frame(ftable(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)
}
})
Modified: pkg/stacomir/R/RefChoix.r
===================================================================
--- pkg/stacomir/R/RefChoix.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/RefChoix.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -69,7 +69,6 @@
#' Choice_c method for Refchoix referential objects
#' @param object An object of class \link{RefListe-class}
-#' @note the choice method assigns an object of class refList named refListe in the environment envir_stacomi
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @examples
#' \dontrun{
@@ -92,4 +91,28 @@
return(object)
+ })
+
+#' Multiple Choice method for RefChoix referential objects, to put together with notebook widgets
+#' @param object An object of class \link{RefChoix-class}
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+setMethod("choicemult",signature=signature("RefChoix"),definition=function(object,
+ selected_value
+ ) {
+ hlist=function(h,...){
+ valeurchoisie=svalue(choice)
+ object at listechoice<-valeurchoisie
+ assign("refchoice",object,envir_stacomi)
+ funout(gettext("choice made",domain="R-stacomiR"))
+ }
+
+ if (!exists("notebook")) notebook <- gnotebook(container=group)
+ groupchoice<-ggroup(container=notebook, label=gettext("options",domain="R-stacomiR"),horizontal=FALSE)
+ glabel(object at label,container=groupchoice)
+ list_libelle=fun_char_spe(object at listechoice)
+ choice=gradio(items=list_libelle,
+ selected=object at selected,
+ horizontal=FALSE,
+ container=groupchoice,
+ handler=hlist)
})
\ No newline at end of file
Modified: pkg/stacomir/R/RefHorodate.r
===================================================================
--- pkg/stacomir/R/RefHorodate.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/RefHorodate.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -150,16 +150,16 @@
}
} else {
stop("Formatting problem, the character vector you are trying to pass as horodate could not
-be parsed. Check example or documentation")
+ be parsed. Check example or documentation")
}
-
+
} else if (class(horodate)=="Date"){
.horodate<-as.POSIXlt(horodate)
} else if (class(horodate)[2]=="POSIXt"){
.horodate=horodate
}
if (is.na(.horodate)) stop("Formatting problem, the character vector you are trying to pass as horodate could not
-be parsed. Check example or documentation")
+ be parsed. Check example or documentation")
object at horodate=.horodate
validObject(object)
assign(nomassign,object at horodate,envir_stacomi)
@@ -167,3 +167,28 @@
return(object)
})
+#' Multiple Choice method for RefHorodate referential objects, to put together with notebook widgets
+#' @param object An object of class \link{RefHorodate-class}
+#' @param label the name to write in the frame
+#' @param nomassign the name with which the frame will be assigned to envir_stacomi
+#' @param funoutlabel the sentence to write when the choice has been made
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+setMethod("choicemult",signature=signature("RefHorodate"),definition=function(object,
+ label="date",
+ nomassign="horodate",
+ funoutlabel="nous avons le choix dans la date\n"
+ ) {
+ hhoro=function(h,...){
+ object=setRefHorodate(object,svalue(horodate))
+ assign(nomassign,object at horodate,envir_stacomi)
+ funout(gettext("Horodate selected\n",domain="R-stacomiR"))
+ # changing tab of notebook to next tab
+ if (svalue(notebook)<length(notebook)){
+ svalue(notebook)<-svalue(notebook)+1
+ }
+ }
+ if (!exists("notebook")) notebook <- gnotebook(container=group)
+ grouphorodate<-ggroup(container=notebook, label=label,horizontal=FALSE)
+ horodate<-gedit(getRefHorodate(object),container=grouphorodate,handler=hhoro,width=20)
+ gbutton("OK", container=grouphorodate,handler=hhoro,icon="execute")
+ })
\ No newline at end of file
Modified: pkg/stacomir/R/interface_BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigrationCar.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/interface_BilanMigrationCar.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -4,56 +4,73 @@
{
quitte()
- bilanMigrationPar=new("BilanMigrationPar")
- assign("bilanMigrationPar",bilanMigrationPar,envir=envir_stacomi)
+ bilanMigrationCar=new("BilanMigrationCar")
+ assign("bilanMigrationCar",bilanMigrationCar,envir=envir_stacomi)
bilanFonctionnementDC=new("BilanFonctionnementDC") # appel ici pour pouvoir utiliser les fonctions graphiques associees sur fonctionnement du DC
assign("bilanFonctionnementDC",bilanFonctionnementDC,envir=envir_stacomi)
+ objectBilan="BilanMigrationCar"
+ # the following name is created by the interface
+ # as I can't get the name from within the function (deparse(substitute(objectBilan)) does not return
+ # "bilanMigrationMult" see refDC choice_c method)
+ # so this will allow to assign "bilanMigrationMult" in envir_stacomi while using other class
+ # like refDC
+ assign("objectBilan",objectBilan,envir=envir_stacomi)
funout(gettext("Loading of the lists for taxons, stages, counting devices, qualitative and quantitative parameters\n",domain="R-stacomiR"))
- bilanMigrationPar at taxons=charge(bilanMigrationPar at taxons)
- bilanMigrationPar at stades=charge(bilanMigrationPar at stades)
- bilanMigrationPar at dc=charge(bilanMigrationPar at dc)
- bilanMigrationPar at parquan=charge(bilanMigrationPar at parquan)
- bilanMigrationPar at parqual=charge(bilanMigrationPar at parqual)
- #TODO transformer la valeur logique de echantillon en un refchoix correct (radiobutton)
- bilanMigrationPar at echantillon=charge(bilanMigrationPar at echantillon,vecteur=gettext("with","without",domain="R-stacomiR"),
+ bilanMigrationCar at taxons=charge(bilanMigrationCar at taxons)
+ bilanMigrationCar at stades=charge(bilanMigrationCar at stades)
+ bilanMigrationCar at dc=charge(bilanMigrationCar at dc)
+ bilanMigrationCar at parquan=charge(bilanMigrationCar at parquan)
+ bilanMigrationCar at parqual=charge(bilanMigrationCar at parqual)
+
+ bilanMigrationCar at echantillon=charge(bilanMigrationCar at echantillon,vecteur=gettext("with","without",domain="R-stacomiR"),
label=gettext("Choice of batch type, inclusion of samples ?",domain="R-stacomiR"),
selected=as.integer(1))
#######################
# Interface Graphique
##########################
- group <- gWidgets::ggroup(horizontal=FALSE) # doit toujours s'appeller group
-
+ group <- gWidgets::ggroup(horizontal=TRUE) # doit toujours s'appeller group
assign("group",group,envir = .GlobalEnv)
-
- gWidgets::add(ggroupboutons,group)
- choice(bilanMigrationPar at pasDeTemps)
- choice(bilanMigrationPar at echantillon)
- choice(bilanMigrationPar at dc,objectBilan=bilanMigrationPar,is.enabled=TRUE)
-
-
+ notebook <- gnotebook(container=group)
+ assign("notebook",notebook,envir=.GlobalEnv)
+ size(notebook)<-c(400,300)
+ gWidgets::add(ggroupboutons,group)
+
+ choicemult(bilanMigrationCar at horodatedebut,label=gettext("from",domain="R-stacomiR"))
+ choicemult(bilanMigrationCar at horodatefin,label=gettext("to",domain="R-stacomiR"))
+ choicemult(bilanMigrationCar at echantillon)
+ choicemult(bilanMigrationCar at dc,objectBilan=bilanMigrationCar,is.enabled=TRUE)
+ # TODO regler la disparition des onglets de l'interface
+ # TODO VERIFIER LE CHARGEMENT DES ONGLETS SUIVANTS DANS L'INTERFACE (taxon, stade, refparquan, refparqual)
+ # Error in (function (classes, fdef, mtable) :
+ # unable to find an inherited method for function 'choicemult' for signature '"Refpar"'
+ svalue(notebook)<-1
ggroupboutonsbas = gWidgets::ggroup(horizontal=FALSE)
gWidgets::add(ggroupboutons,ggroupboutonsbas)
assign("ggroupboutonsbas",ggroupboutonsbas, envir=.GlobalEnv)
toolbarlist = list(
- Calc=gWidgets::gaction(handler = hbilanMigrationParcalc,
+ Calc=gWidgets::gaction(handler = hbmCcalc,
icon = "new",
label=gettext("calculation"),
- action=bilanMigrationPar,
- tooltip=gettext("Calculation of numbers by time step",domain="R-stacomiR")),
- Graph=gWidgets::gaction(handler = hbilanMigrationPargraph,
+ action=bilanMigrationCar,
+ tooltip=gettext("calculation",domain="R-stacomiR")),
+ Graph=gWidgets::gaction(handler = hbmCplotquan,
icon = "graph",
- label="graph",
- tooltip=gettext("Monthly graphic",domain="R-stacomiR")),
- Graph2=gWidgets::gaction(handler = hbilanMigrationPargraph2,
+ label="gr qual",
+ tooltip=gettext("Plot for qualitative parm",domain="R-stacomiR")),
+ Graph2=gWidgets::gaction(handler = hbmCplotqual,
icon = "graph2",
- label="grjour",
- tooltip=gettext("Daily graphic",domain="R-stacomiR")),
- Stat =gWidgets::gaction(handler= hbilanMigrationParstat,
+ label="gr quan",
+ tooltip=gettext("plot for quantitative parm",domain="R-stacomiR")),
+ Graph3=gWidgets::gaction(handler = hbmCplotcrossed,
+ icon = "graph2",
+ label="gr crossed",
+ tooltip=gettext("Crossed graph for qualitative and quantitative parameter",domain="R-stacomiR")),
+ Stat =gWidgets::gaction(handler= hbmCstat,
icon = "matrix",
label="stat",
- tooltip=gettext("Summary in .csv",domain="R-stacomiR")),
+ tooltip=gettext("Summary",domain="R-stacomiR")),
annuler=gWidgets::gaction(handler= quitte,
icon = "close",
label=gettext("Exit",domain="R-stacomiR")))
@@ -62,6 +79,6 @@
#graphes=ggraphics(width=600,height=400)
#add(ggrouptotal1,graphes ) # on ajoute au groupe horizontal
#assign("graphes",graphes,envir=envir_stacomi)
- dev.new()
+
}
\ No newline at end of file
Modified: pkg/stacomir/R/interface_BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigrationMult.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/interface_BilanMigrationMult.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -70,6 +70,6 @@
#graphes=ggraphics(width=650,height=650)
#add(ggrouptotal1,graphes ) # on ajoute au groupe horizontal
#assign("graphes",graphes,envir=envir_stacomi)
- dev.new()
+
}
Deleted: pkg/stacomir/R/interface_Bilan_taille.r
===================================================================
--- pkg/stacomir/R/interface_Bilan_taille.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/interface_Bilan_taille.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -1,61 +0,0 @@
-# Nom fichier : interface_Bilan_taille.R (interface)
-
-# see interface_Bilancarlot for doc
-interface_BilanTaille = function()
-{
- quitte() # vidange de l'interface
- bilan_taille=new("Bilan_taille")
- assign("bilan_taille",bilan_taille,envir=envir_stacomi)
- #funout(gettext("Loading of vue_ope_lot view, cd and timesteps choices\n",domain="R-stacomiR"))
- bilan_taille at dc=charge(bilan_taille at dc)
- #bilan_taille at taxons=charge(bilan_taille at taxons)
- #bilan_taille at stades=charge(bilan_taille at stades)
- #bilan_taille at par=charge(bilan_taille at par)
-
- group <- gWidgets::ggroup(horizontal=FALSE) # doit toujours s'appeller group
- assign("group",group,envir = .GlobalEnv)
- add(ggroupboutons,group)
- gl=glabel(text=gettext("Size report",domain="R-stacomiR"),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_taille at horodate,
- label=gettext("First timestamp",domain="R-stacomiR"),
- nomassign="bilan_taille_date_debut",
- funoutlabel=gettext("The beginning date has been chosen\n",domain="R-stacomiR"),
- decal=-2,
- affichecal=FALSE)
- choice(bilan_taille at horodate,
- label=gettext("Last timestamp",domain="R-stacomiR"),
- nomassign="bilan_taille_date_fin",
- funoutlabel=gettext("The ending date has been chosen\n",domain="R-stacomiR"),
- decal=-1,
- affichecal=FALSE)
-
- choice(bilan_taille at dc,objectBilan=bilan_taille,is.enabled=TRUE)
- aGrint=gWidgets::gaction(label="ggplot",icon="gWidgetsRGtk2-bubbles",handler=fungraphInteract_tail,tooltip=gettext("dotplot",domain="R-stacomiR"))
- aTable=gWidgets::gaction(label=gettext("table",domain="R-stacomiR"),icon="dataframe",handler=funtableBilan_tail,tooltip=gettext("Table",domain="R-stacomiR"))
- aQuit=gWidgets::gaction(label=gettext("Exit",domain="R-stacomiR"),icon="close", handler=quitte,tooltip=gettext("Exit",domain="R-stacomiR"))
- aCalc=gWidgets::gaction(handler=hcalculeBilanTaille,action=bilan_taille,icon = "new",label="calcul",tooltip=gettext("crossed query length / qualitative feature",domain="R-stacomiR"))
- toolbarlist <- list(
- # barchart=aBarchart,
- Calc=aCalc,
- Grint=aGrint,
- table=aTable,
- Quit = aQuit)
- ggroupboutonsbas = gWidgets::ggroup(horizontal=FALSE)
- gWidgets::add(ggroupboutons,ggroupboutonsbas)
- enabled(toolbarlist[["Grint"]])<-FALSE
- enabled(toolbarlist[["table"]])<-FALSE
- gWidgets::add(ggroupboutonsbas, gtoolbar(toolbarlist))
- gWidgets::addSpring(group)
- #graphes=ggraphics(width=600,height=400)
- #add(ggrouptotal1,graphes ) # on ajoute au groupe horizontal
- #assign("graphes",graphes,envir=envir_stacomi)
- dev.new()
- assign("toolbarlist",toolbarlist,envir=.GlobalEnv)
- assign("ggroupboutonsbas",ggroupboutonsbas,envir =.GlobalEnv)
-}
Modified: pkg/stacomir/R/stacomi.r
===================================================================
--- pkg/stacomir/R/stacomi.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/R/stacomi.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -306,6 +306,7 @@
#' @importFrom Hmisc wtd.quantile
#' @importFrom Hmisc capitalize
#' @importFrom mgcv gam
+#' @importFrom MIfuns ftable2data.frame
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @examples
#'
Modified: pkg/stacomir/inst/config/stacomi_manual_launch.r
===================================================================
--- pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-05-08 20:07:03 UTC (rev 359)
@@ -88,7 +88,7 @@
source("interface_BilanMigrationInterAnnuelle.r")
source("interface_Bilan_carlot.r")
source("interface_bilan_poids_moyen.r")
-source("interface_Bilan_taille.r")
+#source("interface_Bilan_taille.r")
source("interface_BilanConditionEnv.r")
source("interface_BilanMigration.r")
source("interface_BilanMigrationMultConditionEnv.r")
Modified: pkg/stacomir/inst/examples/bilanMigrationCar-example.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationCar-example.R 2017-05-08 17:47:50 UTC (rev 358)
+++ pkg/stacomir/inst/examples/bilanMigrationCar-example.R 2017-05-08 20:07:03 UTC (rev 359)
@@ -61,5 +61,6 @@
# load the dataset generated by previous lines
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)
+
}
More information about the Stacomir-commits
mailing list