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

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

Author: briand
Date: 2017-07-17 09:00:26 +0200 (Mon, 17 Jul 2017)
New Revision: 443

Modified:
   pkg/stacomir/R/report_mig_char.R
Log:
Bug fix (5), Error in setasqualitative method, changed one column name. 
Modification in setasqualitative method which did not work (one name was misspeled)
Modification in connect method, avec or with indicates now that subsamples are included.
Modification for the selection of parameters, in the previous version the selection did not work.
Modification of Ylab in plot
Treatment of NA in plot plot.type="quant", missing values coming from qualitative parms are treated as 'NA' otherwise plot chrashes


Modified: pkg/stacomir/R/report_mig_char.R
===================================================================
--- pkg/stacomir/R/report_mig_char.R	2017-07-13 12:23:36 UTC (rev 442)
+++ pkg/stacomir/R/report_mig_char.R	2017-07-17 07:00:26 UTC (rev 443)
@@ -43,7 +43,8 @@
 		parquan="ref_parquan"),
 	prototype=list(
 		data=list(),
-		echantillon=new("ref_choice","listechoice"=c(gettext(c("with","without"),domain="stacomiR")),
+		echantillon=new("ref_choice",
+            "listechoice"=gettext(c("with","without"),domain="stacomiR"),
 			selectedvalue=gettext("with",domain="stacomiR")),
 		calcdata<-list(),
 		parqual=new("ref_parqual"),
@@ -72,7 +73,8 @@
 #' @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 report, for this class this will be used to calculate the number of daily steps.
-#' @param echantillon Default TRUE, 
+#' @param echantillon Default "with" can be "without" (values "avec" and "sans") are accepted, checking without modifies the query
+#' in the connect method so that subsamples are not allowed, 
 #' @param silent Default FALSE, if TRUE the program should no display messages
 #' @return An object of class \link{report_sea_age-class}
 #' The choice_c method fills in the data slot for classes \link{ref_dc-class}, \link{ref_taxa-class}, \link{ref_stage-class}, \link{ref_par-class} and two slots of \link{ref_horodate-class} and then 
@@ -201,11 +203,12 @@
 #' @param object An object of class \link{report_mig_char-class}
 #' @param silent Boolean default FALSE, if TRUE information messages not displayed
 #' @return report_mig_char with slot @data filled from the database
+#' @note 
 #' @aliases connect.report_mig_char
 #' @export
 setMethod("connect",signature=signature("report_mig_char"),definition=function(object,silent=FALSE){
 	  r_mig_char<-object
-	  if (r_mig_char at echantillon@selectedvalue==r_mig_char at echantillon@listechoice[1]) {
+	  if (r_mig_char at echantillon@selectedvalue==r_mig_char at echantillon@listechoice[2]) {
 		echantillons=" AND lot_pere IS NULL"      
 	  } else {
 		echantillons=""      
@@ -237,7 +240,7 @@
 			  echantillons,
 			  " AND lot_tax_code in ",vector_to_listsql(r_mig_char at taxa@data$tax_code),
 			  " AND lot_std_code in ",vector_to_listsql(r_mig_char at stage@data$std_code),
-			  " AND car_par_code in ",vector_to_listsql(r_mig_char at parqual@data$par_code),
+			  " AND car_par_code in ",vector_to_listsql(parqual),
 			  " AND (ope_date_debut, ope_date_fin) OVERLAPS (TIMESTAMP '" ,
 			  r_mig_char at horodatedebut@horodate ,
 			  "', TIMESTAMP '" , r_mig_char at horodatefin@horodate  , "')" 
@@ -265,7 +268,7 @@
 			  echantillons,
 			  " AND lot_tax_code in ",vector_to_listsql(r_mig_char at taxa@data$tax_code),
 			  " AND lot_std_code in ",vector_to_listsql(r_mig_char at stage@data$std_code),
-			  " AND car_par_code in ",vector_to_listsql(r_mig_char at parquan@data$par_code),
+			  " AND car_par_code in ",vector_to_listsql(parquan),
 			  " AND (ope_date_debut, ope_date_fin) OVERLAPS (TIMESTAMP '" ,
 			  r_mig_char at horodatedebut@horodate ,
 			  "', TIMESTAMP '" , r_mig_char at horodatefin@horodate  , "')" 
@@ -323,7 +326,7 @@
 	  # resetting the right values for valqual
 	  r_mig_char at parqual@valqual<-rbind(r_mig_char at parqual@valqual,
 		  data.frame(val_identifiant=levels(tab$car_val_identifiant),
-			  val_qual_code=par,
+			  val_qal_code=par,
 			  val_rang=1:length(levels(tab$car_val_identifiant)),
 			  val_libelle=NA))
 	  
@@ -460,6 +463,7 @@
 	  } #end plot.type = "qual"
 	  if (plot.type=="quant") { 
 		calcdata<-r_mig_char at calcdata
+        calcdata$car_par_code_quan[is.na(calcdata$car_par_code_quan)]<-"NA"
 		the_parms<-unique(calcdata$car_par_code_quan)
 		cs<-colortable(color=color_parm,vec=the_parms,palette="Dark2")
 		cs<-stacomirtools::chnames(cs,"name","car_par_code_quan")
@@ -467,7 +471,7 @@
 		g<-ggplot(calcdata)+
 			geom_point(aes(x=ope_date_debut,y=car_valeur_quantitatif,col=color),stat='identity')+
 			xlab(gettext("Month"))+
-			ylab(gettext("Number"))+
+			ylab(gettext("Quantitative parameter"))+
 			scale_colour_identity(name=gettext("Param"),
 				labels=cs[,"car_par_code_quan"],
 				breaks=cs[,"color"],