[Blotter-commits] r872 - in pkg/FinancialInstrument: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 11 18:29:02 CET 2011
Author: gsee
Date: 2011-12-11 18:29:00 +0100 (Sun, 11 Dec 2011)
New Revision: 872
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/NAMESPACE
pkg/FinancialInstrument/R/instrument.R
pkg/FinancialInstrument/R/ls_instruments.R
pkg/FinancialInstrument/R/parse_id.R
pkg/FinancialInstrument/R/synthetic.R
pkg/FinancialInstrument/man/ls_instruments.Rd
pkg/FinancialInstrument/man/synthetic.instrument.Rd
Log:
- support for ICS: ICS and ICS_root instrument constructors;
ls_ICS and ls_ICS_roots funs;
instrument.auto now recogizes ICS
- parse_id will replace "-" with "." before it begins its work
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/DESCRIPTION 2011-12-11 17:29:00 UTC (rev 872)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.9.10
+Version: 0.9.11
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/NAMESPACE 2011-12-11 17:29:00 UTC (rev 872)
@@ -19,6 +19,8 @@
export(getInstrument)
export(getSymbols.FI)
export(guaranteed_spread)
+export(ICS)
+export(ICS_root)
export(instrument)
export(instrument_attr)
export(instrument.auto)
@@ -47,6 +49,8 @@
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)
Modified: pkg/FinancialInstrument/R/instrument.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.R 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/R/instrument.R 2011-12-11 17:29:00 UTC (rev 872)
@@ -742,6 +742,23 @@
if (any(pid$type == 'butterfly')) {
return(butterfly(primary_id, currency=currency, defined.by='auto', assign_i=assign_i, ...))
}
+ if (any(pid$type == 'ICS')) {
+ root <- getInstrument(pid$root, type='ICS_root', silent=TRUE)
+ if (is.instrument(root)) {
+ return(ICS(primary_id, assign_i=assign_i, ...))
+ } else {
+ #TODO: look for members in dots
+ if (!silent) {
+ warning(paste(primary_id, " appears to be an ICS, ",
+ "but its ICS_root cannot be found. ",
+ "Creating _", default_type, "_ instrument instead.", sep=""))
+ warned <- TRUE
+ }
+ dargs$root_id <- pid$root
+ dargs$suffix_id <- pid$suffix
+ dargs$expires <- paste(pid$year, sprintf("%02d", month_cycle2numeric(pid$month)), sep="-")
+ }
+ }
if (any(pid$type == 'future') || any(pid$type == 'SSF')) {
root <- getInstrument(pid$root,silent=TRUE,type='future')
if (is.instrument(root) && !inherits(root, 'future_series')) {
Modified: pkg/FinancialInstrument/R/ls_instruments.R
===================================================================
--- pkg/FinancialInstrument/R/ls_instruments.R 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/R/ls_instruments.R 2011-12-11 17:29:00 UTC (rev 872)
@@ -312,7 +312,34 @@
tmp_symbols
}
+#' @export
+#' @rdname ls_instruments
+ls_ICS <- 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, 'ICS') && inherits(tmp_instr, 'instrument')) {
+ tmp_symbols <- c(tmp_symbols,instr)
+ }
+ }
+ tmp_symbols
+}
+#' @export
+#' @rdname ls_instruments
+ls_ICS_roots <- 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, 'ICS_root') && 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
Modified: pkg/FinancialInstrument/R/parse_id.R
===================================================================
--- pkg/FinancialInstrument/R/parse_id.R 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/R/parse_id.R 2011-12-11 17:29:00 UTC (rev 872)
@@ -27,6 +27,7 @@
parse_id <- function(x, silent=TRUE, root=NULL) {
sufftype <- TRUE #will we use the type given by parse_suffix, or overwrite it with e.g. 'exchange_rate', or 'synthetic'
suffformat <- TRUE #If x begins with "^" this will be set to FALSE, and we'll overwrite parse_suffix(...)$format with yahooIndex"
+ x <- gsub("-", ".", x)
all.numeric <- as.logical(!is.na(suppressWarnings(as.numeric(x))))
if (!is.null(root)) {
suffix <- sub(root,"",x) #turns ESU1 into U1, or ES_U11 into _U11
Modified: pkg/FinancialInstrument/R/synthetic.R
===================================================================
--- pkg/FinancialInstrument/R/synthetic.R 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/R/synthetic.R 2011-12-11 17:29:00 UTC (rev 872)
@@ -74,9 +74,14 @@
#' It will be \code{\link{strsplit}} using the regex "[-;:_,\\.]" to create the \code{members} vector,
#' and potentially combined with a \code{root_id}.
#'
-#' The wrappers will build \code{primary_id} if is NULL, either by combining \code{root_id} and \code{suffix_id}, or
+#' Most wrappers will build \code{primary_id} if it is NULL, either by combining \code{root_id} and \code{suffix_id}, or
#' by passing \code{members} in a call to \code{\link{make_spread_id}}
#'
+#' \code{ICS} will build an Intercommodity Spread. Although the expiration date and ratio may change,
+#' the members of a given ICS will not change. Therefore, \code{ICS_root} can be used to hold the
+#' members of an Intercommodity Spread. If an \code{ICS_root} has not been defined, then \code{members}
+#' will be a required argument for \code{ICS}
+#'
#' We welcome assistance from others to model more complex OTC derivatives such as swap products.
#'
#' @aliases synthetic.instrument synthetic spread guaranteed_spread butterfly
@@ -127,10 +132,12 @@
}
}
- # expires will be whichever member expires first.
- if (is.character(members)) {
+ # expires will be whichever member expires first (unless it was passed through dots)
+ if (is.character(members) && is.null(dargs$expires)) {
ids <- sort_ids(members) #sort chronologically by expiry
- expires <- try(getInstrument(ids[1], silent=TRUE)$expires)
+ expires <- NULL
+ tmpinstr <- try(getInstrument(ids[1], silent=TRUE))
+ if (is.instrument(tmpinstr)) expires <- tmpinstr$expires
if (!is.null(expires) &&
!inherits(expires, "try-error") &&
is.null(dargs$expires)) {
@@ -261,9 +268,124 @@
synthetic.instrument(primary_id = id, currency = currency, members = members,
memberratio = memberratio, multiplier = multiplier, identifiers = NULL, assign_i=assign_i,
tick_size=tick_size, ... = ..., type = c("guaranteed_spread", "spread",
- "synthetic.instrument", "synthetic"))
+ "synthetic.instrument", "synthetic", 'instrument'))
}
+#' @export
+#' @rdname synthetic.instrument
+ICS_root <- function(primary_id, currency = NULL, members, multiplier=NULL, identifiers=NULL, assign_i=TRUE, ...) {
+ # future roots may begin with a dot; make sure we've got the primary_ids
+ members <- do.call(c, lapply(members, function(x) {
+ instr <- try(getInstrument(x, type='future', silent=TRUE))
+ if (is.instrument(instr))
+ instr$primary_id
+ else {
+ warning(x, ' is not defined.')
+ x
+ }
+ }))
+ getfirst <- function(chr) { # value of 'chr' field of the first of "members" that has a field named "chr"
+ tmp <- suppressWarnings(try(na.omit(as.data.frame(
+ buildHierarchy(members, chr), stringsAsFactors=FALSE)[[chr]][[1]])))
+ if (identical(character(0), as.vector(tmp))) stop(chr, ' is required if no members are defined')
+ tmp
+ }
+
+ # If currency was not given, use the currency of the first 'member' that is defined
+ if (is.null(currency)) currency <- getfirst('currency')
+ # do the same with multiplier
+ if (is.null(multiplier)) multiplier <- getfirst('multiplier')
+
+ synthetic(primary_id, currency, multiplier,
+ identifiers=identifiers, assign_i=assign_i,
+ ... = ..., type='ICS_root', members=members)
+}
+
+#' @export
+#' @rdname synthetic.instrument
+ICS <- function(primary_id, assign_i=TRUE, identifiers = NULL, ...)
+{ #author gsee
+ pid <- parse_id(primary_id)
+ if (!"ICS" %in% pid$type) stop("suffix of primary_id should look like 'H2.0302'")
+
+ dargs <- list(...)
+ root <- getInstrument(pid$root, silent=TRUE, type=c('ICS_root', 'spread', 'synthetic'))
+ # look in dots for arguments that you can use to call ICS_root if there isn't
+ # an ICS_root already defined.
+ if (!is.instrument(root)) {
+ if (is.null(dargs$members)) stop(paste('Please provide "members" or define ICS_root',
+ pid$root))
+ # See if we can create a temporary ICS_root with args in dots
+ icsra <- list() #ICS_root args
+ icsra$primary_id <- pid$root
+ if (!is.null(dargs$currency)) {
+ icsra$currency <- dargs$currency
+ dargs$currency <- NULL
+ }
+ if (!is.null(dargs$multiplier)) {
+ icsra$multiplier <- dargs$multiplier
+ dargs$multiplier <- NULL
+ }
+ if (!is.null(dargs$members)) {
+ icsra$members <- dargs$members
+ dargs$members <- NULL
+ }
+ icsra$assign_i <- FALSE
+ root <- do.call(ICS_root, icsra)
+ } else {
+ dargs$currency <- NULL
+ dargs$multiplier <- NULL
+ dargs$members <- NULL
+ }
+ if (!is.instrument(root)) stop("'ICS_root' must be defined first")
+ members <- root$members
+ #split the suffix in half. 1st half is CY, 2nd half is ratio string
+ suff.1 <- strsplit(pid$suffix, "\\.")[[1]][1]
+ suff.2 <- strsplit(pid$suffix, "\\.")[[1]][2]
+
+ # if members are futures (roots) change them to the future_series
+ # get a list of member instruments
+ memlist <- lapply(members, getInstrument, type=c('future_series', 'future'))
+ #memtypes <- do.call(c, lapply(memlist, "[[", "type"))
+
+ # if any members are future, create a future_series id, else don't change member primary_id
+ members <- sapply(memlist, function(x) {
+ if (x$type[1] == 'future') {
+ if (is.null(x$root)) {
+ paste(x$primary_id, suff.1, sep="_")
+ } else paste(x$root, suff.1, sep="_")
+ } else x$primary_id
+ })
+
+ # Check to make sure members exist in instrument envir. Warn if not.
+ defined <- sapply(members, exists, where=.instrument)
+ if (any(defined == FALSE)) warning("No instrument definition found for ",
+ paste(members[!defined], collapse=" "))
+ memberratio <- suff.2
+ if (is.character(memberratio) && length(memberratio == 1)) {
+ # "0503" means c(5, -3). "010201" is c(1,-2,1)
+ memberratio <- do.call(c, lapply(seq(2, nchar(memberratio), 2),
+ function(i) as.numeric(substr(memberratio, i-1, i))))
+ # every other weight will be negative -- i.e. every other position is short
+ if (length(memberratio) > 1) memberratio <- suppressWarnings(memberratio * c(1,-1))
+ }
+ #paste(sub("\\.\\.", "", members)
+ if (length(dargs) == 0) dargs <- NULL
+ siargs <- list() #synthetic.instrument arguments
+ siargs$primary_id <- primary_id
+ siargs$currency <- root$currency
+ siargs$members <- members
+ siargs$memberratio <- memberratio
+ siargs$multiplier <- root$multiplier
+ siargs$identifiers <- identifiers
+ siargs$assign_i <- assign_i
+ siargs$tick_size <- root$tick_size
+ siargs$type <- c('ICS', 'guaranteed_spread', 'spread', 'synthetic.instrument', 'synthetic', 'instrument')
+ siargs <- c(siargs, dargs)
+ do.call(synthetic.instrument, siargs)
+}
+
+
Modified: pkg/FinancialInstrument/man/ls_instruments.Rd
===================================================================
--- pkg/FinancialInstrument/man/ls_instruments.Rd 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/man/ls_instruments.Rd 2011-12-11 17:29:00 UTC (rev 872)
@@ -9,6 +9,8 @@
\alias{ls_future_series}
\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}
@@ -69,6 +71,10 @@
ls_synthetics(pattern = NULL, match = TRUE)
+ ls_ICS(pattern = NULL, match = TRUE)
+
+ ls_ICS_roots(pattern = NULL, match = TRUE)
+
ls_derivatives(pattern = NULL, match = TRUE)
ls_non_derivatives(pattern = NULL, match = TRUE)
Modified: pkg/FinancialInstrument/man/synthetic.instrument.Rd
===================================================================
--- pkg/FinancialInstrument/man/synthetic.instrument.Rd 2011-12-11 00:05:06 UTC (rev 871)
+++ pkg/FinancialInstrument/man/synthetic.instrument.Rd 2011-12-11 17:29:00 UTC (rev 872)
@@ -1,6 +1,8 @@
\name{synthetic}
\alias{butterfly}
\alias{guaranteed_spread}
+\alias{ICS}
+\alias{ICS_root}
\alias{spread}
\alias{synthetic}
\alias{synthetic.instrument}
@@ -27,6 +29,12 @@
root_id = NULL, suffix_id = NULL, members = NULL,
memberratio = c(1, -1), ..., multiplier = NULL,
identifiers = NULL, assign_i = TRUE, tick_size = NULL)
+
+ ICS_root(primary_id, currency = NULL, members,
+ multiplier = NULL, identifiers = NULL, assign_i = TRUE,
+ ...)
+
+ ICS(primary_id, assign_i = TRUE, identifiers = NULL, ...)
}
\arguments{
\item{primary_id}{chr string of primary identifier of
@@ -97,11 +105,18 @@
create the \code{members} vector, and potentially
combined with a \code{root_id}.
- The wrappers will build \code{primary_id} if is NULL,
+ Most wrappers will build \code{primary_id} if it is NULL,
either by combining \code{root_id} and \code{suffix_id},
or by passing \code{members} in a call to
\code{\link{make_spread_id}}
+ \code{ICS} will build an Intercommodity Spread. Although
+ the expiration date and ratio may change, the members of
+ a given ICS will not change. Therefore, \code{ICS_root}
+ can be used to hold the members of an Intercommodity
+ Spread. If an \code{ICS_root} has not been defined, then
+ \code{members} will be a required argument for \code{ICS}
+
We welcome assistance from others to model more complex
OTC derivatives such as swap products.
}
More information about the Blotter-commits
mailing list