[Blotter-commits] r991 - in pkg/FinancialInstrument: . R

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

Author: gsee
Date: 2012-03-28 15:57:26 +0200 (Wed, 28 Mar 2012)
New Revision: 991

Modified:
   pkg/FinancialInstrument/DESCRIPTION
   pkg/FinancialInstrument/R/format_id.R
Log:
 sort_ids is better at handling instruments with multiple expires values.

Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION	2012-03-26 17:07:54 UTC (rev 990)
+++ pkg/FinancialInstrument/DESCRIPTION	2012-03-28 13:57:26 UTC (rev 991)
@@ -11,7 +11,7 @@
     meta-data and relationships. Provides support for
     multi-asset class and multi-currency portfolios. Still
     in heavy development.
-Version: 0.13.4
+Version: 0.13.5
 URL: https://r-forge.r-project.org/projects/blotter/
 Date: $Date$
 Depends:

Modified: pkg/FinancialInstrument/R/format_id.R
===================================================================
--- pkg/FinancialInstrument/R/format_id.R	2012-03-26 17:07:54 UTC (rev 990)
+++ pkg/FinancialInstrument/R/format_id.R	2012-03-28 13:57:26 UTC (rev 991)
@@ -259,13 +259,19 @@
     f <- function(x, ...) {
         tmpi <- getInstrument(x, silent=TRUE)
         if (is.instrument(tmpi)) {
-            if (is.timeBased(suppressWarnings(try(as.Date(tmpi$expires), silent=TRUE)))) {
-                out <- as.Date(tmpi$expires)
-                if (!is.na(out)) return(out)
-            } 
-            if (is.timeBased(suppressWarnings(try(as.Date(tmpi$expires, format='%Y%m%d'), silent=TRUE)))) {
-                out <- as.Date(tmpi$expires, format = "%Y%m%d")
-                if (!is.na(out)) return(out)
+            if (!is.null(tmpexp <- tmpi[["expires"]])) {
+                if (length(tmpexp) > 1) {
+                    warning(paste(x, "has more than 1 value for expires.",
+                                  "Only the first will be used."))
+                    tmpexp <- tmpexp[[1L]]
+                }
+                dtmpexp <- suppressWarnings(try(as.Date(tmpexp), silent=TRUE))
+                if (inherits(dtmpexp, "try-error") || is.na(dtmpexp) || !is.timeBased(dtmpexp)) {
+                    dtmpexp <- suppressWarnings(try(as.Date(tmpexp, format='%Y%m%d'), silent=TRUE))
+                }
+                if (!inherits(dtmpexp, "try-error") && !is.na(dtmpexp) && is.timeBased(dtmpexp)) {
+                    return(dtmpexp)
+                }
             }
         }
         pid <- parse_id(x, ...)