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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jan 18 07:00:50 CET 2012


Author: gsee
Date: 2012-01-18 06:59:33 +0100 (Wed, 18 Jan 2012)
New Revision: 913

Modified:
   pkg/FinancialInstrument/NAMESPACE
   pkg/FinancialInstrument/R/instrument.R
   pkg/FinancialInstrument/man/ls_by_currency.Rd
   pkg/FinancialInstrument/man/ls_instruments.Rd
   pkg/FinancialInstrument/man/series_instrument.Rd
   pkg/FinancialInstrument/man/synthetic.instrument.Rd
Log:
 - speed up future_series; add overwrite arg
 - speed up getInstrument; replaced for loop. Thanks Brian.
 - Using CRAN roxygen2


Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE	2012-01-15 17:32:33 UTC (rev 912)
+++ pkg/FinancialInstrument/NAMESPACE	2012-01-18 05:59:33 UTC (rev 913)
@@ -1,36 +1,30 @@
-S3method(print,id.list)
-S3method(print,instrument)
-S3method(print,suffix.list)
-export(.to_daily)
-export(C2M)
-export(ICS)
-export(ICS_root)
-export(M2C)
-export(MC2N)
 export(bond)
 export(bond_series)
 export(buildBasket)
 export(buildHierarchy)
 export(buildRatio)
+export(build_series_symbols)
 export(buildSpread)
-export(build_series_symbols)
 export(build_spread_symbols)
 export(butterfly)
+export(C2M)
 export(currency)
 export(exchange_rate)
 export(fn_SpreadBuilder)
+export(format_id)
 export(formatSpreadPrice)
-export(format_id)
 export(fund)
 export(future)
 export(future_series)
 export(getInstrument)
 export(getSymbols.FI)
 export(guaranteed_spread)
+export(ICS)
+export(ICS_root)
 export(instrument)
+export(instrument_attr)
 export(instrument.auto)
 export(instrument.table)
-export(instrument_attr)
 export(is.currency)
 export(is.currency.name)
 export(is.instrument)
@@ -38,44 +32,46 @@
 export(load.instruments)
 export(loadInstruments)
 export(ls_AUD)
-export(ls_CAD)
-export(ls_CHF)
-export(ls_EUR)
-export(ls_FX)
-export(ls_GBP)
-export(ls_HKD)
-export(ls_ICS)
-export(ls_ICS_roots)
-export(ls_JPY)
-export(ls_NZD)
-export(ls_SEK)
-export(ls_USD)
 export(ls_bonds)
 export(ls_by_currency)
 export(ls_by_expiry)
+export(ls_CAD)
 export(ls_calls)
+export(ls_CHF)
 export(ls_currencies)
 export(ls_derivatives)
+export(ls_EUR)
 export(ls_exchange_rates)
 export(ls_expires)
 export(ls_expiries)
 export(ls_funds)
+export(ls_futures)
 export(ls_future_series)
-export(ls_futures)
+export(ls_FX)
+export(ls_GBP)
 export(ls_guaranteed_spreads)
+export(ls_HKD)
+export(ls_ICS)
+export(ls_ICS_roots)
 export(ls_instruments)
 export(ls_instruments_by)
+export(ls_JPY)
 export(ls_non_currencies)
 export(ls_non_derivatives)
+export(ls_NZD)
+export(ls_options)
 export(ls_option_series)
-export(ls_options)
 export(ls_puts)
+export(ls_SEK)
 export(ls_spreads)
 export(ls_stocks)
 export(ls_strikes)
 export(ls_synthetics)
 export(ls_underlyings)
+export(ls_USD)
+export(M2C)
 export(make_spread_id)
+export(MC2N)
 export(month_cycle2numeric)
 export(next.future_id)
 export(option)
@@ -92,12 +88,12 @@
 export(rm_derivatives)
 export(rm_exchange_rates)
 export(rm_funds)
+export(rm_futures)
 export(rm_future_series)
-export(rm_futures)
 export(rm_instruments)
 export(rm_non_derivatives)
+export(rm_options)
 export(rm_option_series)
-export(rm_options)
 export(rm_spreads)
 export(rm_stocks)
 export(rm_synthetics)
@@ -111,8 +107,12 @@
 export(synthetic)
 export(synthetic.instrument)
 export(synthetic.ratio)
+export(.to_daily)
 export(to_secBATV)
 export(update_instruments.TTR)
 export(update_instruments.yahoo)
 export(volep)
 importFrom(zoo,as.Date)
+S3method(print,id.list)
+S3method(print,instrument)
+S3method(print,suffix.list)

Modified: pkg/FinancialInstrument/R/instrument.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.R	2012-01-15 17:32:33 UTC (rev 912)
+++ pkg/FinancialInstrument/R/instrument.R	2012-01-18 05:59:33 UTC (rev 913)
@@ -249,6 +249,7 @@
 #' @param payment_schedule not currently being implemented
 #' @param identifiers named list of any other identifiers that should also be stored for this instrument
 #' @param assign_i TRUE/FALSE. Should the instrument be assigned in the \code{.instrument} environment?
+#' @param overwrite TRUE/FALSE. If FALSE, only \code{first_traded} and \code{expires} will be updated.
 #' @param ... any other passthru parameters
 #' @aliases 
 #' option_series
@@ -273,7 +274,9 @@
 #' }
 #' @export
 #' @rdname series_instrument
-future_series <- function(primary_id, root_id=NULL, suffix_id=NULL, first_traded=NULL, expires=NULL, identifiers = NULL, assign_i=TRUE, ...){
+future_series <- function(primary_id, root_id=NULL, suffix_id=NULL, 
+                          first_traded=NULL, expires=NULL, identifiers = NULL, 
+                          assign_i=TRUE, overwrite=TRUE, ...){
   if (missing(primary_id)) {
       if (all(is.null(c(root_id,suffix_id)))) {
           stop('must provide either a primary_id or both a root_id and a suffix_id')
@@ -319,50 +322,52 @@
   ## with futures series we probably need to be more sophisticated,
   ## and find the existing series from prior periods (probably years or months)
   ## and then add the first_traded and expires to the time series bu splicing
-  temp_series<-try(getInstrument(primary_id, silent=TRUE),silent=TRUE)
-  if(inherits(temp_series,"future_series")) {
-      message("updating existing first_traded and expires for ",primary_id)
-      temp_series$first_traded<-unique(c(temp_series$first_traded,first_traded))
-      temp_series$expires<-unique(c(temp_series$expires,expires))
-      assign(primary_id, temp_series, envir=as.environment(FinancialInstrument:::.instrument))
-      primary_id
-  } else {
-      args <- list()
-      args$primary_id <- primary_id
-      args$root_id <- root_id
-      args$suffix_id=suffix_id
-      args$currency = contract$currency
-      args$multiplier = contract$multiplier
-      args$tick_size=contract$tick_size
-      args$identifiers = identifiers
-      args$first_traded = first_traded
-      args$type=c("future_series", "future")
-      args$expires = expires
-      if (!is.null(contract$exchange)) {
-          args$exchange <- contract$exchange
-      }
-      args$underlying_id = contract$underlying_id
-      if (!is.null(contract$marketName)) {
-          args$marketName <- contract$marketName
-      }
-      if (!is.null(contract$exchange_id)) {
-          args$exchange_id <- contract$exchange_id
-      }
-      if (!is.null(contract$description)) {
-          args$series_description <- paste(contract$description, expires)
-      }
-      args$assign_i=assign_i
-      dargs<-list(...)
-      dargs$currency=NULL
-      dargs$multiplier=NULL
-      dargs$type=NULL
-      if (is.null(dargs$src) && !is.null(contract$src)){
-          dargs$src <- contract$src
-      }
-      args <- c(args, dargs)
+  #temp_series<-try(getInstrument(primary_id, silent=TRUE),silent=TRUE)
+  if (!overwrite) {
+      temp_series<-try(getInstrument(primary_id, silent=TRUE),silent=TRUE)
+      if(inherits(temp_series,"future_series")) {
+          message("updating existing first_traded and expires for ",primary_id)
+          temp_series$first_traded<-unique(c(temp_series$first_traded,first_traded))
+          temp_series$expires<-unique(c(temp_series$expires,expires))
+          assign(primary_id, temp_series, envir=as.environment(FinancialInstrument:::.instrument))
+          return(primary_id)
+      } else warning("No contract found to update. A new one will be created.")
+  }
+  args <- list()
+  args$primary_id <- primary_id
+  args$root_id <- root_id
+  args$suffix_id=suffix_id
+  args$currency = contract$currency
+  args$multiplier = contract$multiplier
+  args$tick_size=contract$tick_size
+  args$identifiers = identifiers
+  args$first_traded = first_traded
+  args$type=c("future_series", "future")
+  args$expires = expires
+  if (!is.null(contract$exchange)) {
+      args$exchange <- contract$exchange
+  }
+  args$underlying_id = contract$underlying_id
+  if (!is.null(contract$marketName)) {
+      args$marketName <- contract$marketName
+  }
+  if (!is.null(contract$exchange_id)) {
+      args$exchange_id <- contract$exchange_id
+  }
+  if (!is.null(contract$description)) {
+      args$series_description <- paste(contract$description, expires)
+  }
+  args$assign_i=assign_i
+  dargs<-list(...)
+  dargs$currency=NULL
+  dargs$multiplier=NULL
+  dargs$type=NULL
+  if (is.null(dargs$src) && !is.null(contract$src)){
+      dargs$src <- contract$src
+  }
+  args <- c(args, dargs)
 
-      do.call(instrument, args)
-  }
+  do.call(instrument, args)
 }
 
 #' @export
@@ -932,17 +937,29 @@
 getInstrument <- function(x, Dates=NULL, silent=FALSE, type='instrument'){
     tmp_instr <- try(get(x,pos=FinancialInstrument:::.instrument),silent=TRUE) #removed inherits=TRUE
     if(inherits(tmp_instr,"try-error") || !inherits(tmp_instr, type)){
-        #first search
-        instr_list <- ls(pos=FinancialInstrument:::.instrument, all.names=TRUE)
-        for (instr in instr_list){
-            tmp_instr <- try(get(instr, pos=FinancialInstrument:::.instrument), silent=TRUE)
-            if(inherits(tmp_instr, type) && (x %in% tmp_instr$identifiers || x %in% make.names(tmp_instr$identifiers))) {
-                return(tmp_instr)
+        xx <- make.names(x)
+        ## First, look to see if x matches any identifiers.
+        # unlist all instruments into a big named vector
+        ul.instr <- unlist(as.list(FinancialInstrument:::.instrument, all.names=TRUE))
+        # subset by names that include "identifiers"
+        ul.ident <- ul.instr[grep('identifiers', names(ul.instr))]
+        # if x is in the identifiers subset, extract the primary_id from the name
+        tmpname <- ul.ident[match(xx, ul.ident, 0)]
+        # if x was not in ul.ident, tmpname will == named character(0)
+        if (length(tmpname) > 0) {
+            #primary_id is everything before .identifiers
+            id <- gsub("\\.identifiers.*", "", names(tmpname))
+            tmp_instr <- try(get(id, pos=FinancialInstrument:::.instrument), silent=TRUE)
+            if (inherits(tmp_instr, type)) {
+                #&& (x %in% tmp_instr$identifiers || x %in% make.names(tmp_instr$identifiers))
+                return(tmp_instr) 
             }
         }
         #If not found, see if it begins with dots (future or option root)
-        #strip out the dots and add them back 1 at a time to the beginning of id
-        x <- gsub("\\.", "", x) 
+        #Remove any dots at beginning of string and add them back 1 at a time 
+        # to the beginning of id.
+        char.x <- strsplit(x, "")[[1]] # split x into vector of characters
+        x <- substr(x, grep("[^\\.]", char.x)[1], length(char.x)) # excluding leading dots
         tmp_instr<-try(get(x,pos=FinancialInstrument:::.instrument),silent=TRUE)
         if(!inherits(tmp_instr,type)) {
             tmp_instr<-try(get(paste(".",x,sep=""),pos=FinancialInstrument:::.instrument),silent=TRUE)
@@ -950,7 +967,7 @@
                 tmp_instr<-try(get(paste("..",x,sep=""),pos=FinancialInstrument:::.instrument),silent=TRUE)
             }
         }
-        if (!inherits(tmp_instr,'try-error') && inherits(tmp_instr, type)) return(tmp_instr)
+        if (inherits(tmp_instr, type)) return(tmp_instr)
         if(!silent) warning(paste(type,x,"not found, please create it first."))
         return(FALSE)
     } else{

Modified: pkg/FinancialInstrument/man/ls_by_currency.Rd
===================================================================
--- pkg/FinancialInstrument/man/ls_by_currency.Rd	2012-01-15 17:32:33 UTC (rev 912)
+++ pkg/FinancialInstrument/man/ls_by_currency.Rd	2012-01-18 05:59:33 UTC (rev 913)
@@ -1,5 +1,6 @@
 \name{ls_by_currency}
 \alias{ls_AUD}
+\alias{ls_by_currency}
 \alias{ls_CAD}
 \alias{ls_CHF}
 \alias{ls_EUR}
@@ -9,7 +10,6 @@
 \alias{ls_NZD}
 \alias{ls_SEK}
 \alias{ls_USD}
-\alias{ls_by_currency}
 \alias{rm_by_currency}
 \title{shows or removes instruments of given currency denomination(s)}
 \usage{

Modified: pkg/FinancialInstrument/man/ls_instruments.Rd
===================================================================
--- pkg/FinancialInstrument/man/ls_instruments.Rd	2012-01-15 17:32:33 UTC (rev 912)
+++ pkg/FinancialInstrument/man/ls_instruments.Rd	2012-01-18 05:59:33 UTC (rev 913)
@@ -1,37 +1,37 @@
 \name{ls_instruments}
-\alias{ls_FX}
-\alias{ls_ICS}
-\alias{ls_ICS_roots}
 \alias{ls_bonds}
 \alias{ls_calls}
 \alias{ls_currencies}
 \alias{ls_derivatives}
 \alias{ls_exchange_rates}
 \alias{ls_funds}
+\alias{ls_futures}
 \alias{ls_future_series}
-\alias{ls_futures}
+\alias{ls_FX}
 \alias{ls_guaranteed_spreads}
+\alias{ls_ICS}
+\alias{ls_ICS_roots}
 \alias{ls_instruments}
 \alias{ls_non_currencies}
 \alias{ls_non_derivatives}
+\alias{ls_options}
 \alias{ls_option_series}
-\alias{ls_options}
 \alias{ls_puts}
 \alias{ls_spreads}
 \alias{ls_stocks}
 \alias{ls_synthetics}
-\alias{rm_FX}
 \alias{rm_bonds}
 \alias{rm_currencies}
 \alias{rm_derivatives}
 \alias{rm_exchange_rates}
 \alias{rm_funds}
+\alias{rm_futures}
 \alias{rm_future_series}
-\alias{rm_futures}
+\alias{rm_FX}
 \alias{rm_instruments}
 \alias{rm_non_derivatives}
+\alias{rm_options}
 \alias{rm_option_series}
-\alias{rm_options}
 \alias{rm_spreads}
 \alias{rm_stocks}
 \alias{rm_synthetics}

Modified: pkg/FinancialInstrument/man/series_instrument.Rd
===================================================================
--- pkg/FinancialInstrument/man/series_instrument.Rd	2012-01-15 17:32:33 UTC (rev 912)
+++ pkg/FinancialInstrument/man/series_instrument.Rd	2012-01-18 05:59:33 UTC (rev 913)
@@ -6,7 +6,8 @@
 \usage{
   future_series(primary_id, root_id = NULL,
     suffix_id = NULL, first_traded = NULL, expires = NULL,
-    identifiers = NULL, assign_i = TRUE, ...)
+    identifiers = NULL, assign_i = TRUE, overwrite = TRUE,
+    ...)
 
   option_series(primary_id, root_id = NULL,
     suffix_id = NULL, first_traded = NULL, expires = NULL,
@@ -53,6 +54,9 @@
   \item{assign_i}{TRUE/FALSE. Should the instrument be
   assigned in the \code{.instrument} environment?}
 
+  \item{overwrite}{TRUE/FALSE. If FALSE, only
+  \code{first_traded} and \code{expires} will be updated.}
+
   \item{...}{any other passthru parameters}
 }
 \description{

Modified: pkg/FinancialInstrument/man/synthetic.instrument.Rd
===================================================================
--- pkg/FinancialInstrument/man/synthetic.instrument.Rd	2012-01-15 17:32:33 UTC (rev 912)
+++ pkg/FinancialInstrument/man/synthetic.instrument.Rd	2012-01-18 05:59:33 UTC (rev 913)
@@ -1,8 +1,8 @@
 \name{synthetic}
+\alias{butterfly}
+\alias{guaranteed_spread}
 \alias{ICS}
 \alias{ICS_root}
-\alias{butterfly}
-\alias{guaranteed_spread}
 \alias{spread}
 \alias{synthetic}
 \alias{synthetic.instrument}



More information about the Blotter-commits mailing list