From 27e001763c81aaac0d9e2674c4086c69931be51f Mon Sep 17 00:00:00 2001
From: Mauricio Zambrano-Bigiarini <hzambran@users.noreply.github.com>
Date: Mon, 15 Oct 2012 15:13:06 +0000
Subject: [PATCH] hydroPSO.R: sub-daily writing of obsrvations

---
 NEWS          |  1 +
 R/PSO_v2012.R | 24 ++++++++++++++++++++----
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 8e8f317..ee1e325 100755
--- a/NEWS
+++ b/NEWS
@@ -42,6 +42,7 @@ NEWS/ChangeLog for hydroPSO
                                  v[t+1] :   v[t]           ->      -v[t]                 (when x[t+1] > x_max | x[t+1] < x_min )
                             -) when the control argument 'out.with.fit.iter' (not used so far) is set to TRUE, the number of iterations returned
                                correspond to the effective number of iterations carried out, not the maximum defined by 'maxit'
+                            -) now it is able to correctly write the observed values for sub-daily models
                               
 
         o Running 'hydroPSO' >= 0.1-59 with default settings will produce DIFFERENT RESULTS from those obtained with 'hydroPSO' <= 0.1-58, due to the 
diff --git a/R/PSO_v2012.R b/R/PSO_v2012.R
index d4c7cb8..b92080c 100755
--- a/R/PSO_v2012.R
+++ b/R/PSO_v2012.R
@@ -1290,7 +1290,7 @@ hydromod.eval <- function(part, Particles, iter, npart, maxit,
 #          15-Jan-2012 ; 23-Jan-2012 ; 30-Jan-2012 ; 23-Feb-2012 ; 23-Mar-2012 #
 #          14-Jun-2012 ; 15-Jun-2012 ; 03-Jul-2012 ; 06-Jul-2012               #
 #          11-Jul-2012 ; 17-Jul-2012 ; 18-Jul-2012 ; 13-Sep-2012; 14-Sep-2012  #
-#          17-Sep-2012 ; 23-Sep-2012                                           #                          
+#          17-Sep-2012 ; 23-Sep-2012 ; 15-Oct-2012                             #                          
 ################################################################################
 # 'lower'           : minimum possible value for each parameter
 # 'upper'           : maximum possible value for each parameter
@@ -1690,6 +1690,7 @@ hydroPSO <- function(
     
     ifelse( ("gof.Ini" %in% names(model.FUN.args)), gof.Ini.exists <- TRUE, gof.Ini.exists <- FALSE )
     ifelse( ("gof.Fin" %in% names(model.FUN.args)), gof.Fin.exists <- TRUE, gof.Fin.exists <- FALSE )
+    ifelse( ("date.fmt" %in% names(model.FUN.args)), date.fmt.exists <- TRUE, date.fmt.exists <- FALSE )
 
     ############################################################################  
     # 1)                              Initialisation                           #
@@ -2900,17 +2901,32 @@ hydroPSO <- function(
 				   ) 
       hydromod.out   <- do.call(model.FUN, as.list(model.FUN.args))   
 
-      if ("obs" %in% names(model.FUN.args)) {
+      if ("obs" %in% names(model.FUN.args)) {      
+         ifelse(date.fmt.exists, date.fmt <- model.FUN.args[["date.fmt"]], date.fmt <- "%Y-%m-%d")         
+         if ( gof.Ini.exists | gof.Fin.exists ) 
+             ifelse( grepl("%H", date.fmt, fixed=TRUE) | grepl("%M", date.fmt, fixed=TRUE) |
+                     grepl("%S", date.fmt, fixed=TRUE) | grepl("%I", date.fmt, fixed=TRUE) |
+                     grepl("%p", date.fmt, fixed=TRUE) | grepl("%X", date.fmt, fixed=TRUE),
+                     subdaily <- TRUE, subdaily <- FALSE )      
         fname <- paste(file.path(drty.out), "/", "Observations.txt", sep="") 	
 	obs <- model.FUN.args[["obs"]] 
         if (is.zoo(obs)) {
-          if (gof.Ini.exists) obs <- window( obs, start=as.Date(model.FUN.args[["gof.Ini"]]) )
-          if (gof.Fin.exists) obs <- window( obs, end=as.Date(model.FUN.args[["gof.Fin"]]) )
+          if (gof.Ini.exists) {
+            ifelse(subdaily, gof.Ini <- as.POSIXct(model.FUN.args[["gof.Ini"]], format=date.fmt),
+                             gof.Ini <- as.Date(model.FUN.args[["gof.Ini"]], format=date.fmt) )
+            obs <- window(obs, start=gof.Ini)
+          } # IF end
+          if (gof.Fin.exists) {
+            ifelse(subdaily, gof.Fin <- as.POSIXct(model.FUN.args[["gof.Fin"]], format=date.fmt),
+                             gof.Fin <- as.Date(model.FUN.args[["gof.Fin"]], format=date.fmt) )
+            obs <- window(obs, end=gof.Fin)
+          } # IF end
           write.zoo(x=obs, file=fname)
         } else {
             obs <- cbind(1:length(obs), obs)
             write.table(obs, file=fname, col.names=FALSE, row.names=FALSE, sep="  ", quote=FALSE)
           } # ELSE end
+          
       } # IF end
 
     } # IF end    
-- 
GitLab