[Blotter-commits] r764 - pkg/FinancialInstrument/R

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

Author: gsee
Date: 2011-09-09 20:23:07 +0200 (Fri, 09 Sep 2011)
New Revision: 764

Modified:
   pkg/FinancialInstrument/R/instrument.R
Log:
 - if a future/option has src arg, use it in future_series/option_series (unless overridden)
 - auto-create primary_id from underlying_id (if missing(primary_id))
 - add dot(s) to beginning of future/option primary_id if it is the same as underlying_id


Modified: pkg/FinancialInstrument/R/instrument.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.R	2011-09-09 14:16:46 UTC (rev 763)
+++ pkg/FinancialInstrument/R/instrument.R	2011-09-09 18:23:07 UTC (rev 764)
@@ -171,6 +171,7 @@
 #' @export
 #' @rdname instrument
 future <- function(primary_id , currency , multiplier , tick_size=NULL, identifiers = NULL, ..., underlying_id=NULL){
+    if(missing(primary_id)) primary_id <- paste("..",underlying_id,sep="")
     if (length(primary_id) > 1) stop('primary_id must be of length 1')
     if (missing(currency) && !is.null(underlying_id)) {
         uinstr <- getInstrument(underlying_id,silent=TRUE)
@@ -182,6 +183,11 @@
         warning("underlying_id should only be NULL for cash-settled futures")
     } else {
         if(!exists(underlying_id, where=.instrument,inherits=TRUE)) warning("underlying_id not found") # assumes that we know where to look
+        if (primary_id == underlying_id) {
+            primary_id <- paste("..",primary_id,sep="")
+            warning(paste('primary_id is the same as underlying_id,',
+                'the instrument will be given a primary_id of', primary_id))
+        }  
     }
 
     instrument(primary_id=primary_id , currency=currency , multiplier=multiplier , tick_size=tick_size, identifiers = identifiers, ... , type="future", underlying_id=underlying_id, assign_i=TRUE )
@@ -288,6 +294,9 @@
       dargs$currency=NULL
       dargs$multiplier=NULL
       dargs$type=NULL
+      if (is.null(dargs$src) && !is.null(contract$src)){
+          dargs$src <- contract$src
+      }
       instrument( primary_id = primary_id,
                  root_id = root_id,
                  suffix_id=suffix_id,
@@ -308,6 +317,7 @@
 #' @export
 #' @rdname instrument
 option <- function(primary_id , currency , multiplier , tick_size=NULL, identifiers = NULL, ..., underlying_id=NULL){
+  if (missing(primary_id)) primary_id <- paste(".",underlying_id,sep="")
   if (length(primary_id) > 1) stop("'primary_id' must be of length 1")
   if (missing(currency) && !is.null(underlying_id)) {
         uinstr <- getInstrument(underlying_id,silent=TRUE)
@@ -319,6 +329,11 @@
       warning("underlying_id should only be NULL for cash-settled options")
   } else {
       if(!exists(underlying_id, where=.instrument,inherits=TRUE)) warning("underlying_id not found") # assumes that we know where to look
+      if (primary_id == underlying_id) {
+          primary_id <- paste(".",primary_id,sep="")
+          warning(paste('primary_id is the same as underlying_id,',
+                'the instrument will be given a primary_id of', primary_id))
+      }  
   }
   ## now structure and return
   instrument(primary_id=primary_id , currency=currency , multiplier=multiplier , tick_size=tick_size, identifiers = identifiers, ... , type="option", underlying_id=underlying_id, assign_i=TRUE )
@@ -364,7 +379,9 @@
             stop("must provide 'expires' formatted '%Y-%m-%d', or a 'suffix_id' from which to infer 'expires'")
     }
     contract<-getInstrument(root_id, type='option')
-    
+    if (!hasArg(src) && !is.null(contract$src)){
+        src <- contract$src
+    }
     ## with options series we probably need to be more sophisticated,
     ## and find the existing series from prior periods (probably years)
     ## and then add the first_traded and expires to the time series
@@ -390,6 +407,7 @@
                     callput = callput,
                     strike = strike,
                     underlying_id = contract$underlying_id,
+                    if (!is.null(src)) src=src,
                     ...,
                     type=c("option_series", "option"),
                     assign_i=TRUE