[Stacomir-commits] r379 - in pkg/stacomir: R data inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jun 4 18:54:25 CEST 2017
Author: briand
Date: 2017-06-04 18:54:24 +0200 (Sun, 04 Jun 2017)
New Revision: 379
Modified:
pkg/stacomir/R/BilanMigrationCar.r
pkg/stacomir/R/RefChoix.r
pkg/stacomir/R/Refpar.r
pkg/stacomir/R/Refparqual.r
pkg/stacomir/R/interface_BilanMigrationCar.r
pkg/stacomir/data/bmC.rda
pkg/stacomir/inst/examples/bilanMigrationCar-example.R
Log:
BilanMigrationCar.r development for graphical interface
Modified: pkg/stacomir/R/BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/BilanMigrationCar.r 2017-06-04 12:50:37 UTC (rev 378)
+++ pkg/stacomir/R/BilanMigrationCar.r 2017-06-04 16:54:24 UTC (rev 379)
@@ -43,7 +43,8 @@
parquan="Refparquan"),
prototype=list(
data=list(),
- echantillon=new("RefChoix"),
+ echantillon=new("RefChoix","listechoice"=c(gettext(c("with","without"),domain="stacomiR")),
+ selectedvalue=gettext("with",domain="stacomiR")),
calcdata<-list(),
parqual=new("Refparqual"),
parquan=new("Refparquan")),
@@ -86,7 +87,7 @@
parqual=NULL,
horodatedebut,
horodatefin,
- echantillon=TRUE,
+ echantillon=gettext("with",domain="R-stacomiR"),
silent=FALSE){
# code for debug using example
#horodatedebut="2012-01-01";horodatefin="2013-12-31";dc=c(107,108,101);taxons=2220; stades=c('5','11','BEC','BER','IND');parquan=c('1786','1785','C001','A124');parqual='COHO';silent=FALSE
@@ -108,8 +109,7 @@
if (!is.null(parqual)){
bmC at parqual<-choice_c(bmC at parqual,parqual,silent=silent)
bmC at parqual<-charge_complement(bmC at parqual)
- }
- # the method choice_c is written in refpar, and each time
+ }
assign("refparqual",bmC at parqual,envir_stacomi)
bmC at horodatedebut<-choice_c(object=bmC at horodatedebut,
nomassign="bmC_date_debut",
@@ -121,7 +121,9 @@
funoutlabel=gettext("Ending date has been chosen\n",domain="R-stacomiR"),
horodate=horodatefin,
silent=silent)
- bmC at echantillon<-charge(bmC at echantillon,vecteur=c(TRUE,FALSE),label="essai",selected=as.integer(1))
+ bmC at echantillon<-charge(bmC at echantillon,vecteur=c(gettext("with",domain="R-stacomiR"),gettext("without",domain="R-stacomiR")),
+ label="essai",
+ selected=as.integer(1))
bmC at echantillon<-choice_c(bmC at echantillon,selectedvalue=echantillon)
validObject(bmC)
return(bmC)
@@ -136,7 +138,18 @@
#' @return \link{BilanMigrationCar-class} with slots filled by user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
setMethod("charge",signature=signature("BilanMigrationCar"),definition=function(object,silent=FALSE){
- bmC<-object
+ bmC<-object
+ if (exists("bmC_date_debut",envir_stacomi)) {
+ bmC at horodatedebut@horodate<-get("bmC_date_debut",envir_stacomi)
+ } else {
+ funout(gettext("You need to choose the starting date\n",domain="R-stacomiR"),arret=TRUE)
+ }
+ if (exists("bmC_date_fin",envir_stacomi)) {
+ bmC at horodatefin@horodate<-get("bmC_date_fin",envir_stacomi)
+ } else {
+ funout(gettext("You need to choose the ending date\n",domain="R-stacomiR"),arret=TRUE)
+ }
+
if (exists("refDC",envir_stacomi)) {
bmC at dc<-get("refDC",envir_stacomi)
} else {
@@ -153,17 +166,7 @@
{
funout(gettext("You need to choose a stage, clic on validate\n",domain="R-stacomiR"),arret=TRUE)
}
- if (exists("bmC_date_debut",envir_stacomi)) {
- bmC at horodatedebut@horodate<-get("bmC_date_debut",envir_stacomi)
- } else {
- funout(gettext("You need to choose the starting date\n",domain="R-stacomiR"),arret=TRUE)
- }
- if (exists("bmC_date_fin",envir_stacomi)) {
- bmC at horodatefin@horodate<-get("bmC_date_fin",envir_stacomi)
- } else {
- funout(gettext("You need to choose the ending date\n",domain="R-stacomiR"),arret=TRUE)
- }
-
+
if (exists("refchoice",envir_stacomi)){
bmC at echantillon<-get("refchoice",envir_stacomi)
} else
@@ -197,7 +200,7 @@
#' @export
setMethod("connect",signature=signature("BilanMigrationCar"),definition=function(object,silent=FALSE){
bmC<-object
- if (!bmC at echantillon@selectedvalue) {
+ if (bmC at echantillon@selectedvalue==bmC at echantillon@listechoice[1]) {
echantillons=" AND lot_pere IS NULL"
} else {
echantillons=""
@@ -274,7 +277,8 @@
#' @param h handler
#' @param ... Additional parameters
hbmCcalc=function(h,...){
- bmC<-charge(h$action)
+ bmC<-get("bmC",envir=envir_stacomi)
+ bmC<-charge(bmC)
bmC<-connect(bmC)
bmC<-calcule(bmC)
# calcule will assign in envir_stacomi
@@ -355,7 +359,7 @@
hbmCplotquan = function(h,...) {
if (exists("bmC",envir_stacomi)) {
bmC<-get("bmC",envir_stacomi)
- plot(bmC,plot.type="quan")
+ plot(bmC,plot.type="quan",silent=FALSE)
} else {
funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
}
@@ -367,7 +371,7 @@
hbmCplotqual=function(h,...){
if (exists("bmC",envir_stacomi)) {
bmC<-get("bmC",envir_stacomi)
- plot(bmC,plot.type="qual")
+ plot(bmC,plot.type="qual",silent=FALSE)
} else {
funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
}
@@ -379,7 +383,7 @@
hbmCplotcrossed=function(h,...){
if (exists("bmC",envir_stacomi)) {
bmC<-get("bmC",envir_stacomi)
- plot(bmC,plot.type="crossed")
+ plot(bmC,plot.type="crossed",silent=FALSE)
} else {
funout(gettext("You need to launch computation first, clic on calc\n",domain="R-stacomiR"),arret=TRUE)
}
Modified: pkg/stacomir/R/RefChoix.r
===================================================================
--- pkg/stacomir/R/RefChoix.r 2017-06-04 12:50:37 UTC (rev 378)
+++ pkg/stacomir/R/RefChoix.r 2017-06-04 16:54:24 UTC (rev 379)
@@ -104,7 +104,7 @@
) {
hlist=function(h,...){
valeurchoisie=svalue(choice)
- object at listechoice<-valeurchoisie
+ object at selectedvalue<-valeurchoisie
assign("refchoice",object,envir_stacomi)
funout(gettext("choice made\n",domain="R-stacomiR"))
if (svalue(notebook)<length(notebook)){
Modified: pkg/stacomir/R/Refpar.r
===================================================================
--- pkg/stacomir/R/Refpar.r 2017-06-04 12:50:37 UTC (rev 378)
+++ pkg/stacomir/R/Refpar.r 2017-06-04 16:54:24 UTC (rev 379)
@@ -187,7 +187,7 @@
if (nrow(object at data) > 0){
hpar=function(h,...){
parm=tbdestpar[,][tbdestpar[,]!=""]
- object at data<-object at data[car_libelle%in%parm ,]
+ object at par_selectionne<-object at data[car_libelle%in%parm,"par_code"]
assign(nomassign,object,envir_stacomi)
funout(gettext("Parameter selected\n",domain="R-stacomiR"))
if (!is.null(objectBilan)) {
Modified: pkg/stacomir/R/Refparqual.r
===================================================================
--- pkg/stacomir/R/Refparqual.r 2017-06-04 12:50:37 UTC (rev 378)
+++ pkg/stacomir/R/Refparqual.r 2017-06-04 16:54:24 UTC (rev 379)
@@ -89,7 +89,7 @@
requete=new("RequeteODBC")
requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
requete at sql= paste("select * from ref.tr_valeurparametrequalitatif_val",
- " WHERE val_qal_code in ", vector_to_listsql(object at data$par_code),
+ " WHERE val_qal_code in ", vector_to_listsql(object at par_selectionne),
" ORDER BY val_rang",sep="")
requete<-stacomirtools::connect(requete)
#funout(gettext("The query to load parameters is done \n",domain="R-stacomiR"))
@@ -154,7 +154,7 @@
hpar=function(h,...){
parm=tbdestpar[,][tbdestpar[,]!=""]
if (length(parm)>0){
- object at data<-object at data[car_libelle%in%parm ,]
+ object at par_selectionne<-object at data[car_libelle%in%parm ,"par_code"]
# below the line that changes from the Refpar
object<-charge_complement(object)
assign(nomassign,object,envir_stacomi)
Modified: pkg/stacomir/R/interface_BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigrationCar.r 2017-06-04 12:50:37 UTC (rev 378)
+++ pkg/stacomir/R/interface_BilanMigrationCar.r 2017-06-04 16:54:24 UTC (rev 379)
@@ -4,13 +4,13 @@
{
quitte()
- bilanMigrationCar=new("BilanMigrationCar")
- assign("bilanMigrationCar",bilanMigrationCar,envir=envir_stacomi)
+ bmC=new("BilanMigrationCar")
+ assign("bmC",bmC,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"
+ objectBilan="bmC"
# 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)
@@ -18,13 +18,16 @@
# 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"))
- 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"),
+ bmC at taxons=charge(bmC at taxons)
+ bmC at stades=charge(bmC at stades)
+ bmC at dc=charge(bmC at dc)
+ bmC at parquan=charge(bmC at parquan)
+ bmC at parqual=charge(bmC at parqual)
+ # below, the first element must be the element where samples are accepted (currently with)
+ # this is how it will be evaluated in the connect method, as I can't base myself on the value
+ # which will change with language
+ bmC at echantillon=charge(bmC 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))
#######################
@@ -34,13 +37,13 @@
assign("group",group,envir = .GlobalEnv)
notebook <- gnotebook(container=group)
assign("notebook",notebook,envir=.GlobalEnv)
- size(notebook)<-c(400,400)
+ size(notebook)<-c(400,600)
- choicemult(bilanMigrationCar at horodatedebut,label=gettext("from",domain="R-stacomiR"),decal=-1)
- choicemult(bilanMigrationCar at horodatefin,label=gettext("to",domain="R-stacomiR"),decal=0)
- choicemult(bilanMigrationCar at echantillon)
- choicemult(bilanMigrationCar at dc,objectBilan=bilanMigrationCar,is.enabled=TRUE)
+ choicemult(bmC at horodatedebut,nomassign="bmC_date_debut",label=gettext("from",domain="R-stacomiR"),decal=-1)
+ choicemult(bmC at horodatefin,,nomassign="bmC_date_fin",label=gettext("to",domain="R-stacomiR"),decal=0)
+ choicemult(bmC at echantillon)
+ choicemult(bmC at dc,objectBilan=bmC,is.enabled=TRUE)
# FIXME Error in .local(object, ...) :
# unused arguments (label = "Qualitative feature", frameassign = "frame_parqual") verify
svalue(notebook)<-1
@@ -53,15 +56,14 @@
Calc=gWidgets::gaction(handler = hbmCcalc,
icon = "new",
label=gettext("calculation"),
- action=bilanMigrationCar,
tooltip=gettext("calculation",domain="R-stacomiR")),
Graph=gWidgets::gaction(handler = hbmCplotquan,
icon = "graph",
- label="gr qual",
+ label="gr quan",
tooltip=gettext("Plot for qualitative parm",domain="R-stacomiR")),
Graph2=gWidgets::gaction(handler = hbmCplotqual,
icon = "graph2",
- label="gr quan",
+ label="gr qual",
tooltip=gettext("plot for quantitative parm",domain="R-stacomiR")),
Graph3=gWidgets::gaction(handler = hbmCplotcrossed,
icon = "graph2",
@@ -76,4 +78,5 @@
label=gettext("Exit",domain="R-stacomiR")))
gWidgets::add(ggroupboutonsbas, gtoolbar(toolbarlist))
gWidgets::addSpring(group)
+ assign("bmC",bmC,envir=envir_stacomi)
}
\ No newline at end of file
Modified: pkg/stacomir/data/bmC.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/inst/examples/bilanMigrationCar-example.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationCar-example.R 2017-06-04 12:50:37 UTC (rev 378)
+++ pkg/stacomir/inst/examples/bilanMigrationCar-example.R 2017-06-04 16:54:24 UTC (rev 379)
@@ -20,6 +20,7 @@
parquan=c('A124','C001','1786','1785'),
horodatedebut="2012-01-01",
horodatefin="2012-12-31",
+ #echantillon="with" use the translated value here, default with
silent=FALSE)
# bmC<-charge(bmC) not necessary there
bmC<-connect(bmC)
@@ -55,6 +56,7 @@
parquan=c('A124','C001','1786','1785'),
horodatedebut="2009-01-01",
horodatefin="2012-12-31",
+ #echantillon="with", # alternative "without"
silent=FALSE)
# bmC<-charge(bmC) not necessary there
bmC<-connect(bmC)
More information about the Stacomir-commits
mailing list