[Blotter-commits] r771 - in pkg/FinancialInstrument: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 11 22:33:52 CEST 2011
Author: gsee
Date: 2011-09-11 22:33:52 +0200 (Sun, 11 Sep 2011)
New Revision: 771
Added:
pkg/FinancialInstrument/man/instrument.auto.Rd
pkg/FinancialInstrument/man/print.id.list.Rd
pkg/FinancialInstrument/man/print.suffix.list.Rd
pkg/FinancialInstrument/sandbox/download.tblox.R
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/NAMESPACE
pkg/FinancialInstrument/R/instrument.R
pkg/FinancialInstrument/R/parse_id.R
Log:
- new instrument.auto function guesses which type of instrument to make
- print methods for output from parse_id and parse_suffix (classes id.list and suffix.list)
- updating expires/first traded of existing future_series only concatenates unique dates.
- add file to sandbox with functions to download and format data from tradingblox:
getSymbols.tblox, get_tblox, reformat_tblox
- also in file is define_futures.tblox function to make use of the tradingblox futures dictionary.
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2011-09-11 18:18:00 UTC (rev 770)
+++ pkg/FinancialInstrument/DESCRIPTION 2011-09-11 20:33:52 UTC (rev 771)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios.
Still in heavy development.
-Version: 0.6.4
+Version: 0.6.5
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE 2011-09-11 18:18:00 UTC (rev 770)
+++ pkg/FinancialInstrument/NAMESPACE 2011-09-11 20:33:52 UTC (rev 771)
@@ -21,6 +21,7 @@
export(guaranteed_spread)
export(instrument)
export(instrument_attr)
+export(instrument.auto)
export(instrument.table)
export(is.currency)
export(is.instrument)
@@ -46,4 +47,6 @@
export(.to_daily)
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 2011-09-11 18:18:00 UTC (rev 770)
+++ pkg/FinancialInstrument/R/instrument.R 2011-09-11 20:33:52 UTC (rev 771)
@@ -285,8 +285,8 @@
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<-c(temp_series$first_traded,first_traded)
- temp_series$expires<-c(temp_series$expires,expires)
+ 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(.instrument))
primary_id
} else {
@@ -614,7 +614,93 @@
)
}
}
-
+
+#' Create an instrument based on name alone
+#'
+#' Given a name, this function will attempt to create
+#' an instrument of the appropriate type.
+#'
+#' @note If \code{currency} is not already defined, it will be defined (unless it is not 3 uppercase characters).
+#' The default value for \code{currency} is \dQuote{USD}. If you do not provide a value for \code{currency},
+#' \dQuote{USD} will be defined and used to create the instrument.
+#' @param primary_id charater primary identifier of instrument to be created
+#' @param currency character name of currency that instrument will be denominated it. Default=\dQuote{USD}
+#' @param silent TRUE/FALSE. silence warnings?
+#' @param ... other passthrough parameters
+#' @return Primarily called for its side-effect, but will return the name of the instrument that was created
+#' @note This is not intended to be used to create instruments of type \code{stock}, \code{future}, \code{option},
+#' or \code{bond} although it may be updated in the future.
+#' @author Garrett See
+#' @examples
+#' \dontrun{
+#' instrument.auto("CL_H1.U1")
+#' getInstrument("CL_H1.U1") #guaranteed_spread
+#'
+#' instrument.auto("ES_H1.YM_H1")
+#' getInstrument("ES_H1.YM_H1") #synthetic
+#'
+#' currency(c("USD","EUR"))
+#' instrument.auto("EURUSD")
+#' getInstrument("EURUSD") #made an exchange_rate
+#'
+#' instrument.auto("VX_H11") #no root future defined yet!
+#' getInstrument("VX_H11") #couldn't find future, didnt make future_series
+#' future("VX","USD",1000,underlying_id=synthetic("SPX","USD")) #make the root
+#' instrument.auto("VX_H11") #and try again
+#' getInstrument("VX_H11") #made a future_series
+#' }
+#' @export
+instrument.auto <- function(primary_id, currency='USD', silent=FALSE, ...) {
+##TODO: check formals against dots and remove duplicates from dots before calling constructors to avoid
+# 'formal argument "multiplier" matched by multiple actual arguments'
+ if (!is.currency(currency)) {
+ if (nchar(currency) != 3 || currency != toupper(currency))
+ stop(paste(currency, "is not defined,",
+ "and it will not be auto defined because it does not appear to be valid."))
+ currency(currency)
+ if (!silent) warning(paste('Created currency', currency,'because it was not defined.'))
+ }
+ warned <- FALSE
+ pid <- parse_id(primary_id)
+ type <- NULL
+ if (any(pid$type == 'calendar')) {
+ return(guaranteed_spread(primary_id, currency=currency, defined_by='auto', ...))
+ }
+ if (any(pid$type == 'butterfly')) {
+ return(butterfly(primary_id, currency=currency, defined_by='auto', ...))
+ }
+ if (any(pid$type == 'future')) {
+ root <- getInstrument(pid$root,silent=TRUE,type='future')
+ if (is.instrument(root)) {
+ return(future_series(primary_id,defined_by='auto',...))
+ } else if (!silent) {
+ warning(paste(primary_id,"appears to be a future_series,",
+ "but its root cannot be found.",
+ "Creating basic instrument instead."))
+ warned <- TRUE
+ }
+ }
+ if (any(pid$type == 'option')) {
+ root <- getInstrument(pid$root,silent=TRUE,type='option')
+ if (is.instrument(root)) {
+ return(option_series(primary_id, defined_by='auto', ...))
+ } else if (!silent) {
+ warning(paste(primary_id,"appears to be an option_series,",
+ "but its root cannot be found.",
+ "Creating basic instrument instead."))
+ warned <- TRUE
+ }
+ }
+ if (any(pid$type == 'exchange_rate'))
+ return(exchange_rate(primary_id, defined_by='auto', ...))
+ if (any(pid$type == 'synthetic')) {
+ return(synthetic(members=strsplit(primary_id,"\\.")[[1]], currency=currency, defined_by='auto', ...) )
+ }
+ if (!silent && !warned) warning(paste(primary_id, 'is not of an unambiguous format.', 'Creating basic instrument.'))
+ instrument(primary_id, ..., defined_by='auto', currency=currency, multiplier=1, identifiers=list(), assign_i=TRUE)
+}
+
+
#' primary accessor function for getting objects of type 'instrument'
#'
#' This function will search the \code{.instrument} environment for objects of
Modified: pkg/FinancialInstrument/R/parse_id.R
===================================================================
--- pkg/FinancialInstrument/R/parse_id.R 2011-09-11 18:18:00 UTC (rev 770)
+++ pkg/FinancialInstrument/R/parse_id.R 2011-09-11 20:33:52 UTC (rev 771)
@@ -356,3 +356,25 @@
structure(list(type=type, month=month,year=year, strike=strike, right=right, cm=cm, cc=cc, format=format), class='suffix.list')
}
+
+#' id.list class print method
+#'
+#' @method print id.list
+#' @S3method print id.list
+#' @keywords internal
+print.id.list <- function(x, ...) {
+ str(x, comp.str="", give.length=FALSE, give.attr=FALSE)
+ invisible(x)
+}
+
+#' suffix.list class print method
+#'
+#' @method print suffix.list
+#' @S3method print suffix.list
+#' @keywords internal
+print.suffix.list <- function(x, ...) {
+ str(x, comp.str="", give.length=FALSE, give.attr=FALSE)
+ invisible(x)
+}
+
+
Added: pkg/FinancialInstrument/man/instrument.auto.Rd
===================================================================
--- pkg/FinancialInstrument/man/instrument.auto.Rd (rev 0)
+++ pkg/FinancialInstrument/man/instrument.auto.Rd 2011-09-11 20:33:52 UTC (rev 771)
@@ -0,0 +1,61 @@
+\name{instrument.auto}
+\alias{instrument.auto}
+\title{Create an instrument based on name alone}
+\usage{
+ instrument.auto(primary_id, currency = "USD", silent =
+ FALSE, ...)
+}
+\arguments{
+ \item{primary_id}{charater primary identifier of
+ instrument to be created}
+
+ \item{currency}{character name of currency that
+ instrument will be denominated it. Default=\dQuote{USD}}
+
+ \item{silent}{TRUE/FALSE. silence warnings?}
+
+ \item{...}{other passthrough parameters}
+}
+\value{
+ Primarily called for its side-effect, but will return the
+ name of the instrument that was created
+}
+\description{
+ Given a name, this function will attempt to create an
+ instrument of the appropriate type.
+}
+\note{
+ If \code{currency} is not already defined, it will be
+ defined (unless it is not 3 uppercase characters). The
+ default value for \code{currency} is \dQuote{USD}. If
+ you do not provide a value for \code{currency},
+ \dQuote{USD} will be defined and used to create the
+ instrument.
+
+ This is not intended to be used to create instruments of
+ type \code{stock}, \code{future}, \code{option}, or
+ \code{bond} although it may be updated in the future.
+}
+\examples{
+\dontrun{
+instrument.auto("CL_H1.U1")
+getInstrument("CL_H1.U1") #guaranteed_spread
+
+instrument.auto("ES_H1.YM_H1")
+getInstrument("ES_H1.YM_H1") #synthetic
+
+currency(c("USD","EUR"))
+instrument.auto("EURUSD")
+getInstrument("EURUSD") #made an exchange_rate
+
+instrument.auto("VX_H11") #no root future defined yet!
+getInstrument("VX_H11") #couldn't find future, didnt make future_series
+future("VX","USD",1000,underlying_id=synthetic("SPX","USD")) #make the root
+instrument.auto("VX_H11") #and try again
+getInstrument("VX_H11") #made a future_series
+}
+}
+\author{
+ Garrett See
+}
+
Added: pkg/FinancialInstrument/man/print.id.list.Rd
===================================================================
--- pkg/FinancialInstrument/man/print.id.list.Rd (rev 0)
+++ pkg/FinancialInstrument/man/print.id.list.Rd 2011-09-11 20:33:52 UTC (rev 771)
@@ -0,0 +1,11 @@
+\name{print.id.list}
+\alias{print.id.list}
+\title{id.list class print method}
+\usage{
+ \method{print}{id.list} (x, ...)
+}
+\description{
+ id.list class print method
+}
+\keyword{internal}
+
Added: pkg/FinancialInstrument/man/print.suffix.list.Rd
===================================================================
--- pkg/FinancialInstrument/man/print.suffix.list.Rd (rev 0)
+++ pkg/FinancialInstrument/man/print.suffix.list.Rd 2011-09-11 20:33:52 UTC (rev 771)
@@ -0,0 +1,11 @@
+\name{print.suffix.list}
+\alias{print.suffix.list}
+\title{suffix.list class print method}
+\usage{
+ \method{print}{suffix.list} (x, ...)
+}
+\description{
+ suffix.list class print method
+}
+\keyword{internal}
+
Added: pkg/FinancialInstrument/sandbox/download.tblox.R
===================================================================
--- pkg/FinancialInstrument/sandbox/download.tblox.R (rev 0)
+++ pkg/FinancialInstrument/sandbox/download.tblox.R 2011-09-11 20:33:52 UTC (rev 771)
@@ -0,0 +1,182 @@
+# Daily historical futures data for 40 products since 1995.
+
+library(FinancialInstrument)
+
+#' get historical futures data from tradingblox.com
+#'
+#' \code{get_tblox} will download all data available from tradingblox.
+#' \code{getSymbols.tblox} will only return the Symbols you ask for.
+get_tblox <- function(env='.GlobalEnv') {
+# a function to download all data for all 40 instruments
+ tmp <- tempfile()
+ download.file("http://www.tradingblox.com/Data/DataOnly.zip",tmp)
+ tblox.tmp <- tempdir()
+ unzip(tmp,exdir=tblox.tmp)
+ def <- read.csv('http://www.tradingblox.com/tradingblox/CSIUA/FuturesInfo.txt',skip=1,header=FALSE)
+ for (i in 1:length(def[,1])){
+ if (file.exists(paste(tblox.tmp,'Futures',def[i,4],sep='/'))) {
+ dat <-read.csv(paste(tblox.tmp,"/Futures/",def[i,4],sep=""),header=FALSE)
+ idx <- as.Date(dat[,1],format='%Y%m%d')
+ x <- xts(dat[,2:9],order.by=as.Date(paste(dat[,1]),format="%Y%m%d"))
+ cn <- c(paste('Adj',c("Open","High","Low","Close"),sep="."),'Volume','OpInt','ExpMth','Unadj.Close')
+ colnames(x) <- paste(def[i,1],cn,sep=".")
+ assign(paste(def[i,1]), x, pos=env)
+ }
+ }
+ paste(def[,1])
+}
+
+# a getSymbols method to get only the symbols you specify
+# (it still has to download all the data, but will only read/save data for the symbols you specify)
+getSymbols.tblox <-
+function (Symbols, env, return.class = "xts", ...)
+{
+ importDefaults("getSymbols.tblox")
+ this.env <- environment()
+ for (var in names(list(...))) {
+ assign(var, list(...)[[var]], this.env)
+ }
+ default.return.class <- return.class
+ if (missing(verbose))
+ verbose <- FALSE
+ if (missing(auto.assign))
+ auto.assign <- TRUE
+ if (!auto.assign) stop("must use auto.assign=TRUE for src='tblox'")
+ tmp <- tempfile()
+ download.file("http://www.tradingblox.com/Data/DataOnly.zip",tmp)
+ tblox.tmp <- tempdir()
+ unzip(tmp,exdir=tblox.tmp)
+ def <- read.csv('http://www.tradingblox.com/tradingblox/CSIUA/FuturesInfo.txt',skip=1,header=FALSE)
+ if (is.null(Symbols) || is.na(Symbols) || Symbols == "all" || Symbols == "")
+ Symbols <- def
+ sym.out <- NULL
+ for (i in match(Symbols, paste(def[,1])) ){
+ if (file.exists(paste(tblox.tmp,'Futures',def[i,4],sep='/'))) {
+ if (verbose)
+ cat("loading ", Symbols[[i]], ".....")
+ return.class <- getSymbolLookup()[[paste(def[i,1])]]$return.class
+ return.class <- ifelse(is.null(return.class), default.return.class,
+ return.class)
+ dat <-read.csv(paste(tblox.tmp,"/Futures/",def[i,4],sep=""),header=FALSE)
+ fr <- if (verbose)
+ cat("done.\n")
+ idx <- as.Date(dat[,1],format='%Y%m%d')
+ x <- xts(dat[,2:9],order.by=as.Date(paste(dat[,1]),format="%Y%m%d"))
+ cn <- c(paste('Adj',c("Open","High","Low","Close"),sep="."),'Volume','OpInt','ExpMth','Unadj.Close')
+ colnames(x) <- paste(def[i,1],cn,sep=".")
+ x <- quantmod:::convert.time.series(fr = x, return.class = return.class)
+ assign(paste(def[i,1]), x, pos=env)
+ sym.out <- c(sym.out, paste(def[i,1]))
+ }
+ }
+ return(sym.out)
+}
+
+#http://www.tradingblox.com/tradingblox/documentation.htm
+
+#' Define futures with tradingblox data
+#'
+#' Define futures using the tradingblox.com futures dictionary.
+#' @param verbose be verbose?
+#' @return called for side-effect
+#' @author Garrett See
+#' @examples \dontrun{define_futures.tblox()}
+define_futures.tblox <- function(verbose=TRUE){
+# a function to define metadata for all the futures that are available from tblox
+ def <- read.csv('http://www.tradingblox.com/tradingblox/CSIUA/FuturesInfo.txt',skip=1,header=FALSE,stringsAsFactors=FALSE)
+ for (i in 1:length(def[,1])) {
+ ccy <- try(getInstrument(paste(def[i,8]),silent=TRUE),silent=TRUE)
+ if (inherits(ccy, 'try-error') || !inherits(ccy,'currency')) {
+ currency(paste(def[i,8]))
+ if (verbose) warning(paste("Created currency", def[i,8], "because it did not exist."))
+ }
+ tick <- def[i,14]
+ if (length(strsplit(tick,"/")[[1]]) == 2) {
+ numer <- as.numeric(strsplit(tick,"/")[[1]][1])
+ denom <- as.numeric(gsub("h","",strsplit(tick,"/")[[1]][2]))
+ tick <- numer / denom
+ }
+ tmonths <- NULL
+ for (j in 1:nchar(def[i,6])) tmonths <- c(tmonths, substr(def[i,6],j,j))
+ tmonths <- paste(tmonths,collapse=",")
+ #FIXME: How do I turn "FGHJKMNQUVXZ"
+ # into "F,G,H,J,K,M,N,Q,U,V,X,Z"
+ # without using a for loop?
+ primary_id <- paste(def[i,1])
+ instr <- try(getInstrument(primary_id,silent=TRUE),silent=TRUE)
+ if (inherits(instr,'try-error') || !is.instrument(instr)) {
+ future(primary_id = primary_id,
+ currency = paste(def[i,8]),
+ multiplier = as.numeric(gsub(",","",def[i,9])),
+ tick_size = as.numeric(tick),
+ defined.by = 'tblox' )
+ }
+ instr <- getInstrument(primary_id)
+ instr$currency = paste(def[i,8])
+ instr$multiplier = as.numeric(gsub(",","",def[i,9]))
+ instr$tick_size = as.numeric(tick)
+ instr$identifiers = NULL
+ instr$description = paste(def[i,2])
+ instr$exchange = paste(def[i,5])
+ #instr$TradingMonths = tmonths
+ instr$month_cycle = tmonths
+ instr$ContractSize = paste(def[i,7])
+ instr$Margin = as.numeric(gsub(",","",def[i,10]))
+ instr$ProductGroup = paste(def[i,17])
+ instr$DisplayDigits = paste(def[i,21])
+ if (is.null(instr$defined.by)) instr$defined.by <- 'tblox'
+ if(instr$defined.by != 'tblox')
+ instr$defined.by <- paste(c(instr$defined.by, "tblox"), collapse = ";")
+ instr$updated <- Sys.time()
+ assign(primary_id, instr, pos=.instrument)
+ }
+}
+
+#define_futures.tblox()
+
+#1: symbol
+#2: description <- c(description, description)
+#5: exchange
+#6: TradingMonths
+#7: ContractSize
+#8: currency
+#9: BigPoint Value of a 1.0 movement
+#10: Margin
+#11: CloseCorrel
+#12: LooseCorrel
+
+#14: tick_unit
+#15: minimum_tick
+#17: Group
+#21: DisplayDigits
+
+
+#' remove all but adjusted OHLC columns from tblox data
+#' @param env environment that holds tblox data
+#' @return called for side-effect.
+#' @note must have called define_futures.tblox first
+#' @examples
+#' \dontrun{
+#' get_tblox()
+#' define_futures.tblox()
+#' reformat_tblox()
+#' }
+reformat_tblox <- function(symbols, env=.GlobalEnv) {
+ f <- function(x){
+ nx <- try(get(x,pos=env),silent=TRUE)
+ if (!inherits(nx,'try-error')) {
+ nx <- nx[,1:5]
+ colnames(nx) <- paste(x,c("Open","High","Low","Adjusted.Close","Volume"),sep=".")
+ assign(x,nx,pos=env)
+ }
+ }
+ syms <- if(missing(symbols) || is.null(symbols)) {
+ if (!require('twsInstrument')) stop('symbols must be supplied if twsInstrument package is not installed.')
+ ls_instruments_by("defined.by","tblox")
+ } else symbols
+ lapply(syms, FUN=f)
+ syms
+}
+
+
+
Property changes on: pkg/FinancialInstrument/sandbox/download.tblox.R
___________________________________________________________________
Added: svn:executable
+ *
More information about the Blotter-commits
mailing list