[Stacomir-commits] r314 - pkg/stacomir/R

[noreply at r-forge.r-project.org]

Author: briand
Date: 2017-03-18 21:13:13 +0100 (Sat, 18 Mar 2017)
New Revision: 314

Modified:
   pkg/stacomir/R/RefStationMesure.r
Log:
Developping choice_c method for RefStationMesure

Modified: pkg/stacomir/R/RefStationMesure.r
===================================================================
--- pkg/stacomir/R/RefStationMesure.r	2017-03-17 16:58:58 UTC (rev 313)
+++ pkg/stacomir/R/RefStationMesure.r	2017-03-18 20:13:13 UTC (rev 314)
@@ -12,8 +12,8 @@
 #' @author cedric.briand"at"eptb-vilaine.fr
 #' @keywords classes
 setClass (Class="RefStationMesure", 
-   representation=representation(data="data.frame"),
-   prototype=prototype(data=data.frame())
+		representation=representation(data="data.frame"),
+		prototype=prototype(data=data.frame())
 )
 
 #' Loading method for RefStationMesure referential object
@@ -26,19 +26,19 @@
 #'  charge(object)
 #' }
 setMethod("charge",
-          signature=signature("RefStationMesure"),     
-          definition=function(object) 
-          {
-        			requete=new("RequeteODBC")
-        			requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
-        			requete at sql= paste("SELECT stm_identifiant, stm_libelle, stm_sta_code, stm_par_code, stm_description",
-                    " FROM ",get("sch",envir=envir_stacomi),"tj_stationmesure_stm", 
+		signature=signature("RefStationMesure"),     
+		definition=function(object) 
+		{
+			requete=new("RequeteODBC")
+			requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
+			requete at sql= paste("SELECT stm_identifiant, stm_libelle, stm_sta_code, stm_par_code, stm_description",
+					" FROM ",get("sch",envir=envir_stacomi),"tj_stationmesure_stm", 
 					" ORDER BY stm_identifiant;",sep="")
-        			requete at silent = TRUE;
-        			requete<-stacomirtools::connect(requete)    
-        			object at data<-requete at query
-        			return(object)
-          }
+			requete at silent = TRUE;
+			requete<-stacomirtools::connect(requete)    
+			object at data<-requete at query
+			return(object)
+		}
 )
 #' Choice method for RefStationMesure referential object
 #' @param object An object of class \link{RefStationMesure-class}
@@ -58,17 +58,17 @@
 				title=gettext("Monitoring stations selection",domain="R-stacomiR")) {
 			if (nrow(object at data) > 0){
 				hSTM=function(h,...){
-          stationMesure=svalue(choice,index=TRUE)
-          if(length(stationMesure)==0)
-          {
-             funout(gettext("Select at least one value\n",domain="R-stacomiR"),arret=TRUE)
-          }
-          else
-          {
-            object at data<-object at data[stationMesure,]
-            assign("refStationMesure",object,envir_stacomi)
-  					funout(gettext("The monitoring stations have been selected\n",domain="R-stacomiR"))
-          }
+					stationMesure=svalue(choice,index=TRUE)
+					if(length(stationMesure)==0)
+					{
+						funout(gettext("Select at least one value\n",domain="R-stacomiR"),arret=TRUE)
+					}
+					else
+					{
+						object at data<-object at data[stationMesure,]
+						assign("refStationMesure",object,envir_stacomi)
+						funout(gettext("The monitoring stations have been selected\n",domain="R-stacomiR"))
+					}
 				}
 				frame_stationMesure<<-gexpandgroup(title)
 				add(group,frame_stationMesure)
@@ -77,5 +77,32 @@
 				enabled(frame_stationMesure)<-is.enabled
 				gbutton("OK", container=frame_stationMesure,handler=hSTM)
 			} 
-      else funout(gettext("Stop : no data for selected monitoring station (problem with the ODBC link ?)\n",domain="R-stacomiR"),arret=TRUE)
+			else funout(gettext("Stop : no data for selected monitoring station (problem with the ODBC link ?)\n",domain="R-stacomiR"),arret=TRUE)
 		})
+
+
+
+#' Command line interface to select a monitoring  station
+#' 
+#' 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. 
+#' @param object an object of class RefStationMesure
+#' @param stationmesure a character vector of the monitoring station code (corresponds to stm_libelle in the tj_stationmesure_stm table)
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+setMethod("choice_c",signature=signature("RefStationMesure"),definition=function(object,stationmesure) {
+			if (class(stationmesure)!="character") {		
+				stop("the stationmesure should be of class character")
+			} 
+			if(length(stationMesure)==0){
+				stop("Select at least one value\n")
+			}
+			if (any(is.na(stationmesure))){
+				stop("NA values for stationmesure")
+			} 
+			# I can use the stm_libelle as there is a unique constraint in the table
+			libellemanquants<-stationmesure[!stationmesure%in%object at data$stm_libelle]
+			if (length(libellemanquants)>0) warning(gettextf("stationmesure code not present :\n %s",stringr::str_c(libellemanquants,collapse=", "),domain="R-stacomiR"))
+			object at data<-object at data[object at data$stm_libelle%in%stationmesure,]		
+			assign("refStationMesure",object,envir_stacomi)
+			return(object)
+		})
\ No newline at end of file