[Blotter-commits] r822 - in pkg/FinancialInstrument: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 21 01:18:57 CEST 2011
Author: gsee
Date: 2011-10-21 01:18:56 +0200 (Fri, 21 Oct 2011)
New Revision: 822
Added:
pkg/FinancialInstrument/R/ls_by_currency.R
pkg/FinancialInstrument/R/ls_by_expiry.R
pkg/FinancialInstrument/R/ls_expiries.R
pkg/FinancialInstrument/R/ls_instruments.R
pkg/FinancialInstrument/R/ls_instruments_by.R
pkg/FinancialInstrument/R/ls_strikes.R
pkg/FinancialInstrument/R/ls_underlyings.R
pkg/FinancialInstrument/R/saveInstruments.R
pkg/FinancialInstrument/R/update_instruments.yahoo.R
pkg/FinancialInstrument/man/ls_by_currency.Rd
pkg/FinancialInstrument/man/ls_by_expiry.Rd
pkg/FinancialInstrument/man/ls_expiries.Rd
pkg/FinancialInstrument/man/ls_instruments.Rd
pkg/FinancialInstrument/man/ls_instruments_by.Rd
pkg/FinancialInstrument/man/ls_strikes.Rd
pkg/FinancialInstrument/man/ls_underlyings.Rd
pkg/FinancialInstrument/man/saveInstruments.Rd
pkg/FinancialInstrument/man/update_instruments.yahoo.Rd
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/NAMESPACE
Log:
Moved the following functions from twsInstrument to FinancialInstrument:
saveInstruments, loadInstruments, update_instruments.yahoo,
update_instruments.TTR, ls_instruments, ls_stocks, ls_options,
ls_option_series, ls_futures, ls_future_series, ls_currencies,
ls_non_currencies, ls_exchange_rates, ls_FX, ls_bonds, ls_funds,
ls_spreads, ls_guaranteed_spreads, ls_synthetics, ls_derivatives,
ls_non_derivatives, ls_calls, ls_puts, ls_by_expiry, ls_by_currency,
ls_AUD, ls_GBP, ls_CAD, ls_EUR, ls_JPY, ls_CHF, ls_HKD, ls_SEK, ls_NZD,
ls_instruments_by, ls_underlyings, ls_expires, ls_expiries, ls_strikes
rm_instruments, rm_stocks, rm_options, rm_option_series, rm_futures,
rm_future_series, rm_currencies, rm_exchange_rates, rm_FX, rm_bonds,
rm_funds, rm_spreads, rm_synthetics, rm_derivatives, rm_non_derivatives
rm_by_expiry, rm_by_currency
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2011-10-18 02:25:08 UTC (rev 821)
+++ pkg/FinancialInstrument/DESCRIPTION 2011-10-20 23:18:56 UTC (rev 822)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.7.5
+Version: 0.8
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
@@ -33,3 +33,12 @@
'parse_id.R'
'MonthCodes.R'
'format_id.R'
+ 'ls_by_expiry.R'
+ 'ls_instruments_by.R'
+ 'ls_instruments.R'
+ 'ls_strikes.R'
+ 'ls_underlyings.R'
+ 'update_instruments.yahoo.R'
+ 'ls_by_currency.R'
+ 'saveInstruments.R'
+ 'ls_expiries.R'
Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE 2011-10-18 02:25:08 UTC (rev 821)
+++ pkg/FinancialInstrument/NAMESPACE 2011-10-20 23:18:56 UTC (rev 822)
@@ -26,6 +26,42 @@
export(is.currency)
export(is.instrument)
export(load.instruments)
+export(loadInstruments)
+export(ls_AUD)
+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_GBP)
+export(ls_guaranteed_spreads)
+export(ls_HKD)
+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_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)
@@ -38,6 +74,23 @@
export(parse_suffix)
export(prev.future_id)
export(redenominate)
+export(rm_bonds)
+export(rm_by_currency)
+export(rm_by_expiry)
+export(rm_currencies)
+export(rm_derivatives)
+export(rm_exchange_rates)
+export(rm_funds)
+export(rm_futures)
+export(rm_future_series)
+export(rm_instruments)
+export(rm_non_derivatives)
+export(rm_options)
+export(rm_option_series)
+export(rm_spreads)
+export(rm_stocks)
+export(rm_synthetics)
+export(saveInstruments)
export(setSymbolLookup.FI)
export(sort_ids)
export(spread)
@@ -46,6 +99,8 @@
export(synthetic.instrument)
export(synthetic.ratio)
export(.to_daily)
+export(update_instruments.TTR)
+export(update_instruments.yahoo)
export(volep)
importFrom(zoo,as.Date)
S3method(print,id.list)
Added: pkg/FinancialInstrument/R/ls_by_currency.R
===================================================================
--- pkg/FinancialInstrument/R/ls_by_currency.R (rev 0)
+++ pkg/FinancialInstrument/R/ls_by_currency.R 2011-10-20 23:18:56 UTC (rev 822)
@@ -0,0 +1,143 @@
+#' shows or removes instruments of given currency denomination(s)
+#'
+#' ls_ functions get names of instruments denominated in a given currency (or
+#' currencies) rm_ functions remove instruments of a given currency
+#'
+#'
+#' @aliases ls_by_currency rm_by_currency ls_USD ls_AUD ls_GBP ls_CAD ls_EUR
+#' ls_JPY ls_CHF ls_HKD ls_SEK ls_NZD
+#' @param currency chr vector of names of currency
+#' @param pattern an optional regular expression. Only names matching
+#' \sQuote{pattern} are returned.
+#' @param match exact match?
+#' @param show.currencies include names of currency instruments in the returned
+#' names?
+#' @param keep.currencies Do not delete currency instruments when deleting
+#' multiple instruments.
+#' @param x what to remove. chr vector.
+#' @return ls_ functions return vector of instrument names rm_ functions return
+#' invisible / called for side-effect.
+#' @author Garrett See
+#' @seealso ls_instruments, ls_currencies, rm_instruments, rm_currencies,
+#' twsInstrument, instrument
+#' @examples
+#'
+#' \dontrun{
+#' #First create instruments
+#' currency(c('USD','CAD','GBP')
+#' stock(c('CM','CNQ'),'CAD')
+#' stock(c('BET','BARC'),'GBP')
+#' stock(c('SPY','DIA'),'USD')
+#'
+#' #now the examples
+#' ls_by_currency(c('CAD','GBP'))
+#'
+#' ls_USD()
+#' ls_CAD()
+#'
+#' #2 ways to remove all instruments of a currency
+#' rm_instruments(ls_USD())
+#' #rm_instruments(ls_GBP(),keep.currencies=FALSE)
+#' rm_by_currency( ,'CAD')
+#' #rm_by_currency( ,'CAD', keep.currencies=FALSE)
+#' }
+#' @export
+#' @rdname ls_by_currency
+ls_by_currency <- function(currency, pattern=NULL, match=TRUE,show.currencies=FALSE) {
+ if (length(pattern) > 1 && !match) {
+ warning("Using match because length of pattern > 1.")
+ #should I use match?
+ #or, ignore pattern and return everything?
+ #or, do multiple ls calls and return unique
+ match <- TRUE
+ }
+
+ if (!(currency %in% ls_currencies()) ) {
+ warning(paste(currency, 'is not a defined currency', sep=" "))
+ }
+
+ if (!is.null(pattern) && match) { #there's a pattern and match is TRUE
+ symbols <- ls(.instrument, all.names=TRUE)
+ symbols <- symbols[match(pattern,symbols)]
+ } else if (!match && length(pattern) == 1) { # pattern is length(1) and match is FALSE
+ symbols <- ls(.instrument, all.names=TRUE, pattern=pattern)
+ } else if (is.null(pattern)) { #no pattern
+ symbols <- ls(.instrument, all.names=TRUE)
+ } # else pattern length > 1 & don't match
+
+ tmp_symbols <- NULL
+ for (symbol in symbols) {
+ tmp_instr <- try(get(symbol, pos = .instrument),silent=TRUE)
+ if (is.instrument(tmp_instr) &&
+ tmp_instr$currency == currency ){
+ tmp_symbols <- c(tmp_symbols,symbol)
+ }
+ }
+ if (show.currencies) {
+ tmp_symbols
+ } else if (!is.null(tmp_symbols)) {
+ ls_non_currencies(tmp_symbols)
+ } else NULL
+}
+
+#' @export
+#' @rdname ls_by_currency
+rm_by_currency <- function(x,currency,keep.currencies=TRUE) {
+ sc <- !keep.currencies #make show.currencies==opposite of keep
+ if (missing(x)) {
+ x <- ls_by_currency(currency,show.currencies=sc)
+ } else x <- ls_by_currency(currency,pattern=x,show.currencies=sc)
+ rm(list=x,pos=.instrument)
+}
+
+#AUD GBP CAD EUR JPY CHF HKD SEK NZD
+#' @export
+#' @rdname ls_by_currency
+ls_USD <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('USD',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_AUD <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('AUD',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_GBP <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('GBP',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_CAD <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('CAD',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_EUR <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('EUR',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_JPY <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('JPY',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_CHF <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('CHF',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_HKD <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('HKD',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_SEK <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('SEK',pattern,match,show.currencies)
+}
+#' @export
+#' @rdname ls_by_currency
+ls_NZD <- function(pattern=NULL,match=TRUE,show.currencies=FALSE) {
+ ls_by_currency('NZD',pattern,match,show.currencies)
+}
Property changes on: pkg/FinancialInstrument/R/ls_by_currency.R
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/FinancialInstrument/R/ls_by_expiry.R
===================================================================
--- pkg/FinancialInstrument/R/ls_by_expiry.R (rev 0)
+++ pkg/FinancialInstrument/R/ls_by_expiry.R 2011-10-20 23:18:56 UTC (rev 822)
@@ -0,0 +1,74 @@
+#TODO: allow for more date formats.
+
+
+
+#' list or remove instruments by expiration date
+#'
+#' show names of or remove instruments that expire on a given date
+#'
+#'
+#' @aliases ls_by_expiry rm_by_expiry
+#' @param expiry expiration date that should correspond to the sQuoteexpires
+#' slot of an instrument
+#' @param pattern an optional regular expression. Only names matching
+#' sQuotepattern are returned.
+#' @param match exact match of pattern?
+#' @param x what to remove
+#' @return \code{ls_by_expiry} gives a vector of names of instruments that
+#' expire on the given expiry. \code{rm_by_expiry} is called for its
+#' side-effect.
+#' @author Garrett See
+#' @seealso ls_instruments, ls_options, ls_calls, ls_puts, ls_futures,
+#' ls_derivatives
+#' @examples
+#'
+#' \dontrun{
+#' ls_by_expiry('20110917')
+#' ls_by_expiry('20110917',ls_options())
+#' }
+#' @export
+#' @rdname ls_by_expiry
+ls_by_expiry <- function(expiry, pattern=NULL, match=TRUE) {
+ if (length(pattern) > 1 && !match) {
+ warning("Using match because length of pattern > 1.")
+ #should I use match even though it's TRUE?
+ #or, ignore pattern and return everything?
+ #or, do multiple ls calls and return unique
+ match <- TRUE
+ }
+
+ if (!is.null(pattern) && match) { #there's a pattern and match is TRUE
+ symbols <- ls(.instrument, all.names=TRUE)
+ symbols <- symbols[match(pattern,symbols)]
+ } else if (!match && length(pattern) == 1) { # pattern is length(1) and match is FALSE
+ symbols <- ls(.instrument, all.names=TRUE, pattern=pattern)
+ } else if (is.null(pattern)) { #no pattern
+ symbols <- ls(.instrument, all.names=TRUE)
+ } # else pattern length > 1 & don't match
+
+ tmp_symbols <- NULL
+ for (symbol in symbols) {
+ tmp_instr <- try(get(symbol, pos = .instrument),silent=TRUE)
+ if (is.instrument(tmp_instr) && !is.null(tmp_instr$expires) ) {
+ if (any(tmp_instr$expires == expiry) ){
+ tmp_symbols <- c(tmp_symbols,symbol)
+ }
+ }
+ }
+
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_by_expiry
+rm_by_expiry <- function(x,expiry) {
+ if (missing(x)) {
+ x <- ls_by_expiry(expiry)
+ } else x <- ls_by_expiry(expiry,pattern=x)
+ rm(list=x,pos=.instrument)
+}
+#rm_by_expiry(ls_options(),'20130119')
+
+
+#TODO: ls_by_underlying
+ #if (it's %in% ls_derivatives())
Property changes on: pkg/FinancialInstrument/R/ls_by_expiry.R
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/FinancialInstrument/R/ls_expiries.R
===================================================================
--- pkg/FinancialInstrument/R/ls_expiries.R (rev 0)
+++ pkg/FinancialInstrument/R/ls_expiries.R 2011-10-20 23:18:56 UTC (rev 822)
@@ -0,0 +1,83 @@
+#' show unique expiration dates of instruments
+#'
+#' show unique expiration dates of instruments
+#'
+#' \code{ls_expires} is an alias. (plural of expires?)
+#'
+#' type is currently only implemented for \sQuote{derivative}, \sQuote{future},
+#' \sQuote{option}, \sQuote{call} and \sQuote{put} internally, a call is made
+#' to the appropriate ls_ function.
+#'
+#' @aliases ls_expiries ls_expires
+#' @param pattern optional regular expression.
+#' @param match exact match?
+#' @param underlying_id chr name of underlying or vector of underlying_ids. If
+#' NULL, all underlyings will be used
+#' @param type chr string name of class that instruments to be returned must
+#' inherit.
+#' @return named chr vector with length of unique expiration dates of
+#' derivatives of class \code{type} and having an underlying_id of
+#' \code{underlying_id} if given.
+#' @note This should be updated to deal with dates instead of character strings
+#' @author Garrett
+#' @seealso ls_instruments_by for things like e.g.
+#' ls_instruments_by('expires','20110916'), ls_instruments, ls_derivatives,
+#' ls_options, ls_calls, buildHierarchy, instrument.table
+#' @examples
+#'
+#' \dontrun{
+#' option_series.yahoo('SPY')
+#' option_series.yahoo('DIA',NULL)
+#' ls_expiries()
+#'
+#' }
+#' @export
+#' @rdname ls_expiries
+ls_expiries <- function(pattern=NULL, match=TRUE, underlying_id=NULL, type='derivative') {
+ #if (!is.null(pattern)) underlying_id <- ls_underlyings
+ if (is.null(underlying_id))
+ underlying_id <- ls_underlyings(pattern,match)
+ symbols <- do.call(eval(paste('ls_',type,"s",sep="")),args=list(pattern=pattern) ) #symbols == all derivatives by default
+ dates <- NULL
+ underlyings <- NULL
+ for (symbol in symbols) {
+ tmp_instr <- try(get(symbol,pos=.instrument),silent=TRUE)
+ if (!is.null(tmp_instr$underlying_id) && any(tmp_instr$underlying_id==underlying_id)) { #the underlying_id of this instr mathces one of the one's we're interested in.
+ underlying <- tmp_instr$underlying_id
+ if (is.null(tmp_instr$expires)) { #get value for expiry; may be in 'expires' or 'expiry' slot
+ if (!is.null(tmp_instr$expiry)) {
+ expiry <- tmp_instr$expiry
+ } else expiry <- NULL
+ } else expiry <- tmp_instr$expires
+ dates <- c(dates, expiry)
+ if (!is.null(expiry)) underlyings <- c(underlyings, underlying)
+ }
+ #ll <- list(expiry)
+ #names(ll) <- underlying
+ #dates <- c(dates, ll)
+ }
+ #cbind(underlyings,dates[-which(duplicated(underlyings))])
+ if(!identical(which(duplicated(dates)),integer(0))) {
+ expires <- dates[-which(duplicated(dates))]
+ names(expires) <- underlyings[-which(duplicated(dates))]
+ } else {
+ expires <- dates
+ names(expires) <- underlyings
+ }
+ expires
+# underlying_id <- underlyings[-which(duplicated(dates))]
+# names(underlying_id) <- dates[-which(duplicated(dates))]
+# data.frame(underlying_id)
+}
+
+#' @export
+#' @rdname ls_expiries
+ls_expires <- ls_expiries
+
+
+#ls_instruments_by('expires','20110916')
+#ls_expiries(underlying_id=ls_underlyings(ls_calls())) #Nesting
+#ls_expiries('SPY')
+#ls_expiries(ls_calls())
+
+
Added: pkg/FinancialInstrument/R/ls_instruments.R
===================================================================
--- pkg/FinancialInstrument/R/ls_instruments.R (rev 0)
+++ pkg/FinancialInstrument/R/ls_instruments.R 2011-10-20 23:18:56 UTC (rev 822)
@@ -0,0 +1,578 @@
+#' display the names of or delete instruments, stocks, options, futures,
+#' currencies, bonds, funds, spreads, guaranteed_spreads, synthetics,
+#' derivatives, or non-derivatives.
+#'
+#' ls functions return the names of all the instruments of the class implied by
+#' the function name. rm functions remove the instruments of the class implied
+#' by the function name
+#'
+#' rm_instruments and rm_non_derivatives will not delete currencies unless the
+#' keep.currencies argument is FALSE.
+#'
+#' For the rm functions, x can be a vector of instrument names, or nothing. If
+#' \code{x} is missing, all instruments of the relevant type will be removed.
+#'
+#' It can be useful to nest these functions to get things like futures
+#' denominated in USD.
+#'
+#' @aliases ls_instruments ls_stocks ls_options ls_option_series ls_futures
+#' ls_future_series ls_currencies ls_non_currencies ls_exchange_rates ls_FX
+#' ls_bonds ls_funds ls_spreads ls_guaranteed_spreads ls_synthetics
+#' ls_derivatives ls_non_derivatives ls_calls ls_puts rm_instruments rm_stocks
+#' rm_options rm_option_series rm_futures rm_future_series rm_currencies
+#' rm_exchange_rates rm_FX rm_bonds rm_funds rm_spreads rm_synthetics
+#' rm_derivatives rm_non_derivatives
+#' @param pattern an optional regular expression. Only names matching
+#' \sQuote{pattern} are returned.
+#' @param match return only exact matches?
+#' @param verbose be verbose?
+#' @param include.series should future_series or option_series instruments be
+#' included.
+#' @param x what to remove. if not supplied all instruments of relevent class
+#' will be removed. For \code{ls_defined.by} x is the string describing how the
+#' instrument was defined.
+#' @param keep.currencies If TRUE, currencies will not be deleted.
+#' @param includeFX should exchange_rates be included in ls_non_currencies
+#' results
+#' @return ls functions return vector of character strings corresponding to
+#' instruments of requested type rm functions are called for side-effect
+#' @author Garrett See
+#' @seealso ls_instruments_by, ls_by_currency, ls_by_expiry, ls, rm,
+#' instrument, stock, future, option, currency, FinancialInstrument::sort_ids
+#' @examples
+#'
+#' \dontrun{
+#' #rm_instruments(keep.currencies=FALSE) #remove everything from .instrument
+#'
+#' # First, create some instruments
+#' currency('USD')
+#' currency('EUR')
+#' currency('JPY')
+#' #stocks
+#' stock("SEE","USD")
+#' stock("SE","USD")
+#' stock("S","USD")
+#' stock("SPY",'USD')
+#' #derivatives
+#' option('.SPY','USD',multiplier=100,expiry='20110618', strike=130, callput='put', underlying_id='SPY')
+#' future('ES', 'USD', multiplier=50, expiry='20110916', underlying_id='ES')
+#' option('.ES','USD',multiplier=1, expiry='201106',strike=1350, right='C', underlying_id='ES')
+#'
+#' # Now, the examples
+#' ls_instruments() #all instruments
+#' ls_instruments("SE") #only the one stock
+#' ls_instruments("S", match=FALSE) #anything with "S" in name
+#'
+#' ls_currencies()
+#' ls_stocks()
+#' ls_options()
+#' ls_futures()
+#' ls_derivatives()
+#' ls_puts()
+#' ls_non_derivatives()
+#' #ls_by_expiry('20110618',ls_puts) #put options that expire on Jun 18th, 2011
+#' #ls_puts(ls_by_expiry('20110618')) #same thing
+#'
+#' rm_options('.SPY')
+#' rm_futures()
+#' ls_instruments()
+#' #rm_instruments('EUR') #Incorrect
+#' rm_instruments('EUR', keep.currencies=FALSE) #remove the currency
+#' rm_currencies('JPY') #or remove currency like this
+#' ls_currencies()
+#' ls_instruments()
+#'
+#' rm_instruments() #remove all but currencies
+#' rm_currencies()
+#'
+#' #option_series.yahoo('DIA')
+#' ls_instruments_by('underlying_id','DIA') #underlying_id must exactly match 'DIA'
+#' ls_derivatives('DIA',match=FALSE) #primary_ids that contain 'DIA'
+#' }
+#' @export
+#' @rdname ls_instruments
+ls_instruments <- function(pattern=NULL, match=TRUE, verbose=TRUE) {
+ if (length(pattern) > 1 && !match) {
+ if (verbose)
+ warning("Using match=TRUE because length of pattern > 1.")
+ #should I use match?
+ #or, ignore pattern and return everything?
+ #or, do multiple ls calls and return unique
+ match <- TRUE
+ }
+ if (!is.null(pattern) && match) { #there's a pattern and match is TRUE
+ symbols <- ls(.instrument, all.names=TRUE)
+ symbols <- symbols[match(pattern,symbols)]
+ } else if (!match && length(pattern) == 1) { # pattern is length(1) and don't match
+ symbols <- ls(.instrument, all.names=TRUE, pattern=pattern)
+ } else if (is.null(pattern)) { #no pattern
+ symbols <- ls(.instrument, all.names=TRUE)
+ } # else pattern length > 1 & don't match
+
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (is.instrument(tmp_instr)) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_stocks <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'stock') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_options <- function(pattern=NULL,match=TRUE, include.series=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'option') && inherits(tmp_instr, 'instrument')) {
+ if (!inherits(tmp_instr, 'option_series') || include.series)
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_option_series <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'option_series') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_futures <- function(pattern=NULL,match=TRUE, include.series=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'future') && inherits(tmp_instr, 'instrument')) {
+ if (!inherits(tmp_instr, 'future_series') || include.series)
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_future_series <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'future_series') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_currencies <- function(pattern=NULL, match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'currency') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_non_currencies <- function(pattern=NULL, includeFX=TRUE, match=TRUE) {
+ symbols <- ls_instruments(pattern, match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (!inherits(tmp_instr, 'currency') ||
+ (inherits(tmp_instr, 'exchange_rate') && includeFX) ) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_exchange_rates <- ls_FX <- function(pattern=NULL,match=TRUE) {
+ #This could use ls_currencies instead of ls_instruments, but currency class may be
+ #subject to change
+ symbols <- ls_instruments(pattern=pattern,match=match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'exchange_rate') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_bonds <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'bond') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_funds <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'fund') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_spreads <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'spread') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_guaranteed_spreads <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'guaranteed_spread') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_synthetics <- function(pattern=NULL, match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'synthetic') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+
+# should it be ls_yahoo, ls_defined.by.yahoo, or ls_src? something else?
+#ls_yahoo <- function(pattern=NULL) {
+#instruments defined by yahoo
+# symbols <- ls_instruments(pattern) #TODO: other functions should be updated to get symbols like this too
+# tmp_symbols <- NULL
+# for (instr in symbols) {
+# tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+# if ( is.instrument(tmp_instr) && !is.null(tmp_instr$defined.by) ) {
+# dby <- unlist(strsplit( tmp_instr$defined.by,";"))
+# if (any(dby == "yahoo" ))
+# tmp_symbols <- c(tmp_symbols, instr)
+# }
+# }
+# tmp_symbols
+#}
+
+#ls_IB <- function(pattern=NULL) {
+#instruments defined by IB
+# symbols <- ls_instruments(pattern)
+# tmp_symbols <- NULL
+# for (instr in symbols) {
+# tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+# if ( is.instrument(tmp_instr) && !is.null(tmp_instr$defined.by) ) {
+# dby <- unlist(strsplit( tmp_instr$defined.by,";"))
+# if (any(dby == "IB" )) tmp_symbols <- c(tmp_symbols,instr)
+# }
+# }
+# tmp_symbols
+#}
+
+
+#ls_defined.by <- function(x, pattern=NULL) {
+# symbols <- ls_instruments(pattern)
+# tmp_symbols <- NULL
+# for (symbol in symbols) {
+# tmp_instr <- try(get(symbol, pos=.instrument),silent=TRUE)
+# if (is.instrument(tmp_instr) && !is.null(tmp_instr$defined.by) ) {
+# dby <- unlist(strsplit( tmp_instr$defined.by,";"))
+# if (any(dby == x)) tmp_symbols <- c(tmp_symbols,symbol)
+# }
+# }
+# tmp_symbols
+#}
+
+#' @export
+#' @rdname ls_instruments
+ls_derivatives <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ #there is currently no derivative class
+ #but check for it in case someone made one
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (inherits(tmp_instr, 'derivative') ||
+ inherits(tmp_instr, 'option') ||
+ inherits(tmp_instr, 'future') ) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_non_derivatives <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_instruments(pattern,match)
+ #there is currently no derivative class
+ #but check for it in case someone made one
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (!inherits(tmp_instr, 'derivative') &&
+ !inherits(tmp_instr, 'option') &&
+ !inherits(tmp_instr, 'future') ) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+
+
+#' @export
+#' @rdname ls_instruments
+ls_calls <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_options(pattern=pattern,match=match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (is.instrument(tmp_instr) && inherits(tmp_instr, 'option')) {
+ if (!is.null(tmp_instr$callput)) {
+ right <- tmp_instr$callput
+ }else if(!is.null(tmp_instr$right)) {
+ right <- tmp_instr$right
+ } else right <- FALSE
+ if (right == "C" || right == "Call" ||
+ right == "call" || right == "c") {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ }
+ tmp_symbols
+}
+
+#' @export
+#' @rdname ls_instruments
+ls_puts <- function(pattern=NULL,match=TRUE) {
+ symbols <- ls_options(pattern=pattern,match=match)
+ tmp_symbols <- NULL
+ for (instr in symbols) {
+ tmp_instr <- try(get(instr, pos = .instrument),silent=TRUE)
+ if (is.instrument(tmp_instr) && inherits(tmp_instr, 'option')) {
+ if (!is.null(tmp_instr$callput)) {
+ right <- tmp_instr$callput
+ }else if(!is.null(tmp_instr$right)) {
+ right <- tmp_instr$right
+ } else right <- FALSE
+ if (right == "P" || right == "Put" ||
+ right == "put" || right == "p") {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ }
+ tmp_symbols
+}
+
+
+#TODO: add error checking: check to see if .instrument exists
+
+#' @export
+#' @rdname ls_instruments
+rm_instruments <- function(x, keep.currencies=TRUE) {
+ if (missing(x)) {
+ x <- ls_instruments()
+ }
+ if (keep.currencies && !is.null(x)) {
+ if(any(is.na(match(x,ls_currencies())))) { #are any of them not a currency
+ if (!all(is.na(match(x,ls_currencies())))) #are some of them a currency
+ x <- x[!x %in% ls_currencies()] #then take them out of to-be-removed
+ } else stop('Use keep.currencies=FALSE to delete a currency')
+ }
+
+ rm(list=x,pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_stocks <- function(x) {
+ if (missing(x)) {
+ x <- ls_stocks()
+ }
+ rm(list=x[x %in% ls_stocks()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_options <- function(x) {
+ if (missing(x)) {
+ x <- ls_options()
+ }
+ rm(list=x[x %in% ls_options()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_option_series <- function(x) {
+ if (missing(x)) {
+ x <- ls_option_series()
+ }
+ rm(list=x[x %in% ls_option_series()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_futures <- function(x) {
+ if (missing(x)) {
+ x <- ls_futures()
+ }
+ rm(list=x[x %in% ls_futures()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_future_series <- function(x) {
+ if (missing(x)) {
+ x <- ls_future_series()
+ }
+ rm(list=x[x %in% ls_future_series()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_currencies <- function(x) {
+ if (missing(x)) {
+ x <- ls_currencies()
+ }
+ rm(list=x[x %in% ls_currencies()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_exchange_rates <- rm_FX <- function(x) {
+ if (missing(x)) {
+ x <- ls_exchange_rates()
+ }
+ rm(list=x[x %in% ls_exchange_rates()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_bonds <- function(x) {
+ if (missing(x)) {
+ x <- ls_bonds()
+ }
+ rm(list=x[x %in% ls_bonds()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_funds <- function(x) {
+ if (missing(x)) {
+ x <- ls_funds()
+ }
+ rm(list=x[x %in% ls_funds()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_spreads <- function(x) {
+ if (missing(x)) {
+ x <- ls_spreads()
+ }
+ rm(list=x[x %in% ls_spreads()], pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_synthetics <- function(x) {
+ if (missing(x)) {
+ x <- ls_synthetics()
+ }
+ rm(list=x[x %in% ls_synthetics()],pos=.instrument)
+}
+
+
+#' @export
+#' @rdname ls_instruments
+rm_derivatives <- function(x) {
+ if (missing(x)) {
+ x <- ls_derivatives()
+ }
+ rm(list=x[x %in% ls_derivatives()],pos=.instrument)
+}
+
+#' @export
+#' @rdname ls_instruments
+rm_non_derivatives <- function(x, keep.currencies=TRUE) {
+ if (missing(x)) {
+ x <- ls_non_derivatives()
+ }
+ if (keep.currencies && !is.null(x)) {
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/blotter -r 822
More information about the Blotter-commits
mailing list