[Stacomir-commits] r378 - in pkg/stacomir: R inst/config inst/tests/testthat
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jun 4 14:50:37 CEST 2017
Author: briand
Date: 2017-06-04 14:50:37 +0200 (Sun, 04 Jun 2017)
New Revision: 378
Modified:
pkg/stacomir/R/BilanMigrationCar.r
pkg/stacomir/R/RefChoix.r
pkg/stacomir/R/RefDC.r
pkg/stacomir/R/RefStades.r
pkg/stacomir/R/RefTaxon.r
pkg/stacomir/R/Refpar.r
pkg/stacomir/R/Refparqual.r
pkg/stacomir/R/interface_BilanMigrationCar.r
pkg/stacomir/R/utilitaires.r
pkg/stacomir/inst/config/libraries.r
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/tests/testthat/test-10BilanConditionEnv.R
pkg/stacomir/inst/tests/testthat/test-11BilanMigrationMultConditionEnv.R
Log:
development of the graphical interface for BilanMigrationCar
Modified: pkg/stacomir/R/BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/BilanMigrationCar.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/BilanMigrationCar.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -64,11 +64,11 @@
#' command line interface for BilanMigrationCar class
#' @param object An object of class \link{BilanMigrationCar-class}
#' @param dc A numeric or integer, the code of the dc, coerced to integer,see \link{choice_c,RefDC-method}
-#' @param taxons '2220=Salmo salar',
+#' @param taxons '2220=Salmo salar', can be a vector with several values
#' these should match the ref.tr_taxon_tax referential table in the stacomi database, see \link{choice_c,RefTaxon-method}
-#' @param stades TODO
-#' @param parquan quantitative parameter
-#' @param parqual qualitative parameter
+#' @param stades The stages selected, can be a vector with several values
+#' @param parquan Quantitative parameter
+#' @param parqual Qualitative parameter
#' @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 echantillon Default TRUE,
@@ -274,7 +274,10 @@
#' @param h handler
#' @param ... Additional parameters
hbmCcalc=function(h,...){
- calcule(h$action)
+ bmC<-charge(h$action)
+ bmC<-connect(bmC)
+ bmC<-calcule(bmC)
+ # calcule will assign in envir_stacomi
}
#' Turns a quantitative parameter into qualitative
#'
Modified: pkg/stacomir/R/RefChoix.r
===================================================================
--- pkg/stacomir/R/RefChoix.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/RefChoix.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -106,7 +106,10 @@
valeurchoisie=svalue(choice)
object at listechoice<-valeurchoisie
assign("refchoice",object,envir_stacomi)
- funout(gettext("choice made",domain="R-stacomiR"))
+ funout(gettext("choice made\n",domain="R-stacomiR"))
+ if (svalue(notebook)<length(notebook)){
+ svalue(notebook)<-svalue(notebook)+1
+ }
}
if (!exists("notebook")) notebook <- gnotebook(container=group)
Modified: pkg/stacomir/R/RefDC.r
===================================================================
--- pkg/stacomir/R/RefDC.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/RefDC.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -176,41 +176,47 @@
if (nrow(object at data) > 0){
hDC=function(h,...){
#browser()
- object at dc_selectionne<-as.integer(tbdestdc[,][tbdestdc[,]!=""])
- object at ouvrage= object at data$dif_ouv_identifiant[object at data$dc%in%object at dc_selectionne]
- object at station= as.character(object at data$sta_code[object at data$dc%in%object at dc_selectionne])
- assign("refDC",object,envir_stacomi)
- funout(gettext("Counting device selected\n",domain="R-stacomiR"))
- # si il existe un object fils; supprimer
- # referentiel fils, celui charge par la methode charge_avec_filtre
- # ici comme on fait appel e un autre object il faut appeller le conteneur qui contient l'object
- if (!is.null(objectBilan)) {
- # ci dessous pas d'appel de charge_avec_filtre pour les bilanEspeces (tous les taxons)
- if("RefTaxon"%in%as.character(getSlots(class(objectBilan)))){
-
-
- objectBilan at dc<-object
- objectBilan at taxons<-charge_avec_filtre(object=objectBilan at taxons,dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne)
- # the name was created by the interface
- # as I can't get the name from within the function (deparse(substitute(objectBilan does not return
- # "bilanMigrationMult"
- assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
- # suppresses all tab larger than (dc)
- currenttab<-svalue(notebook)
- if (length(notebook)>currenttab){
- for (i in length(notebook):(currenttab+1)){
- svalue(notebook) <- i
- dispose(notebook) ## dispose current tab
- }}
- choicemult(objectBilan at taxons,objectBilan,is.enabled=TRUE)
- funout(gettext("Select taxa for this counting device (for all periods)\n",domain="R-stacomiR"))
+ dc_selectionne<-tbdestdc[,][tbdestdc[,]!=""]
+ object at dc_selectionne<-as.integer(dc_selectionne)
+ if (length(dc_selectionne)>0){
+ object at ouvrage= object at data$dif_ouv_identifiant[object at data$dc%in%object at dc_selectionne]
+ object at station= as.character(object at data$sta_code[object at data$dc%in%object at dc_selectionne])
+ assign("refDC",object,envir_stacomi)
+ funout(gettext("Counting device selected\n",domain="R-stacomiR"))
+ # si il existe un object fils; supprimer
+ # referentiel fils, celui charge par la methode charge_avec_filtre
+ # ici comme on fait appel e un autre object il faut appeller le conteneur qui contient l'object
+ if (!is.null(objectBilan)) {
+ # ci dessous pas d'appel de charge_avec_filtre pour les bilanEspeces (tous les taxons)
+ if("RefTaxon"%in%as.character(getSlots(class(objectBilan)))){
+
+
+ objectBilan at dc<-object
+ objectBilan at taxons<-charge_avec_filtre(object=objectBilan at taxons,dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne)
+ # the name was created by the interface
+ # as I can't get the name from within the function (deparse(substitute(objectBilan does not return
+ # "bilanMigrationMult"
+ assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+ # suppresses all tab larger than (dc)
+ currenttab<-svalue(notebook)
+ if (length(notebook)>currenttab){
+ for (i in length(notebook):(currenttab+1)){
+ svalue(notebook) <- i
+ dispose(notebook) ## dispose current tab
+ }}
+ choicemult(objectBilan at taxons,objectBilan,is.enabled=TRUE)
+ #funout(gettext("Select taxa for this counting device (for all periods)\n",domain="R-stacomiR"))
+ }
}
+ # changing tab of notebook to next tab
+ if (svalue(notebook)<length(notebook)){
+ svalue(notebook)<-svalue(notebook)+1
+ }
+ #dispose(winst)
+ } else {
+ funout(gettext("Counting device not selected\n",domain="R-stacomiR"))
+
}
- # changing tab of notebook to next tab
- if (svalue(notebook)<length(notebook)){
- svalue(notebook)<-svalue(notebook)+1
- }
- #dispose(winst)
}
# Handler d'affichage du tableau
# below the widget structure [=> within (=> type
Modified: pkg/stacomir/R/RefStades.r
===================================================================
--- pkg/stacomir/R/RefStades.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/RefStades.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -106,8 +106,8 @@
if (exists("frame_parqual")) delete(group,frame_parqual)
choice(objectBilan at parqual,label=gettext("Qualitative feature",domain="R-stacomiR"),
- nomassign="refparqual",
- frameassign="frame_parqual",is.enabled=TRUE)
+ nomassign="refparqual",
+ frameassign="frame_parqual",is.enabled=TRUE)
}
#il y a bien un object parquan dans l'object Bilan
if (class(try(objectBilan at parquan,silent=TRUE))!="try-error") {
@@ -163,61 +163,71 @@
if (nrow(object at data) > 0){
hstd=function(h,...){
stades=tbdeststd[,][tbdeststd[,]!=""]
- object at data<-object at data[std_libelle%in%stades ,]
- assign("refStades",object,envir_stacomi)
- funout(gettext("Stage selected\n",domain="R-stacomiR"))
- if (!is.null(objectBilan)) {
- objectBilan at stades<-object
- assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
-
- # suppresses all tab larger than current tab
- currenttab<-svalue(notebook)
- if (length(notebook)>currenttab){
- for (i in length(notebook):(currenttab+1)){
- svalue(notebook) <- i
- dispose(notebook) ## dispose current tab
- }}
- # par defaut la methode ne charge pas de maniere interactive (par exemple en ne prenant que les stades des taxon du dc par la methode charge_avec_filtre
- # elle est alors affichee des le debut par la methode choice e laquelle on ne passe pas d'objectBilan en parametre
- #il y a bien un object par dans l'object Bilan
- if (class(try(objectBilan at par,silent=TRUE))!="try-error") {
- objectBilan at par<-charge_avec_filtre(object=objectBilan at par,
- dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
- taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code,
- stade_selectionne=get("refStades",envir_stacomi)@data$std_code)
- choicemult(objectBilan at par,is.enabled=TRUE)
- }
- #il y a bien un object parqual dans l'object Bilan
- if (class(try(objectBilan at parqual,silent=TRUE))!="try-error") {
- objectBilan at parqual<-charge_avec_filtre(object=objectBilan at parqual,
- dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
- taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code,
- stade_selectionne=get("refStades",envir_stacomi)@data$std_code)
- choicemult(objectBilan at parqual,label=gettext("Qualitative feature",domain="R-stacomiR"),
- nomassign="refparqual",frameassign="frame_parqual",
- )
- }
-#il y a bien un object parquan dans l'object Bilan
- if (class(try(objectBilan at parquan,silent=TRUE))!="try-error") {
- objectBilan at parquan<-charge_avec_filtre(object=objectBilan at parquan,
- dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
- taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code,
- stade_selectionne=get("refStades",envir_stacomi)@data$std_code)
- if (class(objectBilan)=="Bilan_taille" )
- {
- if (nrow(objectBilan at parquan@data)>0) {
- objectBilan at parquan@data=objectBilan at parquan@data[objectBilan at parquan@data$par_code=="1786"| #taille
- objectBilan at parquan@data$par_code=="1785"| # taille fourche
- is.na(objectBilan at parquan@data$par_code)|objectBilan at parquan@data$par_code=="C001",] # aucune
+ if (length(stades)>0){
+ object at data<-object at data[std_libelle%in%stades ,]
+ assign("refStades",object,envir_stacomi)
+ funout(gettext("Stage selected\n",domain="R-stacomiR"))
+ if (!is.null(objectBilan)) {
+ objectBilan at stades<-object
+ assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+
+ # suppresses all tab larger than current tab
+ stagetab<-svalue(notebook)
+ if (length(notebook)>stagetab){
+ for (i in length(notebook):(stagetab+1)){
+ svalue(notebook) <- i
+ dispose(notebook) ## dispose current tab
+ }}
+ # if the class is loaded from with a bilanObject
+ # and there is no parquan inside
+ # then par is loaded, instead parquan and parqual are loaded
+ # as now BilanMigrationCar inherits from bilan_carlot and thus possesses a
+ # refpar class
+ if (class(try(objectBilan at par,silent=TRUE))!="try-error"&
+ class(try(objectBilan at parqual,silent=TRUE))=="try-error") {
+ objectBilan at par<-charge_avec_filtre(object=objectBilan at par,
+ dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
+ taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code,
+ stade_selectionne=get("refStades",envir_stacomi)@data$std_code)
+ choicemult(objectBilan at par,nomassign="refpar",
+ objectBilan,
+ label=gettext("Parm.",domain="R-stacomiR"))
+ }
+ # there is an object parqual with the Bilan Object
+ if (class(try(objectBilan at parqual,silent=TRUE))!="try-error") {
+ objectBilan at parqual<-charge_avec_filtre(object=objectBilan at parqual,
+ dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
+ taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code,
+ stade_selectionne=get("refStades",envir_stacomi)@data$std_code)
+ choicemult(objectBilan at parqual,
+ objectBilan,
+ nomassign="refparqual",
+ label=gettext("Qualit. parm.",domain="R-stacomiR")
+ )
+ }
+ # there is an object parquan with the Bilan Object
+ if (class(try(objectBilan at parquan,silent=TRUE))!="try-error") {
+ objectBilan at parquan<-charge_avec_filtre(object=objectBilan at parquan,
+ dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
+ taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code,
+ stade_selectionne=get("refStades",envir_stacomi)@data$std_code)
+ if (class(objectBilan)=="Bilan_taille" )
+ {
+ if (nrow(objectBilan at parquan@data)>0) {
+ objectBilan at parquan@data=objectBilan at parquan@data[objectBilan at parquan@data$par_code=="1786"| #taille
+ objectBilan at parquan@data$par_code=="1785"| # taille fourche
+ is.na(objectBilan at parquan@data$par_code)|objectBilan at parquan@data$par_code=="C001",] # aucune
+ }
}
+ choicemult(objectBilan at parquan,
+ objectBilan,
+ nomassign="refparquan",
+ label=gettext("Quant. parm.",domain="R-stacomiR"))
}
- choicemult(objectBilan at parquan,label=gettext("Quantitative feature",domain="R-stacomiR"),
- nomassign="refparquan",frameassign="frame_parquan",
- is.enabled=TRUE)
+ svalue(notebook)<-stagetab+1
}
- if (svalue(notebook)<length(notebook)){
- svalue(notebook)<-svalue(notebook)+1
- }
+ } else {
+ funout(gettext("No Stage selected\n",domain="R-stacomiR"))
}
}
# below the widget structure [=> within (=> type
@@ -268,7 +278,7 @@
})
gbutton("OK", container = groupstd, handler = hstd)
} else {
- funout(gettext("Error : no counting device in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
+ funout(gettext("Error : no stages in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
}
})
Modified: pkg/stacomir/R/RefTaxon.r
===================================================================
--- pkg/stacomir/R/RefTaxon.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/RefTaxon.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -116,31 +116,35 @@
if (nrow(object at data) > 0){
htax=function(h,...){
taxons=tbdesttaxon[,][tbdesttaxon[,]!=""]
- object at data<-object at data[tax_libelle%in%taxons ,]
- assign("refTaxon",object,envir_stacomi)
- funout(gettext("The taxa(s) have been selected\n",domain="R-stacomiR"))
- if (!is.null(objectBilan)) {
- objectBilan at taxons<-object
- objectBilan at stades<-charge_avec_filtre(object=objectBilan at stades,
- dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
- taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code
- )
- assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
- # suppresses all tab larger than 3 (taxon)
- # suppresses all tab larger than (dc)
- currenttab<-svalue(notebook)
- if (length(notebook)>currenttab){
- for (i in length(notebook):(currenttab+1)){
- svalue(notebook) <- i
- dispose(notebook) ## dispose current tab
- }}
- choicemult(objectBilan at stades,objectBilan,is.enabled=TRUE)
- }
- # changing tab of notebook to next tab
- if (svalue(notebook)<length(notebook)){
- svalue(notebook)<-svalue(notebook)+1
- }
- }
+ if (length(taxons)>0){
+ object at data<-object at data[tax_libelle%in%taxons ,]
+ assign("refTaxon",object,envir_stacomi)
+ funout(gettext("Taxa selected\n",domain="R-stacomiR"))
+ if (!is.null(objectBilan)) {
+ objectBilan at taxons<-object
+ objectBilan at stades<-charge_avec_filtre(object=objectBilan at stades,
+ dc_selectionne=get("refDC",envir_stacomi)@dc_selectionne,
+ taxon_selectionne=get("refTaxon",envir_stacomi)@data$tax_code
+ )
+ assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+ # suppresses all tab larger than 3 (taxon)
+ # suppresses all tab larger than (dc)
+ currenttab<-svalue(notebook)
+ if (length(notebook)>currenttab){
+ for (i in length(notebook):(currenttab+1)){
+ svalue(notebook) <- i
+ dispose(notebook) ## dispose current tab
+ }}
+ choicemult(objectBilan at stades,objectBilan,is.enabled=TRUE)
+ }
+ # changing tab of notebook to next tab
+ if (svalue(notebook)<length(notebook)){
+ svalue(notebook)<-svalue(notebook)+1
+ }
+ } else {
+ funout(gettext("No taxa selected\n",domain="R-stacomiR"))
+ }
+ }
# below the widget structure [=> within (=> type
# group(ggroup)[notebook(notebook)[grouptaxon(ggroup&tab)[[frametaxonsource(gframe)[tbsourcetaxon(gtable)],frametaxondest(gframe)[tbdtaxondest(gtable)]],OKbutton]]
if (!exists("notebook")) notebook <- gnotebook(container=group)
Modified: pkg/stacomir/R/Refpar.r
===================================================================
--- pkg/stacomir/R/Refpar.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/Refpar.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -165,11 +165,10 @@
})
-#' Multiple Choice method for RefPar referential objects
+#' Multiple Choice method for Refpar referential objects
#'
-#' @param object An object of class \link{RefPar-class}
-#' @param objectBilan An object Bilan which includes the \link{RefPar-class}, default NULL
-#' @param is.enabled Sets if the frame is enabled at launch, defaut TRUE
+#' @param object An object of class \link{Refpar-class}
+#' @param objectBilan An object Bilan which includes the \link{Refpar-class}, default NULL
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @examples
#' \dontrun{
@@ -181,26 +180,30 @@
#' objectBilan=bilan_taille # for other test
#' choicemult(object,objectBilan=bilanMigrationCar)
#' }
-setMethod("choicemult",signature=signature("Refpar"),definition=function(object,objectBilan=NULL,is.enabled=TRUE) {
+setMethod("choicemult",signature=signature("Refpar"),definition=function(object,objectBilan=NULL,
+ label=gettext("Sample characteristic",domain="R-stacomiR"),
+ nomassign="refpar") {
if (nrow(object at data) > 0){
hpar=function(h,...){
parm=tbdestpar[,][tbdestpar[,]!=""]
object at data<-object at data[car_libelle%in%parm ,]
- assign("refPar",object,envir_stacomi)
+ assign(nomassign,object,envir_stacomi)
funout(gettext("Parameter selected\n",domain="R-stacomiR"))
if (!is.null(objectBilan)) {
+ # the method can be used for parquan or par
+ # so I test whether the object contains a class parquan
+ if (class(try(objectBilan at parquan,silent=TRUE))!="try-error") {
+ objectBilan at parquan<-object
+ assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+ } else {
objectBilan at parm<-object
assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+ }
# suppresses all tab larger than current tab
- currenttab<-svalue(notebook)
- if (length(notebook)>currenttab){
- for (i in length(notebook):(currenttab+1)){
- svalue(notebook) <- i
- dispose(notebook) ## dispose current tab
- }}
+ partab<-svalue(notebook)
if (svalue(notebook)<length(notebook)){
- svalue(notebook)<-svalue(notebook)+1
+ svalue(notebook)<-partab+1
}
}
}
@@ -211,7 +214,7 @@
car_libelle[nchar(car_libelle)>30]<-paste(substr(car_libelle[nchar(car_libelle)>30],1,30),".",sep="")
grouppar<-ggroup()
assign("gouppar",grouppar,envir=.GlobalEnv)
- add(notebook,grouppar,label=gettext("Sample characteritic",domain="R-stacomiR"))
+ add(notebook,grouppar,label=label)
frameparsource<-gframe(gettext("Select here",domain="R-stacomiR"),container=grouppar)
tbsourcepar = gtable(car_libelle,container=frameparsource,expand = TRUE, fill = TRUE)
size(tbsourcepar)<-c(160,300)
@@ -253,6 +256,6 @@
})
gbutton("OK", container = grouppar, handler = hpar)
} else {
- funout(gettext("Error : no counting device in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
+ funout(gettext("Error : no parameters in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
}
})
Modified: pkg/stacomir/R/Refparqual.r
===================================================================
--- pkg/stacomir/R/Refparqual.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/Refparqual.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -118,7 +118,7 @@
#' }
setMethod("choice",signature=signature("Refparqual"),definition=function(object,
label=gettext("Choice of a sample characteristic",domain="R-stacomiR"),
- nomassign="refpar",
+ nomassign="refparqual",
frameassign="frame_par",
is.enabled=TRUE) {
if (nrow(object at data) > 0){
@@ -127,7 +127,7 @@
object at data<-object at data[car_libelle%in%carchoisi ,]
object<-charge_complement(object)
assign(nomassign,object,envir_stacomi)
- funout(gettext("Feature has been selected\n",domain="R-stacomiR"))
+ funout(gettext("Features have been selected\n",domain="R-stacomiR"))
}
assign(frameassign,gframe(label),envir= .GlobalEnv)
add(group,get(eval(frameassign),envir= .GlobalEnv))
@@ -136,3 +136,91 @@
gbutton("OK", container=get(eval(frameassign),envir= .GlobalEnv),handler=hcar)
} else stop(gettext("Internal error : unable to load any feature to make the choice\n",domain="R-stacomiR"),arret=TRUE)
})
+
+
+#' Multiple Choice method for Refparqual referential objects internal use
+#' @note this methods rewrites that of the Refpar as it integrates a call to chargecomplement to load
+#' the list of possible values for a qualitative parameter
+#' @param object An object of class \link{Refparqual-class}
+#' @param objectBilan An object Bilan which includes the \link{Refparqual-class}, default NULL
+#' @param nomassign The name used when assigning the object Refparqual to the \code{envir_stacomi} environment
+#' @param label The name of the frame
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+setMethod("choicemult",signature=signature("Refparqual"),definition=function(object,
+ objectBilan=NULL,
+ nomassign="refparqual",
+ label=gettext("Qualitative",domain="R-stacomiR")) {
+ if (nrow(object at data) > 0){
+ hpar=function(h,...){
+ parm=tbdestpar[,][tbdestpar[,]!=""]
+ if (length(parm)>0){
+ object at data<-object at data[car_libelle%in%parm ,]
+ # below the line that changes from the Refpar
+ object<-charge_complement(object)
+ assign(nomassign,object,envir_stacomi)
+ funout(gettext("Parameter selected\n",domain="R-stacomiR"))
+ } else {
+ funout(gettext("No Parameter selected\n",domain="R-stacomiR"))
+ }
+ if (!is.null(objectBilan)) {
+ objectBilan at parqual<-object
+ assign(get("objectBilan",envir=envir_stacomi),objectBilan,envir=envir_stacomi)
+ # suppresses all tab larger than current tab
+ qualtab<-svalue(notebook)
+ if (svalue(notebook)<length(notebook)){
+ svalue(notebook)<-qualtab+1
+ }
+ }
+ }
+ # below the widget structure [=> within (=> type
+ # group(ggroup)[notebook(notebook)[groupstd(ggroup&tab)[[framestdsource(gframe)[tbsourcestd(gtable)],framestddest(gframe)[tbdeststd(gtable)]],OKbutton]]
+ if (!exists("notebook")) notebook <- gnotebook(container=group)
+ car_libelle=fun_char_spe(object at data$par_nom)
+ car_libelle[nchar(car_libelle)>30]<-paste(substr(car_libelle[nchar(car_libelle)>30],1,30),".",sep="")
+ grouppar<-ggroup()
+ assign("gouppar",grouppar,envir=.GlobalEnv)
+ add(notebook,grouppar,label=gettext("Qualitative",domain="R-stacomiR"))
+ frameparsource<-gframe(gettext("Select here",domain="R-stacomiR"),container=grouppar)
+ tbsourcepar = gtable(car_libelle,container=frameparsource,expand = TRUE, fill = TRUE)
+ size(tbsourcepar)<-c(160,300)
+ framepardest<-gframe(gettext("drop here",domain="R-stacomiR"),container=grouppar)
+ # need for a fixed size data.frame otherwise errors when adding new lines
+ xx<-data.frame(choice=rep("",8))
+ xx$choice<-as.character(xx$choice)
+ tbdestpar=gtable(xx,container=framepardest,expand = TRUE, fill = TRUE)
+ size(tbdestpar)<-c(160,300)
+ adddropsource(tbsourcepar)
+ adddroptarget(tbdestpar)
+ adddropmotion(tbdestpar,handler=function(h,...) {
+ valeurs<-tbdestpar[,]
+ valeurs<-valeurs[valeurs!=""]
+ if (!svalue(tbsourcepar)%in%valeurs){
+ tbdestpar[length(valeurs)+1,1]<-svalue(tbsourcepar)
+ }
+ })
+ addHandlerDoubleclick(tbsourcepar,handler=function(h,...) {
+ valeurs<-tbdestpar[,]
+ valeurs<-valeurs[valeurs!=""]
+ if (!svalue(tbsourcepar)%in%valeurs){
+ tbdestpar[length(valeurs)+1,1]<-svalue(h$obj)
+ }
+ })
+ adddropsource(tbdestpar)
+ adddroptarget(tbsourcepar)
+ removepar<-function(){
+ valeurs<-tbdestpar[,]
+ valeurs<-valeurs[valeurs!=""]
+ valeurs<-valeurs[-match(svalue(tbdestpar),valeurs)]
+ tbdestpar[,]<-c(valeurs,rep("",8-length(valeurs)))
+ }
+ adddropmotion(tbsourcepar,handler=function(h,...) {
+ removepar()
+ })
+ addHandlerDoubleclick(tbdestpar,handler=function(h,...) {
+ removepar()
+ })
+ gbutton("OK", container = grouppar, handler = hpar)
+ } else {
+ funout(gettext("Error : no qualitative parameters in the database (the query returns 0 entry)\n",domain="R-stacomiR"),arret=TRUE)
+ }
+ })
Modified: pkg/stacomir/R/interface_BilanMigrationCar.r
===================================================================
--- pkg/stacomir/R/interface_BilanMigrationCar.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/interface_BilanMigrationCar.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -34,18 +34,18 @@
assign("group",group,envir = .GlobalEnv)
notebook <- gnotebook(container=group)
assign("notebook",notebook,envir=.GlobalEnv)
- size(notebook)<-c(400,300)
- gWidgets::add(ggroupboutons,group)
+ size(notebook)<-c(400,400)
+
- choicemult(bilanMigrationCar at horodatedebut,label=gettext("from",domain="R-stacomiR"))
- choicemult(bilanMigrationCar at horodatefin,label=gettext("to",domain="R-stacomiR"))
+ 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)
- # 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"'
+# FIXME Error in .local(object, ...) :
+# unused arguments (label = "Qualitative feature", frameassign = "frame_parqual") verify
svalue(notebook)<-1
+ gWidgets::add(ggroupboutons,group)
+ # ggroupboutons is attached to the original frame
ggroupboutonsbas = gWidgets::ggroup(horizontal=FALSE)
gWidgets::add(ggroupboutons,ggroupboutonsbas)
assign("ggroupboutonsbas",ggroupboutonsbas, envir=.GlobalEnv)
@@ -76,9 +76,4 @@
label=gettext("Exit",domain="R-stacomiR")))
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)
-
-
}
\ No newline at end of file
Modified: pkg/stacomir/R/utilitaires.r
===================================================================
--- pkg/stacomir/R/utilitaires.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/R/utilitaires.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -22,7 +22,7 @@
# delete(ggroupboutons,group)
# rm(group,envir= .GlobalEnv)
# }
- dispose(ggroupboutonsbas)
+ if (exists("win",envir=.GlobalEnv)) dispose(win)
if (exists("envir_stacomi")){
miettes=ls(envir=envir_stacomi)
if (length(miettes)> 0 ) {
Modified: pkg/stacomir/inst/config/libraries.r
===================================================================
--- pkg/stacomir/inst/config/libraries.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/inst/config/libraries.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -3,7 +3,7 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
libraries=function() {
necessary = c( 'RODBC','ggplot2','gWidgets','gWidgetsRGtk2',
- 'lattice','RColorBrewer','Rcmdr','xtable','scales','reshape2','grid','stringr','intervals','sqldf','RPostgreSQL') # 'tcltk2','XML', 'Hmisc''svMisc''proto''R2HTML'
+ 'lattice','RColorBrewer','xtable','scales','reshape2','grid','stringr','intervals','sqldf','RPostgreSQL') # 'tcltk2','XML', 'Hmisc''svMisc''proto''R2HTML'
if(!all(necessary %in% installed.packages()[, 'Package']))
install.packages(necessary[!necessary %in% installed.packages()[, 'Package']], dependencies = TRUE)
#if (!'XML'%in%installed.packages()[, 'Package']) install.packages("XML", repos = "http://www.omegahat.org/R")
Modified: pkg/stacomir/inst/config/stacomi_manual_launch.r
===================================================================
--- pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/inst/config/stacomi_manual_launch.r 2017-06-04 12:50:37 UTC (rev 378)
@@ -22,14 +22,13 @@
setwd(pgwd)
# pour voir apparaitre toutes les requetes dans R
# assign("showmerequest",1,envir=envir_stacomi)
-source ("F:/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
-<<<<<<< .mine
+source ("C:/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
-source ("C:/Users/logrami/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
-=======
+
+
#source ("C:/Users/logrami/workspace/stacomir/pkg/stacomir/inst/config/libraries.r")
->>>>>>> .r359
+
libraries()
source("utilitaires.r") # contient funout (pour ecrire dans la console) et filechoose
@@ -68,9 +67,11 @@
source("BilanConditionEnv.r")
source("BilanMigrationMultConditionEnv.r")
source("Bilan_carlot.r")
+require(xtable)
source("BilanMigrationCar.r")
source("BilanMigrationInterAnnuelle.r")
-require(xtable)
+source("BilanMigrationCar.r")
+
source("BilanAnnuels.r")
source("BilanArgentee.r")
@@ -106,7 +107,7 @@
source("interface_BilanAgedemer.r")
source("stacomi.r")
# interface_BilanEspeces dans BilanEspeces
-setwd("F:/workspace/stacomir/pkg/stacomir")
-stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+setwd("C:/workspace/stacomir/pkg/stacomir")
+stacomi(gr_interface=TRUE,login_window=FALSE,database_expected=FALSE)
Modified: pkg/stacomir/inst/tests/testthat/test-10BilanConditionEnv.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-10BilanConditionEnv.R 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/inst/tests/testthat/test-10BilanConditionEnv.R 2017-06-04 12:50:37 UTC (rev 378)
@@ -1,4 +1,3 @@
-# TODO: Add comment
#
# Author: cedric.briand
###############################################################################
Modified: pkg/stacomir/inst/tests/testthat/test-11BilanMigrationMultConditionEnv.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-11BilanMigrationMultConditionEnv.R 2017-06-04 06:43:48 UTC (rev 377)
+++ pkg/stacomir/inst/tests/testthat/test-11BilanMigrationMultConditionEnv.R 2017-06-04 12:50:37 UTC (rev 378)
@@ -1,4 +1,3 @@
-# TODO: Add comment
#
# Author: cedric.briand
###############################################################################
More information about the Stacomir-commits
mailing list