[Blotter-commits] r738 - in pkg/FinancialInstrument: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 25 11:56:58 CEST 2011
Author: gsee
Date: 2011-08-25 11:56:58 +0200 (Thu, 25 Aug 2011)
New Revision: 738
Added:
pkg/FinancialInstrument/R/format_id.R
pkg/FinancialInstrument/man/format_id.Rd
pkg/FinancialInstrument/man/month_cycle2numeric.Rd
pkg/FinancialInstrument/man/next.future_id.Rd
pkg/FinancialInstrument/man/sort_ids.Rd
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/NAMESPACE
pkg/FinancialInstrument/R/instrument.R
pkg/FinancialInstrument/R/parse_id.R
pkg/FinancialInstrument/R/synthetic.R
pkg/FinancialInstrument/man/parse_suffix.Rd
pkg/FinancialInstrument/man/synthetic.instrument.Rd
pkg/FinancialInstrument/man/synthetic.ratio.Rd
Log:
- add format slot to parsed id lists
- remove some redundant SSF code in parse_suffix
- patches to avoid duplicate instrument type
- add next.future_id and prev.future_id funs
- add format_id fun
- add add month_cycle2numeric fun (and unexported variations)
- add sort_ids fun
- bump version number
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/DESCRIPTION 2011-08-25 09:56:58 UTC (rev 738)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.4.4
+Version: 0.4.5
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
@@ -34,3 +34,4 @@
'volep.R'
'parse_id.R'
'MonthCodes.R'
+ 'format_id.R'
Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/NAMESPACE 2011-08-25 09:56:58 UTC (rev 738)
@@ -11,6 +11,7 @@
export(currency)
export(exchange_rate)
export(fn_SpreadBuilder)
+export(format_id)
export(formatSpreadPrice)
export(fund)
export(future)
@@ -25,13 +26,17 @@
export(is.instrument)
export(load.instruments)
export(M2C)
+export(month_cycle2numeric)
+export(next.future_id)
export(option)
export(option_series)
export(option_series.yahoo)
export(parse_id)
export(parse_suffix)
+export(prev.future_id)
export(redenominate)
export(setSymbolLookup.FI)
+export(sort_ids)
export(spread)
export(stock)
export(synthetic)
Added: pkg/FinancialInstrument/R/format_id.R
===================================================================
--- pkg/FinancialInstrument/R/format_id.R (rev 0)
+++ pkg/FinancialInstrument/R/format_id.R 2011-08-25 09:56:58 UTC (rev 738)
@@ -0,0 +1,227 @@
+
+#' format an id
+#'
+#' convert the primary_id or suffix_id of an \code{instrument} to a different format.
+#' Primarily intended for \code{\link{future_series}} instruments.
+#'
+#' Formats for the suffix_id include
+#' 'CY', 'CYY', and 'CYYYY' where C is the month code and Y is numeric.
+#' 'MMMY', 'MMMYY', 'MMMYYYY' where MMM is an uppercase month abbreviation.
+#' 'xxCY', 'xxCYY', 'xxCYYYY' where xx can be any 2 characters.
+#'
+#' There are currently only 2 formats available for \code{\link{option_series}}: 'opt2' and 'opt4'
+#' where opt2 uses a 2 digit year and opt4 uses a 4 digit year.
+#'
+#' @param id character. the id to be reformatted. Can be either a primary_id or a suffix_id
+#' @param format character string indicating how the id should be formatted. See Details.
+#' @param parse character name of parsing method to use: "id" or "suffix"
+#' @param ... parameters to pass to the parsing function
+#' @return character id of the appropriate format
+#' @author Garrett See
+#' @seealso \code{\link{parse_id}}, \code{\link{parse_suffix}},
+#' \code{\link{M2C}}, \code{\link{month_cycle2numeric}}
+#' @examples
+#' format_id('U1', format='MMMYY', parse='suffix')
+#' format_id('ES_JUN2011', format='CYY', parse='id')
+#' format_id("SPY_20110826P129","opt2")
+#' #several at once
+#' id3 <- c('VX_aug1','ES_U1', 'VX_U11')
+#' format_id(id3,'MMMYY')
+#' format_id(id3,'CYY')
+#' @export
+format_id <- function(id, format=NULL, parse=c('id', 'suffix'), ...) {
+ if (!is.null(format) && format == FALSE) format <- NULL
+ parse <- parse[[1]]
+ out <- NULL
+ for (i in id) {
+ pid <- do.call(paste('parse', parse, sep="_"), list(i, ...))
+ suffix <- ifelse(parse=='id',pid$suffix, i)
+ if (any(!is.null(format))) {
+ tmp <- switch(format[[1]],
+ CY=paste(pid$root,paste(M2C(pid$month),substr(pid$year,4,4),sep=""), sep="_"),
+ CYY=paste(pid$root,paste(M2C(pid$month),substr(pid$year,3,4),sep=""), sep="_"),
+ CYYYY=paste(pid$root,paste(M2C(pid$month),pid$year,sep=""), sep="_"),
+ MMM=paste(pid$root,pid$month,sep="_"),
+ MMMY=paste(pid$root, paste(pid$month,substr(pid$year,4,4), sep=""), sep="_"),
+ MMMYY=paste(pid$root, paste(pid$month,substr(pid$year,3,4), sep=""), sep="_"),
+ MMMYYYY=paste(pid$root, paste(pid$month,pid$year,sep=""), sep="_"),
+ xxCY=paste(pid$root, paste(substr(suffix,1,2), M2C(pid$month), substr(pid$year,4,4), sep=""), sep="_"),
+ xxCYY=paste(pid$root, paste(substr(suffix,1,2), M2C(pid$month), substr(pid$year,3,4), sep=""), sep="_"),
+ xxCYYYY=paste(pid$root, paste(substr(suffix,1,2), M2C(pid$month), pid$year, sep=""), sep="_"),
+ NNNN=paste(pid$root, sprintf("%02d", match(pid$month,toupper(month.abb))), substr(pid$year,3,4), sep="_"),
+ opt2={
+ if (!any(pid$format == c("opt2","opt4"))) stop("I'm not programmed to convert non-option_series_ids to option_series_ids")
+ ifelse(pid$format == "opt4", paste(pid$root, substr(suffix,3,nchar(suffix)), sep="_"), i)
+ },
+ opt4={
+ if (!any(pid$format == c("opt2","opt4"))) stop("I'm not programmed to convert non-option_series_ids to option_series_ids")
+ ifelse(pid$format == "opt2", paste(pid$root, paste("20",suffix,sep=""), sep="_"), i)
+ },
+ i)
+ if (substr(tmp,1,1) == "_") tmp <- substr(tmp,2,nchar(tmp))
+ out <- c(out, tmp)
+ } else out <- c(out, i)
+ }
+ out
+}
+
+#' coerce month_cycle to a numeric vector
+#'
+#' This will convert month codes or month names to numeric months.
+#'
+#' Input can be a vector or a comma-delimited string
+#' @return numeric vector
+#' @param month_cycle the expiration months of a \code{link{future}}. See examples.
+#' @author Garrett See
+#' @seealso \code{\link{M2C}}, \code{\link{C2M}}, \code{\link{next.future_id}}
+#' \code{\link{future}}
+#' @examples
+#' month_cycle2numeric("H,M,U,Z")
+#' month_cycle2numeric(c("H","M","U","Z"))
+#' month_cycle2numeric("Mar,jun,SEP,dEc")
+#' month_cycle2numeric("March,june,sep,decem")
+#' month_cycle2numeric("3,6,9,12")
+#' month_cycle2numeric(seq(3,12,3))
+#' @export
+month_cycle2numeric <- function(month_cycle) {
+ if (is.character(month_cycle)) {
+ cycle.chr <- toupper(strsplit(paste(month_cycle, collapse=","), ",")[[1]])
+ if (!any(suppressWarnings(is.na(as.numeric(cycle.chr))))) {
+ month_cycle <- as.numeric(cycle.chr)
+ } else {
+ month_cycle <- match(cycle.chr, M2C()) # "H,M" or c("H","M")
+ if (any(is.na(month_cycle))) month_cycle <- pmatch(cycle.chr, toupper(month.name)) # "Mar,Jun" or c("MAR","JUN")
+ }
+ }
+ month_cycle
+}
+
+# @examples
+# month_cycle2code('feb,apr,jun,aug,dec')
+month_cycle2code <- function(month_cycle) {
+ M2C()[month_cycle2numeric(month_cycle)]
+}
+
+# @examples
+# month_cycle2string('feb,apr,jun,aug,dec')
+month_cycle2string <- function(month_cycle) {
+ paste(M2C()[month_cycle2numeric(month_cycle)], collapse=",")
+}
+
+
+#' Get the primary_id of the next-to-expire (previously expiring) future_series instrument
+#'
+#' Using \code{\link{parse_id}}, this will figure out where in the \code{month_cycle} that \code{id}
+#' belongs. Then, it will use the next (previous) month in \code{month_cycle} to construct the id of the
+#' next-to-expire contract.
+#'
+#' \code{month_cycle} can be a numeric vector (corresponding to the months in which contracts expire),
+#' or it can be a vector of month codes, a vector of month abbreviations, or a comma-delimited
+#' string of month codes or abbreviations, in which case an attempt will be made to convert it to a numeric vector.
+#' by passing it through \code{\link{month_cycle2numeric}}
+#'
+#' \code{root} is primarily used when you have an id that does not have an underscore, in which case, providing \code{root}
+#' will make splitting the id into primary_id and suffix_id easier and more accurate. \code{root} can also be used if you want
+#' the returned id to be on a different \code{future} than the id you passed in (when used this way, \code{format} should also be used).
+#'
+#' By default, (when called with \code{format=NULL}) the returned id will be of the same format as the \code{id} that was passed in.
+#' The format of the returned id can be specified with the \code{format} argument. See \code{\link{format_id}} for supported values of \code{format}
+#' @param id character string primary_id of a future_series instrument
+#' @param month_cycle months in which contracts expire. numeric or month codes. See Details.
+#' @param root root_id. usually only used if there is no underscore in the \code{id}. See Details.
+#' @param format how you would like the returned id to be formatted. If NULL, it will match the format of \code{id}. See Details.
+#' @return character
+#' @author Garrett See
+#' @seealso \code{\link{format_id}} for supported values of \code{format}.
+#' \code{\link{month_cycle2numeric}}
+#' @examples
+#' next.future_id("ES_Z1","H,M,U,Z", format=NULL)
+#' next.future_id("VIXAUG11", 1:12, root='VIX', format=NULL)
+#' next.future_id("YM_Q11", seq(3,12,3)) #gives a warning about 'Q' not being part of month_cycle
+#' @export
+#' @rdname next.future_id
+next.future_id <- function(id, month_cycle=seq(3,12,3), root=NULL, format=NULL) {
+ out <- NULL
+ #if month_cycle is character, convert it to numeric vector
+ month_cycle <- month_cycle2numeric(month_cycle)
+ for (ID in id) {
+ pid <- parse_id(ID, silent=TRUE, root=root)
+ y <- pid$year
+ curr.m <- match(pid$month, toupper(month.abb))
+
+ if (is.na(match(curr.m,month_cycle))) {
+ warning('suffix falls inbetween month_cycle months.')
+ #add curr.m to month_cycle
+ month_cycle <- sort(c(curr.m, month_cycle))
+ }
+
+ if (curr.m == last(month_cycle)) {
+ y <- y + 1
+ nxt.m <- month_cycle[1]
+ } else nxt.m <- month_cycle[match(curr.m,month_cycle)+1]
+
+ suffout <- paste(M2C()[nxt.m], substr(y,3,4), sep="")
+ #if there is no underscore in ID sep="", else sep="_"
+ if (identical(integer(0),grep("_",ID))) {sep <- ""} else sep="_"
+ if (is.null(format)) format <- pid$format
+ suffout <- format_id(suffout, format, parse='suffix')
+ out <- c(out, paste(pid$root, suffout, sep=sep))
+ }
+ out
+}
+
+#' @export
+#' @rdname next.future_id
+prev.future_id <- function(id, month_cycle=seq(3,12,3), root=NULL, format=NULL) {
+ out <- NULL
+ month_cycle <- month_cycle2numeric(month_cycle)
+ for (ID in id) {
+ pid <- parse_id(id, silent=TRUE, root=root)
+ y <- pid$year
+ curr.m <- match(pid$month, toupper(month.abb))
+
+ if (is.na(match(curr.m,month_cycle))) {
+ warning('suffix falls inbetween month_cycle months.')
+ #add curr.m to month_cycle
+ month_cycle <- sort(c(curr.m, month_cycle))
+ }
+
+ if (curr.m == first(month_cycle)) {
+ y <- y - 1
+ prev.m <- last(month_cycle)
+ } else prev.m <- month_cycle[match(curr.m,month_cycle)-1]
+
+ suffout <- paste(M2C()[prev.m], substr(y,3,4), sep="")
+ #if there is no underscore in id and format==NULL sep="", else sep="_"
+ if (identical(integer(0),grep("_",id))) {sep <- ""} else sep="_"
+ if (is.null(format)) format <- pid$format
+ suffout <- format_id(suffout, format, parse='suffix')
+ out <- c(out, paste(pid$root, suffout, sep=sep))
+ }
+ out
+}
+
+#' sort primary_ids of instruments
+#'
+#' Primarily intended for use on the primary_ids of \code{\link{future_series}} instruments.
+#' This will sort ids by expiration. All ids that do not contain month and year information
+#' will be sorted alphabetically (separately) and appended to the end of the other sorted ids.
+#' @param ids character vector of ids
+#' @param ... arguments to pass through to \code{\link{parse_id}}
+#' @return sorted character vector of the same length as \code{ids}
+#' @author Garrett See
+#' @seealso \code{\link{parse_id}}
+#' @examples
+#' ids <- c("ES_U11",'GLD','SPY',"YM_Jun11",'DIA','VX_V10')
+#' sort_ids(ids)
+#' @export
+sort_ids <- function(ids, ...) {
+ f <- function(x, ...) {
+ pid <- parse_id(x, ...)
+ as.Date(paste(pid$year,pid$month,15,sep=''),format="%Y%b%d")
+ }
+ out1 <- names(sort(sapply(ids,f, ...)))
+ out2 <- sort(ids[!(ids %in% out1)])
+ c(out1,out2)
+}
+
Modified: pkg/FinancialInstrument/R/instrument.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.R 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/R/instrument.R 2011-08-25 09:56:58 UTC (rev 738)
@@ -123,7 +123,7 @@
if(!is.numeric(multiplier) | length(multiplier) > 1) stop("multiplier must be a single number")
if(!is.null(tick_size) && (!is.numeric(tick_size) | length(tick_size) > 1)) stop("tick_size must be NULL or a single number")
- if(is.null(type)) tclass="instrument" else tclass = c(type,"instrument")
+ if(is.null(type)) tclass="instrument" else tclass = unique(c(type,"instrument"))
tmpinstr <- list(primary_id = primary_id,
currency = currency,
Modified: pkg/FinancialInstrument/R/parse_id.R
===================================================================
--- pkg/FinancialInstrument/R/parse_id.R 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/R/parse_id.R 2011-08-25 09:56:58 UTC (rev 738)
@@ -9,7 +9,7 @@
#' After splitting \code{x} into a root_id and suffix_id, the suffix_id is
#' passed to \code{\link{parse_suffix}} (see also) for further processing.
#'
-#' TODO: add support for bond_series.
+#' TODO: add support for bond_series.
#' @param x the id to be parsed (e.g. \sQuote{ES_U11}, \sQuote{SPY_111217C130})
#' @param silent silence warnings?
#' @param root character name of instrument root_id. Optionally provide this to make parsing easier.
@@ -76,7 +76,7 @@
if (sufftype) type <- suff$type
structure(list(root=root, suffix=suffix, type=type, month=suff$month,
year=suff$year, strike=suff$strike, right=suff$right,
- cm=suff$cm, cc=suff$cc),class='id.list')
+ cm=suff$cm, cc=suff$cc, format=suff$format),class='id.list')
}
#' parse a suffix_id
@@ -108,7 +108,7 @@
#' @return an object of class \sQuote{suffix.list} which is a list containing \sQuote{type} of instrument,
#' \sQuote{month} of expiration, \sQuote{year} of expiration, \sQuote{strike} price of option,
#' \sQuote{right} of option (\dQuote{C} or \dQuote{P}), \sQuote{cm} (maturity in days of a constant maturity contract),
-#' \sQuote{cc} (method for calculating a continuous contract).
+#' \sQuote{cc} (method for calculating a continuous contract), \sQuote{format} (string that indicates the format of the unparsed id).
#' @author Garrett See
#' @seealso \code{\link{parse_id}}
#' @examples
@@ -124,6 +124,7 @@
year <- 0
strike <- NA
right <- NA
+ format <- NA
if (x == "") {
type <- "root"
} else if (!identical(gsub("cm.","",x), x)) {
@@ -131,12 +132,14 @@
#on the vix would look like VX_cm.30
type <- c('outright', 'cm')
cm <- as.numeric(strsplit(x,"\\.")[[1]][2])
+ format <- 'cm'
} else if (!identical(gsub("cc.","",x),x)) {
#cc.OI for rolling on Open Interest,
#cc.Vol for rolling on Volume,
#cc.Exp.1 for rolling 1 day before Expiration date. (Exp.0 would be rolling on expiration)
type <- c('outright', 'cc')
cc <- gsub('cc.','',x)
+ format <- 'cc'
} else if (nchar(x) > 7 && (any(substr(x,7,7) == c("C","P")) || any(substr(x,9,9) == c("C","P"))) ) {
# if the 7th or 9th char is a "C" or "P", it's an option
# 110917C125 or 20110917C125
@@ -145,20 +148,22 @@
|| (hasdot
&& !is.na(as.numeric(strsplit(x,"\\.")[[1]][2])))) {
#&& nchar(strsplit(x,"\\.")[[1]][2]) <= 2)) {
- #if it doesn't have a dot, or it does have dot, but what follows
- #the dot is numeric, then it's an option outright
+ #if it doesn't have a dot, or it does have dot, but what follows
+ #the dot is numeric, then it's an option outright
if (any(substr(x,7,7) == c("C","P"))) {
type <- c("outright","option")
month <- toupper(month.abb[as.numeric(substr(x,3,4))])
year <- 2000 + as.numeric(substr(x,1,2))
strike <- as.numeric(substr(x,8,nchar(x)))
right <- substr(x,7,7)
+ format <- 'opt2'
} else if (any(substr(x,9,9) == c("C","P"))) {
type <- c("outright","option")
month <- toupper(month.abb[as.numeric(substr(x,5,6))])
year <- as.numeric(substr(x,1,4))
strike <- as.numeric(substr(x,10,nchar(x)))
right <- substr(x,9,9)
+ format <- 'opt4'
} else stop("how did you get here?")
} else type <- c("option_spread","spread")
} else if (!identical(gsub("\\.","",x),x)) { #has a dot. U1.Z1, U11.Z11, SPY.DIA,
@@ -173,7 +178,7 @@
if (inherits(s2,'try-error')) {
s2 <- parse_id(s[2],silent=TRUE)
}
- #if (s1$
+
if (all(c(s1$type,s2$type) == 'root')) {
type='synthetic'
} else {
@@ -191,6 +196,7 @@
suff <- parse_suffix(substr(x,3,nchar(x)),silent=silent)
month <- suff$month
year <- suff$year
+ format <- paste('xx', suff$format, sep="")
} else if (nchar(x) == 2) { #U1
if (substr(x,1,1) %in% M2C() && !is.na(as.numeric(substr(x,2,2)))) {
type <- c("outright","future")
@@ -198,6 +204,7 @@
year <- as.numeric(substr(x,2,2)) + 2010
if (!silent)
warning("Converting 1 digit year to 4 digit year assumes there are no futures before 2010")
+ format <- 'CY'
} else if (is.na(as.numeric(x))) type <- 'root'
} else if (nchar(x) == 3) { #U11
if (substr(x,1,1) %in% M2C() && !is.na(as.numeric(substr(x,2,3)))) {
@@ -207,35 +214,28 @@
if (year > 2040) year <- year - 100
if (!silent)
warning('Converting 2 digit year to 4 digit year will result in a year between 1941 and 2040')
+ format <- 'CYY'
} else type <- 'root'
} else if (nchar(x) == 4) { #SEP1, VXU1, 0911
if (toupper(substr(x, 1, 3)) %in% toupper(C2M()) && !is.na(as.numeric(substr(x,4,4)))) {
#sep1, Sep1, SEP1
suff <- paste(M2C(tolower(substr(x,1,3))), substr(x,4,4), sep="") #convert from Sep1 to U1
- return(parse_suffix(suff,silent=silent)) #call recursively with 2 character suffix
+ out <- parse_suffix(suff,silent=silent) #call recursively with 2 character suffix
+ out$format <- 'MMMY'
+ return(out)
} else if (substr(x,3,3) %in% M2C() && !is.na(as.numeric(substr(x,4,4)))) {
- n <- suppressWarnings(as.numeric(substr(x,1,1)))
- if (is.na(n) || n != 1) { #first char will be 1 if it's a single stock future
- #xxU1, VXU1 #ignore the 1st 2 characters, and
- #call recursively with nchar==2 suffix
- return(parse_suffix(substr(x,3,4),silent=silent))
- }
- #Single Stock Futures, SPY_1CU1, SPY_1DU1 (1DU1 is the OCX.NoDivRisk)
- if (substr(x,1,2) == "1C" ) { #1CU1
- type <- c('outright', 'SSF')
- } else if (substr(x,1,2) == "1D") { #1DU1
- type <- c('outright', 'SSF', 'NoDivRisk')
- } else { #shouldn't ever get here...it would have to be something like 11U1
- stop("unknown 4 char suffix that begins with 1")
- }
- suff <- parse_suffix(substr(x,3,4), silent=silent)
+ #xxU1, VXU1 #ignore the 1st 2 characters, and call recursively with 2 character suffix
+ suff <- parse_suffix(substr(x,3,4),silent=silent)
month <- suff$month
- year <- suff$year
+ year <- suff$year
+ format <- 'xxCY'
} else if (!is.na(as.numeric(x))) {
#0911
#convert to U11 and call recursively
suff <- paste(M2C()[as.numeric(substr(x,1,2))], substr(x, 3,4), sep="")
- return(parse_suffix(suff,silent=silent))
+ out <- parse_suffix(suff,silent=silent)
+ out$format <- "NNNN"
+ return(out)
} else {
if (!silent)
warning("Could not parse 4 character suffix")
@@ -249,10 +249,12 @@
month <- toupper(substr(x,1,3))
year <- as.numeric(substr(x,4,5)) + 2000
if (!silent) warning('Converting 2 digit year to 4 digit year assumes there are no futures before 2000')
+ format <- 'MMMYY'
} else if (!is.na(as.numeric(substr(x,2,5))) && (substr(x,1,1) %in% M2C()) ) {
#U2011
month <- toupper(C2M(substr(x,1,1)))
year <- as.numeric(substr(x,2,5))
+ format <- 'CYYYY'
}
} else if (nchar(x) == 6) {
#201109, 092011, 091611
@@ -266,8 +268,9 @@
type <- c("outright","future")
month <- toupper(substr(x,1,3))
year <- as.numeric(substr(x, 4,7))
+ format <- 'MMMYYYY'
}
}
- structure(list(type=type, month=month,year=year, strike=strike, right=right, cm=cm, cc=cc), class='suffix.list')
+ structure(list(type=type, month=month,year=year, strike=strike, right=right, cm=cm, cc=cc, format=format), class='suffix.list')
}
Modified: pkg/FinancialInstrument/R/synthetic.R
===================================================================
--- pkg/FinancialInstrument/R/synthetic.R 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/R/synthetic.R 2011-08-25 09:56:58 UTC (rev 738)
@@ -13,7 +13,7 @@
#' @export
#' @rdname synthetic.instrument
-synthetic <- function(primary_id , currency , multiplier=1, identifiers = NULL, ..., members=NULL, type=c("synthetic", "instrument"))
+synthetic <- function(primary_id , currency , multiplier=1, identifiers = NULL, ..., members=NULL, type="synthetic")
{
instrument(primary_id=primary_id , currency=currency , multiplier=multiplier , identifiers = identifiers, ...=..., type=type, members=members, assign_i=TRUE )
}
@@ -42,7 +42,7 @@
#' @param memberratio numeric vector of ratio relationships between members, e.g. c(4,3) for a 4:3 spread
#' @note DEPRECATED
#' @export
-synthetic.ratio <- function(primary_id , currency , members, memberratio, ..., multiplier=1, identifiers = NULL, type=c("synthetic.ratio","synthetic","instrument"))
+synthetic.ratio <- function(primary_id , currency , members, memberratio, ..., multiplier=1, identifiers = NULL, type=c("synthetic.ratio","synthetic"))
{
#TODO make sure that with options/futures or other instruments that we have you use the base contract
if(!is.list(members)){
@@ -122,7 +122,7 @@
#' }
#' @export
synthetic.instrument <- function (primary_id, currency, members, memberratio, ..., multiplier = 1, tick_size=NULL,
- identifiers = NULL, type = c("synthetic.instrument", "synthetic", "instrument"))
+ identifiers = NULL, type = c("synthetic.instrument", "synthetic"))
{
if (!is.list(members)) {
if (length(members) != length(memberratio) | length(members) <
@@ -232,5 +232,5 @@
synthetic.instrument(primary_id = id, currency = currency, members = members,
memberratio = memberratio, multiplier = multiplier, identifiers = NULL,
tick_size=tick_size, ... = ..., type = c("guaranteed_spread", "spread",
- "synthetic.instrument", "synthetic", "instrument"))
+ "synthetic.instrument", "synthetic"))
}
Added: pkg/FinancialInstrument/man/format_id.Rd
===================================================================
--- pkg/FinancialInstrument/man/format_id.Rd (rev 0)
+++ pkg/FinancialInstrument/man/format_id.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -0,0 +1,55 @@
+\name{format_id}
+\alias{format_id}
+\title{format an id}
+\usage{
+ format_id(id, format = NULL, parse = c("id", "suffix"),
+ ...)
+}
+\arguments{
+ \item{id}{character. the id to be reformatted. Can be
+ either a primary_id or a suffix_id}
+
+ \item{format}{character string indicating how the id
+ should be formatted. See Details.}
+
+ \item{parse}{character name of parsing method to use:
+ "id" or "suffix"}
+
+ \item{...}{parameters to pass to the parsing function}
+}
+\value{
+ character id of the appropriate format
+}
+\description{
+ convert the primary_id or suffix_id of an
+ \code{instrument} to a different format. Primarily
+ intended for \code{\link{future_series}} instruments.
+}
+\details{
+ Formats for the suffix_id include 'CY', 'CYY', and
+ 'CYYYY' where C is the month code and Y is numeric.
+ 'MMMY', 'MMMYY', 'MMMYYYY' where MMM is an uppercase
+ month abbreviation. 'xxCY', 'xxCYY', 'xxCYYYY' where xx
+ can be any 2 characters.
+
+ There are currently only 2 formats available for
+ \code{\link{option_series}}: 'opt2' and 'opt4' where opt2
+ uses a 2 digit year and opt4 uses a 4 digit year.
+}
+\examples{
+format_id('U1', format='MMMYY', parse='suffix')
+format_id('ES_JUN2011', format='CYY', parse='id')
+format_id("SPY_20110826P129","opt2")
+#several at once
+id3 <- c('VX_aug1','ES_U1', 'VX_U11')
+format_id(id3,'MMMYY')
+format_id(id3,'CYY')
+}
+\author{
+ Garrett See
+}
+\seealso{
+ \code{\link{parse_id}}, \code{\link{parse_suffix}},
+ \code{\link{M2C}}, \code{\link{month_cycle2numeric}}
+}
+
Added: pkg/FinancialInstrument/man/month_cycle2numeric.Rd
===================================================================
--- pkg/FinancialInstrument/man/month_cycle2numeric.Rd (rev 0)
+++ pkg/FinancialInstrument/man/month_cycle2numeric.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -0,0 +1,36 @@
+\name{month_cycle2numeric}
+\alias{month_cycle2numeric}
+\title{coerce month_cycle to a numeric vector}
+\usage{
+ month_cycle2numeric(month_cycle)
+}
+\arguments{
+ \item{month_cycle}{the expiration months of a
+ \code{link{future}}. See examples.}
+}
+\value{
+ numeric vector
+}
+\description{
+ This will convert month codes or month names to numeric
+ months.
+}
+\details{
+ Input can be a vector or a comma-delimited string
+}
+\examples{
+month_cycle2numeric("H,M,U,Z")
+month_cycle2numeric(c("H","M","U","Z"))
+month_cycle2numeric("Mar,jun,SEP,dEc")
+month_cycle2numeric("March,june,sep,decem")
+month_cycle2numeric("3,6,9,12")
+month_cycle2numeric(seq(3,12,3))
+}
+\author{
+ Garrett See
+}
+\seealso{
+ \code{\link{M2C}}, \code{\link{C2M}},
+ \code{\link{next.future_id}} \code{\link{future}}
+}
+
Added: pkg/FinancialInstrument/man/next.future_id.Rd
===================================================================
--- pkg/FinancialInstrument/man/next.future_id.Rd (rev 0)
+++ pkg/FinancialInstrument/man/next.future_id.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -0,0 +1,72 @@
+\name{next.future_id}
+\alias{next.future_id}
+\alias{prev.future_id}
+\title{Get the primary_id of the next-to-expire (previously expiring) future_series instrument}
+\usage{
+ next.future_id(id, month_cycle = seq(3, 12, 3), root =
+ NULL, format = NULL)
+
+ prev.future_id(id, month_cycle = seq(3, 12, 3), root =
+ NULL, format = NULL)
+}
+\arguments{
+ \item{id}{character string primary_id of a future_series
+ instrument}
+
+ \item{month_cycle}{months in which contracts expire.
+ numeric or month codes. See Details.}
+
+ \item{root}{root_id. usually only used if there is no
+ underscore in the \code{id}. See Details.}
+
+ \item{format}{how you would like the returned id to be
+ formatted. If NULL, it will match the format of
+ \code{id}. See Details.}
+}
+\value{
+ character
+}
+\description{
+ Using \code{\link{parse_id}}, this will figure out where
+ in the \code{month_cycle} that \code{id} belongs. Then,
+ it will use the next (previous) month in
+ \code{month_cycle} to construct the id of the
+ next-to-expire contract.
+}
+\details{
+ \code{month_cycle} can be a numeric vector (corresponding
+ to the months in which contracts expire), or it can be a
+ vector of month codes, a vector of month abbreviations,
+ or a comma-delimited string of month codes or
+ abbreviations, in which case an attempt will be made to
+ convert it to a numeric vector. by passing it through
+ \code{\link{month_cycle2numeric}}
+
+ \code{root} is primarily used when you have an id that
+ does not have an underscore, in which case, providing
+ \code{root} will make splitting the id into primary_id
+ and suffix_id easier and more accurate. \code{root} can
+ also be used if you want the returned id to be on a
+ different \code{future} than the id you passed in (when
+ used this way, \code{format} should also be used).
+
+ By default, (when called with \code{format=NULL}) the
+ returned id will be of the same format as the \code{id}
+ that was passed in. The format of the returned id can be
+ specified with the \code{format} argument. See
+ \code{\link{format_id}} for supported values of
+ \code{format}
+}
+\examples{
+next.future_id("ES_Z1","H,M,U,Z", format=NULL)
+next.future_id("VIXAUG11", 1:12, root='VIX', format=NULL)
+next.future_id("YM_Q11", seq(3,12,3)) #gives a warning about 'Q' not being part of month_cycle
+}
+\author{
+ Garrett See
+}
+\seealso{
+ \code{\link{format_id}} for supported values of
+ \code{format}. \code{\link{month_cycle2numeric}}
+}
+
Modified: pkg/FinancialInstrument/man/parse_suffix.Rd
===================================================================
--- pkg/FinancialInstrument/man/parse_suffix.Rd 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/man/parse_suffix.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -17,7 +17,8 @@
price of option, \sQuote{right} of option (\dQuote{C} or
\dQuote{P}), \sQuote{cm} (maturity in days of a constant
maturity contract), \sQuote{cc} (method for calculating a
- continuous contract).
+ continuous contract), \sQuote{format} (string that
+ indicates the format of the unparsed id).
}
\description{
extract information from the suffix_id of an instrument
Added: pkg/FinancialInstrument/man/sort_ids.Rd
===================================================================
--- pkg/FinancialInstrument/man/sort_ids.Rd (rev 0)
+++ pkg/FinancialInstrument/man/sort_ids.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -0,0 +1,34 @@
+\name{sort_ids}
+\alias{sort_ids}
+\title{sort primary_ids of instruments}
+\usage{
+ sort_ids(ids, ...)
+}
+\arguments{
+ \item{ids}{character vector of ids}
+
+ \item{...}{arguments to pass through to
+ \code{\link{parse_id}}}
+}
+\value{
+ sorted character vector of the same length as \code{ids}
+}
+\description{
+ Primarily intended for use on the primary_ids of
+ \code{\link{future_series}} instruments. This will sort
+ ids by expiration. All ids that do not contain month and
+ year information will be sorted alphabetically
+ (separately) and appended to the end of the other sorted
+ ids.
+}
+\examples{
+ids <- c("ES_U11",'GLD','SPY',"YM_Jun11",'DIA','VX_V10')
+sort_ids(ids)
+}
+\author{
+ Garrett See
+}
+\seealso{
+ \code{\link{parse_id}}
+}
+
Modified: pkg/FinancialInstrument/man/synthetic.instrument.Rd
===================================================================
--- pkg/FinancialInstrument/man/synthetic.instrument.Rd 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/man/synthetic.instrument.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -8,12 +8,12 @@
\usage{
synthetic(primary_id, currency, multiplier = 1,
identifiers = NULL, ..., members = NULL, type =
- c("synthetic", "instrument"))
+ "synthetic")
synthetic.instrument(primary_id, currency, members,
memberratio, ..., multiplier = 1, tick_size = NULL,
identifiers = NULL, type = c("synthetic.instrument",
- "synthetic", "instrument"))
+ "synthetic"))
spread(primary_id, currency = NULL, members, memberratio,
tick_size = NULL, ..., multiplier = 1, identifiers =
Modified: pkg/FinancialInstrument/man/synthetic.ratio.Rd
===================================================================
--- pkg/FinancialInstrument/man/synthetic.ratio.Rd 2011-08-24 21:07:11 UTC (rev 737)
+++ pkg/FinancialInstrument/man/synthetic.ratio.Rd 2011-08-25 09:56:58 UTC (rev 738)
@@ -4,7 +4,7 @@
\usage{
synthetic.ratio(primary_id, currency, members,
memberratio, ..., multiplier = 1, identifiers = NULL,
- type = c("synthetic.ratio", "synthetic", "instrument"))
+ type = c("synthetic.ratio", "synthetic"))
}
\arguments{
\item{primary_id}{string describing the unique ID for the
More information about the Blotter-commits
mailing list