[Blotter-commits] r1071 - in pkg/FinancialInstrument: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 25 17:23:47 CEST 2012
Author: gsee
Date: 2012-06-25 17:23:47 +0200 (Mon, 25 Jun 2012)
New Revision: 1071
Added:
pkg/FinancialInstrument/R/FindCommonInstrumentAttributes.R
pkg/FinancialInstrument/R/Notionalize.R
pkg/FinancialInstrument/R/getSymbols.FIpar.R
pkg/FinancialInstrument/R/update_instruments.iShares.R
pkg/FinancialInstrument/R/update_instruments.morningstar.R
pkg/FinancialInstrument/man/FindCommonInstrumentAttributes.Rd
pkg/FinancialInstrument/man/Notionalize.Rd
pkg/FinancialInstrument/man/getSymbols.FIpar.Rd
pkg/FinancialInstrument/man/update_instruments.iShares.Rd
pkg/FinancialInstrument/man/update_instruments.morningstar.Rd
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/NAMESPACE
Log:
Move some functions from (private) package:gsee
- getSymbols.FIpar (same as getSymbols.FI, but will run in parallel if a foreach backend has been registered)
- update_instruments.morningstar
- update_instruments.iShares
- FindCommonInstrumentAttributes
- Notionalize and Denotionalize
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2012-06-25 04:18:44 UTC (rev 1070)
+++ pkg/FinancialInstrument/DESCRIPTION 2012-06-25 15:23:47 UTC (rev 1071)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.14.8
+Version: 0.15.0
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
@@ -19,7 +19,8 @@
quantmod(>= 0.3-17),
zoo(>= 1.7-5)
Suggests:
- foreach
+ foreach,
+ XML
Collate:
'buildHierarchy.R'
'buildSpread.R'
@@ -50,3 +51,8 @@
'expires.R'
'find.instrument.R'
'FinancialInstrument-package.R'
+ 'FindCommonInstrumentAttributes.R'
+ 'getSymbols.FIpar.R'
+ 'Notionalize.R'
+ 'update_instruments.iShares.R'
+ 'update_instruments.morningstar.R'
Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE 2012-06-25 04:18:44 UTC (rev 1070)
+++ pkg/FinancialInstrument/NAMESPACE 2012-06-25 15:23:47 UTC (rev 1071)
@@ -1,17 +1,17 @@
-export(.to_daily)
export(add.defined.by)
export(add.identifier)
+export(bond)
export(bond_series)
-export(bond)
-export(build_series_symbols)
-export(build_spread_symbols)
export(buildBasket)
export(buildHierarchy)
export(buildRatio)
+export(build_series_symbols)
export(buildSpread)
+export(build_spread_symbols)
export(butterfly)
export(C2M)
export(currency)
+export(Denotionalize)
export(exchange_rate)
export(expires)
export(find.instrument)
@@ -19,21 +19,22 @@
export(format_id)
export(formatSpreadPrice)
export(fund)
+export(future)
export(future_series)
-export(future)
export(getInstrument)
export(getSymbols.FI)
+export(getSymbols.FIpar)
export(guaranteed_spread)
+export(ICS)
export(ICS_root)
-export(ICS)
+export(instrument)
export(instrument_attr)
export(instrument.auto)
export(instrument.table)
-export(instrument)
+export(is.currency)
export(is.currency.name)
-export(is.currency)
+export(is.instrument)
export(is.instrument.name)
-export(is.instrument)
export(load.instruments)
export(loadInstruments)
export(ls_AUD)
@@ -50,22 +51,22 @@
export(ls_expires)
export(ls_expiries)
export(ls_funds)
+export(ls_futures)
export(ls_future_series)
-export(ls_futures)
export(ls_FX)
export(ls_GBP)
export(ls_guaranteed_spreads)
export(ls_HKD)
+export(ls_ICS)
export(ls_ICS_roots)
-export(ls_ICS)
+export(ls_instruments)
export(ls_instruments_by)
-export(ls_instruments)
export(ls_JPY)
export(ls_non_currencies)
export(ls_non_derivatives)
export(ls_NZD)
+export(ls_options)
export(ls_option_series)
-export(ls_options)
export(ls_puts)
export(ls_SEK)
export(ls_spreads)
@@ -79,9 +80,10 @@
export(MC2N)
export(month_cycle2numeric)
export(next.future_id)
+export(Notionalize)
+export(option)
+export(option_series)
export(option_series.yahoo)
-export(option_series)
-export(option)
export(parse_id)
export(parse_suffix)
export(prev.future_id)
@@ -94,12 +96,12 @@
export(rm_derivatives)
export(rm_exchange_rates)
export(rm_funds)
+export(rm_futures)
export(rm_future_series)
-export(rm_futures)
export(rm_instruments)
export(rm_non_derivatives)
+export(rm_options)
export(rm_option_series)
-export(rm_options)
export(rm_spreads)
export(rm_stocks)
export(rm_synthetics)
@@ -110,13 +112,18 @@
export(sort_ids)
export(spread)
export(stock)
+export(synthetic)
export(synthetic.instrument)
export(synthetic.ratio)
-export(synthetic)
+export(.to_daily)
export(to_secBATV)
export(update_instruments.instrument)
+export(update_instruments.iShares)
export(update_instruments.masterDATA)
export(update_instruments.md)
+export(update_instruments.morningstar)
+export(update_instruments.ms)
+export(update_instruments.SPDR)
export(update_instruments.TTR)
export(update_instruments.yahoo)
export(volep)
Added: pkg/FinancialInstrument/R/FindCommonInstrumentAttributes.R
===================================================================
--- pkg/FinancialInstrument/R/FindCommonInstrumentAttributes.R (rev 0)
+++ pkg/FinancialInstrument/R/FindCommonInstrumentAttributes.R 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,25 @@
+#' Find attributes that more than one instrument have in common
+#' @param Symbols character vector of primary_ids of instruments
+#' @param \dots arguments to pass to
+#' \code{\link[FinancialInstrument]{getInstrument}}
+#' @return character vector of names of attributes that all \code{Symbols}'
+#' instruments have in common
+#' @author gsee
+#' @note I really do not like the name of this function, so if it survives, its
+#' name may change
+#' @examples
+#' \dontrun{
+#' ibak <- as.list(FinancialInstrument:::.instrument, all.names=TRUE)
+#' Symbols <- c("SPY", "AAPL")
+#' define_stocks(Symbols, addIBslot=FALSE)
+#' update_instruments.SPDR("SPY")
+#' update_instruments.TTR("AAPL", exchange="NASDAQ")
+#' FindCommonInstrumentAttributes(Symbols)
+#' FindCommonInstrumentAttributes(c(Symbols, "USD"))
+#' reloadInstruments(ibak)
+#' }
+FindCommonInstrumentAttributes <- function(Symbols, ...) {
+ i <- lapply(Symbols, getInstrument, ...)
+ n <- lapply(i, names)
+ Reduce(intersect, n)
+}
Added: pkg/FinancialInstrument/R/Notionalize.R
===================================================================
--- pkg/FinancialInstrument/R/Notionalize.R (rev 0)
+++ pkg/FinancialInstrument/R/Notionalize.R 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,92 @@
+#' Convert price series to/from notional value
+#'
+#' \code{Notionalize} multiplies all prices by the contract multiplier
+#' \code{Denotionalize} divides all prices by the contract multiplier
+#'
+#' The mulitplier is only applied to columns with prices. A column is
+#' considered to be a price column if its name contains \dQuote{Open},
+#' \dQuote{High}, \dQuote{Low}, \dQuote{Close}, \dQuote{Bid}, \dQuote{Ask},
+#' \dQuote{Trade}, \dQuote{Mid}, or \dQuote{Price} and does not contain
+#' \dQuote{Size}, \dQuote{Sz}, \dQuote{Volume}, \dQuote{Qty},
+#' \dQuote{Quantity}, \dQuote{OpInt}, \dQuote{OpenInterest}
+#' (not case-sensitive)
+#' @param x an xts object, or an object that is coercible to xts
+#' @param name primary_id of the instrument that has the multiplier;
+#' usually the same as the name of \code{x}
+#' @param env environment. where to find \code{x} if only its name is provided
+#' @return an object of the same class as \code{x}
+#' @author Garrett See
+#' @examples
+#' \dontrun{
+#' source("http://tinyurl.com/download-tblox")
+#' getSymbols("CL", src='tblox')
+#' define_futures.tblox()
+#' tail(Notionalize(CL, "CL"))
+#' tail(Denotionalize(Notionalize(CL), "CL"))
+#' }
+#' @export
+#' @rdname Notionalize
+Notionalize <- function(x, name, env=.GlobalEnv) {
+ if (missing(name)) {
+ name <- if (!is.character(x)) {
+ deparse(substitute(x))
+ } else x
+ }
+ stopifnot(is.instrument.name(name))
+ if (is.character(x)) x <- get(x, pos=env)
+ xx <- try.xts(x)
+ if (isTRUE(attr(x, "notional"))) {
+ # at the end of this function, x is given a "notional" attr with a
+ # value of TRUE. Check here. If there is a "notional" attr that is
+ # TRUE, then this data has already been notionalized
+ warning(paste(name, 'has already been notionalized.',
+ 'Set attr(, "notional") to FALSE to allow notionalizing again. \n'))
+ return(x)
+ }
+ # Only add dividends to Open, High, Low, Close, Bid, Ask,
+ # Trade, Mid, Price
+ cn <- grep("Open|High|Low|Close|Bid|Ask|Trade|Mid|Price", colnames(x),
+ ignore.case=TRUE)
+ sz <- grep("Size|Sz|Volume|Qty|Quantity|OpenInterest|OpInt", colnames(x),
+ ignore.case=TRUE)
+ cn <- cn[!cn %in% sz]
+ # we'll get a warning if cn is all columns, or no columns; suppress it
+ out <- suppressWarnings(cbind(sweep(x[, cn], 1,
+ as.numeric(getInstrument(name)$multiplier), "*"), x[, -cn]))
+ # set a flag so that if this function is called
+ # again, it will not try to notionalize something
+ # that has already been notionalized.
+ attr(x, 'notional') <- TRUE
+ reclass(out[, colnames(x)], x) # put back in original order and reclass
+}
+
+
+#' @export
+#' @rdname Notionalize
+Denotionalize <- function(x, name, env=.GlobalEnv) {
+ if (missing(name)) {
+ name <- if (!is.character(x)) {
+ deparse(substitute(x))
+ } else x
+ }
+ stopifnot(is.instrument.name(name))
+ if (is.character(x)) x <- get(x, pos=env)
+ xx <- try.xts(x)
+ if (!isTRUE(attr(x, "notional"))) {
+ warning(paste(name, 'is not notional. Nothing to do.\n'))
+ return(x)
+ }
+ # Only add dividends to Open, High, Low, Close, Bid, Ask,
+ # Trade, Mid, Price
+ cn <- grep("Open|High|Low|Close|Bid|Ask|Trade|Mid|Price", colnames(x),
+ ignore.case=TRUE)
+ sz <- grep("Size|Sz|Volume|Qty|Quantity|OpenInterest|OpInt", colnames(x),
+ ignore.case=TRUE)
+ cn <- cn[!cn %in% sz]
+ # we'll get a warning if cn is all columns, or no columns; suppress it
+ out <- suppressWarnings(cbind(sweep(x[, cn], 1,
+ as.numeric(getInstrument(name)$multiplier), "/"), x[, -cn]))
+ attr(x, 'notional') <- FALSE
+ reclass(out[, colnames(x)], x) # put back in original order and reclass
+}
+
Added: pkg/FinancialInstrument/R/getSymbols.FIpar.R
===================================================================
--- pkg/FinancialInstrument/R/getSymbols.FIpar.R (rev 0)
+++ pkg/FinancialInstrument/R/getSymbols.FIpar.R 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,265 @@
+#' getSymbols method for loading data from split files
+#'
+#' This is \code{\link[FinancialInstrument]{getSymbols.FI}} adapted to use
+#' \code{foreach}. If a parallel backend has been registered (with, e.g.
+#' \code{doMC:::registerDoMC} or \code{doSMP:::registerDoSMP},) it will get multiple symbols
+#' in parallel.
+#'
+#' Meant to be called internally by \code{\link[quantmod]{getSymbols}} .
+#'
+#' If date_format is NULL (the Default), we will assume an ISO date as changed by \code{\link{make.names}},
+#' for example, 2010-12-01 would be assumed to be a file containing 2010.12.01
+#'
+#' If auto.assign is FALSE, you'll only get the last Symbol in the symbols list returned,
+#' so only use \code{auto.assign=FALSE} with a single symbol. Patches Welcome.
+#'
+#' @param Symbols a character vector specifying the names of each symbol to be loaded
+#' @param from Retrieve data no earlier than this date. Default '2010-01-01'.
+#' @param to Retrieve data through this date. Default Sys.Date().
+#' @param ... any other passthru parameters
+#' @param dir if not specified in getSymbolLookup, directory string to use. default ""
+#' @param return.class only "xts" is currently supported
+#' @param extension file extension, default "rda"
+#' @param split_method string specifying the method used to split the files, currently \sQuote{days}
+#' or \sQuote{common}, see \code{\link[FinancialInstrument]{setSymbolLookup.FI}}
+#' @param use_identifier optional. identifier used to construct the \code{primary_id} of the instrument.
+#' If you use this, you must have previously defined the \code{\link[FinancialInstrument]{instrument}}
+#' @param date_format format as per the \code{\link{strptime}}, see Details
+#' @param verbose TRUE/FALSE
+#' @param days_to_omit character vector of names of weekdays that should not be loaded.
+#' Default is \code{c("Saturday", "Sunday")}. Use \code{NULL} to attempt to load data
+#' for all days of the week.
+#' @param indexTZ valid TZ string. (e.g. \dQuote{America/Chicago} or \dQuote{America/New_York})
+#' See \code{\link[xts]{indexTZ}}.
+#' @param timespan xts-style intraday subsetting string. e.g. \dQuote{T08:30:00/T15:00:00}.
+#' If \code{indexTZ} is provided, timezone conversion will occur before
+#' the time of day subsetting. \code{timespan} is only used if
+#' \code{split_method} is \dQuote{days}.
+#' @seealso
+#' \code{\link[quantmod]{getSymbols}}
+#' \code{\link{getSymbols.FI}}
+#' \code{\link[FinancialInstrument]{saveSymbols.days}}
+#' \code{\link[FinancialInstrument]{instrument}}
+#' \code{\link[FinancialInstrument]{setSymbolLookup.FI}}
+#' \code{\link[FinancialInstrument]{load.instruments}}
+#' \code{\link[quantmod]{getSymbols}}
+#' @export
+getSymbols.FIpar <- function(Symbols,
+ from='2010-01-01',
+ to=Sys.Date(),
+ ...,
+ dir="",
+ return.class="xts",
+ extension="rda",
+ split_method = c("days", "common"),
+ use_identifier = NA,
+ date_format=NULL,
+ verbose=TRUE,
+ days_to_omit=c("Saturday", "Sunday"),
+ indexTZ,
+ timespan
+ )
+{
+ require(foreach)
+ if (is.null(date_format)) date_format <- "%Y.%m.%d"
+ if (is.null(days_to_omit)) days_to_omit <- 'NULL'
+ importDefaults("getSymbols.FIpar")
+ this.env <- environment()
+ for(var in names(list(...))) {
+ assign(var,list(...)[[var]], this.env)
+ }
+
+ #The body of the following function comes from Dominik's answer here:
+ #browseURL{"http://stackoverflow.com/questions/7224938/can-i-rbind-be-parallelized-in-r"}
+ #it does what do.call(rbind, lst) would do, but faster and with less memory usage
+ do.call.rbind <- function(lst) {
+ while(length(lst) > 1) {
+ idxlst <- seq(from=1, to=length(lst), by=2)
+
+ lst <- lapply(idxlst, function(i) {
+ if(i==length(lst)) { return(lst[[i]]) }
+
+ return(rbind(lst[[i]], lst[[i+1]]))
+ })
+ }
+ lst[[1]]
+ }
+
+ # Find out if user provided a value for each formal
+ hasArg.from <- hasArg(from)
+ hasArg.to <- hasArg(to)
+ hasArg.dir <- hasArg(dir)
+ hasArg.return.class <- hasArg(return.class)
+ hasArg.extension <- hasArg(extension)
+ hasArg.split_method <- hasArg(split_method)
+ hasArg.use_identifier <- hasArg(use_identifier)
+ hasArg.date_format <- hasArg(date_format)
+ hasArg.verbose <- hasArg(verbose)
+ hasArg.days_to_omit <- hasArg(days_to_omit)
+ hasArg.indexTZ <- hasArg(indexTZ)
+ hasArg.timespan <- hasArg(timespan)
+
+ # Now get the values for each formal that we'll use if not provided
+ # by the user and not found in the SymbolLookup table
+ default.from <- from
+ default.to <- to
+ default.dir <- dir
+ default.return.class <- return.class
+ default.extension <- extension
+ default.split_method <- split_method[1]
+ default.use_identifier <- use_identifier
+ default.date_format <- date_format
+ default.verbose <- verbose
+ default.days_to_omit <- days_to_omit
+ default.indexTZ <- if (hasArg.indexTZ) {
+ default.indexTZ <- indexTZ
+ } else NA
+ default.timespan <- if (hasArg.timespan) {
+ default.timespan <- timespan
+ } else ""
+
+
+ # quantmod:::getSymbols will provide auto.assign and env
+ # so the next 2 if statements should always be TRUE
+ auto.assign <- if(hasArg(auto.assign)) {auto.assign} else TRUE
+ env <- if(hasArg(env)) {env} else .GlobalEnv
+
+ # make an argument matching function to sort out which values to use for each arg
+ pickArg <- function(x, Symbol) {
+ if(get(paste('hasArg', x, sep="."))) {
+ get(x)
+ } else if(!is.null(SymbolLookup[[Symbol]][[x]])) {
+ SymbolLookup[[Symbol]][[x]]
+ } else get(paste("default", x, sep="."))
+ }
+
+ SymbolLookup <- getSymbolLookup()
+ i <- NULL
+ fr<-NULL
+ datl <- foreach(i = icount(length(Symbols))) %dopar% {
+ dir <- default.dir # I don't know why I have to do this!!!
+# timespan <- default.timespan
+ from <- pickArg("from", Symbols[[i]])
+ to <- pickArg("to", Symbols[[i]])
+ dir <- pickArg("dir", Symbols[[i]])
+ return.class <- pickArg("return.class", Symbols[[i]])
+ extension <- pickArg('extension', Symbols[[i]])
+ split_method <- pickArg('split_method', Symbols[[i]])
+ use_identifier <- pickArg('use_identifier', Symbols[[i]])
+ date_format <- pickArg('date_format', Symbols[[i]])
+ verbose <- pickArg('verbose', Symbols[[i]])
+ days_to_omit <- pickArg('days_to_omit', Symbols[[i]])
+ indexTZ <- pickArg('indexTZ', Symbols[[i]])
+ timespan <- pickArg('timespan', Symbols[[i]])
+ # if 'dir' is actually the 'base_dir' then we'll paste the instrument name (Symbol) to the end of it.
+ # First, find out what the instrument name is
+ instr_str <- NA
+ if(!is.na(use_identifier)) {
+ tmp_instr <- try(getInstrument(Symbols[[i]], silent=FALSE))
+ if (inherits(tmp_instr,'try-error') || !is.instrument(tmp_instr))
+ stop("must define instrument first to call with 'use_identifier'")
+ if (!use_identifier=='primary_id') {
+ instr_str<-make.names(tmp_instr$identifiers[[use_identifier]])
+ } else instr_str <- make.names(tmp_instr[[use_identifier]])
+ }
+ Symbol <- ifelse(is.na(instr_str), make.names(Symbols[[i]]), instr_str)
+ ndc<-nchar(dir)
+ if(substr(dir,ndc,ndc)=='/') dir <- substr(dir,1,ndc-1) #remove trailing forward slash
+ ssd <- strsplit(dir,"/")[[1]]
+ if (identical(character(0), ssd) || (!identical(character(0), ssd) && ssd[length(ssd)] != Symbol)) dir <- paste(dir,Symbol,sep="/")
+
+ if(!dir=="" && !file.exists(dir)) {
+ if (verbose) cat("\ndirectory ",dir," does not exist, skipping\n")
+ } else {
+ if(verbose) cat("loading ",Symbols[[i]],".....\n")
+ switch(split_method[1],
+ days={
+ StartDate <- as.Date(from)
+ EndDate <- as.Date(to)
+ date.vec <- as.Date(StartDate:EndDate)
+ date.vec <- date.vec[!weekdays(date.vec) %in% days_to_omit]
+ date.vec <- format(date.vec, format=date_format)
+ sym.files <- paste(date.vec, Symbol, extension, sep=".")
+ if (dir != "") sym.files <- file.path(dir, sym.files)
+ tmpenv <- new.env()
+ dl <- lapply(sym.files, function(fp) {
+ sf <- strsplit(fp, "/")[[1]]
+ sf <- sf[length(sf)]
+ if (verbose) cat('Reading ', sf, '...')
+ if (!file.exists(fp)) {
+ if (verbose) cat(' failed. File not found in ', dir, ' ... skipping\n')
+ } else {
+ if(verbose) cat(' done.\n')
+ local.name <- load(fp)
+ #as.zoo(get(local.name))
+ dat <- get(local.name)
+ if (!is.na(indexTZ) && !is.null(dat)) indexTZ(dat) <- indexTZ
+ dat[timespan]
+ }
+ })
+ if (verbose) cat('rbinding data ... \n')
+ fr <- do.call.rbind(dl)
+ #fr <- do.call(rbind, dl)
+ #fr <- as.xts(fr)
+ },
+ common = , {
+ sym.file <- paste(Symbol,extension,sep=".")
+ if(dir != "") sym.file <- file.path(dir, sym.file)
+ if(!file.exists(sym.file)) {
+ if (verbose) cat("file ",paste(Symbol,extension,sep='.')," does not exist in ",dir,"....skipping\n")
+ } else {
+ #fr <- read.csv(sym.file)
+ local.name <- load(sym.file)
+ dat <- get(local.name)
+ if (!is.na(indexTZ) && !is.null(dat)) indexTZ(dat) <- indexTZ
+ assign('fr', dat[timespan])
+ if(verbose) cat("done.\n")
+ #if(!is.xts(fr)) fr <- xts(fr[,-1],as.Date(fr[,1],origin='1970-01-01'),src='rda',updated=Sys.time())
+ }
+ } # end 'common'/default method (same as getSymbols.rda)
+ ) # end split_method switch
+ # if each file has a different value for an xtsAttribute, only the most recent is used, so fix them here
+# if (!is.null(xtsAttributes(fr)$from))
+# xtsAttributes(fr)$from <- from
+# if (!is.null(xtsAttributes(fr)$to))
+# xtsAttributes(fr)$to <- to
+ fr <- quantmod:::convert.time.series(fr=fr,return.class=return.class)
+ #if (!is.na(indexTZ)) indexTZ(fr) <- indexTZ
+ Symbols[[i]] <-make.names(Symbols[[i]])
+ tmp <- list()
+ tmp[[Symbols[[i]]]] <- fr
+ if(verbose) cat("done.\n")
+ tmp
+ }
+ } #end loop over Symbols
+
+ if (length(Filter("+", lapply(datl, length))) == 0) {
+ warning("No data found.")
+ return(NULL)
+ }
+
+ datl.names <- do.call(c, lapply(datl, names))
+ missing <- Symbols[!Symbols %in% datl.names]
+ if (length(missing) > 0) warning(paste('No data found for', missing))
+ if(auto.assign) {
+ #invisible(lapply(datl, function(x) if (length(x) > 0) assign(names(x), x[[1]], pos=env)))
+ out <- Filter(function(x) length(x) > 0, datl)
+ invisible(lapply(out, function(x) assign(names(x), x[[1]], pos=env)))
+ return(datl.names)
+ } else {
+ #NOTE: Currently, NULLs aren't filtered out. If there are data for any Symbol,
+ # the returned list will have an element for each symbol requested even if some don't contain data.
+ out <- lapply(datl, function(x) {
+ if (length(x) > 0) x[[1]]
+ })
+ if (length(out) == 1)
+ return(out[[1]])
+ else {
+ # Filter(function(x) dim(x)[1] > 0, out)
+ names(out) <- Symbols
+ return(out)
+ }
+ }
+
+}
+
Added: pkg/FinancialInstrument/R/update_instruments.iShares.R
===================================================================
--- pkg/FinancialInstrument/R/update_instruments.iShares.R (rev 0)
+++ pkg/FinancialInstrument/R/update_instruments.iShares.R 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,112 @@
+#' update iShares and SPDR ETF metadata
+#'
+#' This will update previously defined iShares or SPDR ETF \code{instrument}s.
+#' Both functions will add attributes for \dQuote{Name}, and \dQuote{FundFamily}
+#' (\dQuote{iShares} or \dQuote{SPDR}). \code{update_instruments.iShares} will
+#' also add an attribute for \dQuote{MgmtFees}
+#'
+#' @param Symbols character vector of iShares ETF ticker symbols. If not
+#' specified, \code{unique(c(ls_funds(), ls_stocks()))} will be used.
+#' @param silent silence the warning that no iShares are defined?
+#' @return called for side-effect
+#' @author Garrett See
+#' @seealso \code{update_instruments.yahoo}, \code{update_instruments.TTR},
+#' \code{twsInstrument:::update_instruments.IB},
+#' \code{update_instruments.instrument}
+#' @note \code{update_instruments.SPDR} will probably NOT work on Windows. It
+#' has to download for an https URL scheme, and it uses \code{method=curl}
+#' in \code{download.file} to do so.
+#' @references \url{http://us.ishares.com/home.htm},
+#' \url{https://www.spdrs.com/}
+#' @examples
+#' \dontrun{
+#' stock("IWC", currency("USD"))
+#' update_instruments.iShares("IWC")
+#' getInstrument("IWC")
+#'
+#' Symbols <- stock(c("SPY", "JNK"), currency("USD"))
+#' update_instruments.SPDR(Symbols)
+#' buildHierarchy(c("SPY", "JNK"), "Name")
+#' }
+#' @export
+#' @rdname update_instruments.iShares
+update_instruments.iShares <- function(Symbols, silent=FALSE) {
+ tmp <- tempfile()
+ lnk <- paste0("http://us.ishares.com/product_info/fund/excel_returns.htm",
+ "?assetClassCd=EQ&ticker=&asofDt=")
+ download.file(lnk, destfile=tmp)
+ fr <- read.csv(tmp, skip=3, stringsAsFactors=FALSE, header=FALSE)
+ colnames(fr) <- read.delim(text=readLines(tmp, 1), sep=",", header=FALSE,
+ stringsAsFactors=FALSE)
+ unlink(tmp)
+ tickers <- fr[["Ticker"]]
+ if (missing(Symbols)) {
+ Symbols <- unique(c(ls_funds(), ls_stocks()))
+ }
+ s <- Symbols[Symbols %in% tickers]
+ if (length(s) == 0) {
+ if (!isTRUE(silent)) {
+ warning('iShares must be defined before this can update them.')
+ }
+ return(invisible())
+ }
+ dat <- fr[fr$Ticker %in% s, ]
+ for(i in seq_len(NROW(dat))) {
+ instrument_attr(dat[i, "Ticker"], "MgmtFees", dat[i, "Mgmt Fees"])
+ instrument_attr(dat[i, "Ticker"], "Name", dat[i, "iShares Fund Name"])
+ instrument_attr(dat[i, "Ticker"], "FundFamily", "iShares")
+ }
+ invisible(lapply(s, function(x) {
+ db <- getInstrument(x)[["defined.by"]]
+ db <- if (is.null(db)) {
+ "iShares"
+ } else paste(unique(c(strsplit(db, ";")[[1]],
+ "iShares")), collapse=";")
+ instrument_attr(x, "defined.by", db)
+ instrument_attr(x, "updated", Sys.time())
+ }))
+ return(s)
+}
+
+
+#' @export
+#' @rdname update_instruments.iShares
+update_instruments.SPDR <- function(Symbols, silent=FALSE) {
+ tmp <- tempfile()
+ lnk <- paste0("https://www.spdrs.com/library-content/public/public-files/etf",
+ "nav.csv?docname=Most+Recent+Net+Asset+Values&onyx_code1=1299")
+ download.file(lnk, destfile=tmp, method="curl")
+ fr <- read.csv(tmp, skip=1, stringsAsFactors=FALSE)
+ DATE <- gsub(" ", "", sub("DATE,", "", readLines(tmp, 1)))
+ unlink(tmp)
+ tickers <- fr[["TICKER"]] <- gsub("^\\s+|\\s+$", "", fr[["TICKER"]])
+ if (missing(Symbols)) {
+ Symbols <- unique(c(ls_funds(), ls_stocks()))
+ }
+ s <- Symbols[Symbols %in% tickers]
+ if (length(s) == 0) {
+ if (!isTRUE(silent)) {
+ warning('instruments must be defined before this can update them.')
+ }
+ return(invisible())
+ }
+ dat <- fr[fr[["TICKER"]] %in% s, ]
+ for (i in seq_len(NROW(dat))) {
+ instrument_attr(dat[i, "TICKER"], "Name",
+ gsub("^\\s+|\\s+$", "", dat[i, "NAME"]))
+ instrument_attr(dat[i, "TICKER"], "FundFamily", "SPDR")
+ add.identifier(dat[i, "TICKER"],
+ SPDR=gsub("^\\s+|\\s+$", "", dat[i, "FUND"]))
+ add.identifier(dat[i, "TICKER"], CUSIP=gsub("\'", "", fr[i, "CUSIP"]))
+ }
+ invisible(lapply(s, function(x) {
+ db <- getInstrument(x)[["defined.by"]]
+ db <- if (is.null(db)) {
+ "SPDR"
+ } else paste(unique(c(strsplit(db, ";")[[1]], "SPDR")), collapse=";")
+ instrument_attr(x, "defined.by", db)
+ instrument_attr(x, "updated", Sys.time())
+ }))
+ return(s)
+}
+
Added: pkg/FinancialInstrument/R/update_instruments.morningstar.R
===================================================================
--- pkg/FinancialInstrument/R/update_instruments.morningstar.R (rev 0)
+++ pkg/FinancialInstrument/R/update_instruments.morningstar.R 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,71 @@
+#' Update instrument metadata for ETFs
+#'
+#' Currently, this only updates ETFs. It will add \dQuote{msName} and
+#' \dQuote{msCategory} attributes to the instruments. (ms for morningstar)
+#' @param Symbols character vector of Symbols of ETFs
+#' @param silent silence warnings?
+#' @return called for side-effect.
+#' @author Garrett See
+#' @references \url{http://www.morningstar.com}
+#' @seealso \code{\link{update_instruments.yahoo}},
+#' \code{\link{update_instruments.TTR}}
+#' \code{\link{update_instruments.iShares}}
+#' @examples
+#' \dontrun{
+#' ## backup .instrument environment
+#' ibak <- as.list(FinancialInstrument:::.instrument)
+#' rm_instruments()
+#' stock(s <- c("SPY", "USO", "LQD"), currency("USD"))
+#' update_instruments.morningstar(s)
+#' instrument.table(s)
+#' ## cleanup and restore instrument environment
+#' rm_instruments(keep.currencies=FALSE)
+#' loadInstruments(ibak)
+#' }
+#' @export
+update_instruments.morningstar <- function(Symbols, silent=FALSE) {
+ require(XML)
+ x <- readHTMLTable(paste("http://news.morningstar.com/etf/Lists/ETFReturn",
+ "s.html?topNum=All&lastRecNum=1000&curField=8&ca",
+ "tegory=0", sep=""), stringsAsFactors=FALSE)[[4L]]
+ colnames(x) <- x[2, ]
+ x <- x[-c(1:3), -1]
+ x <- x[!is.na(x[, 1]), ]
+ x <- x[!duplicated(x[, 1]), ]
+ tickers <- gsub(".*\\(|*\\)", "", x[,1])
+ rownames(x) <- tickers
+ if (missing(Symbols)) {
+ Symbols <- unique(c(ls_funds(), ls_stocks()))
+ }
+ s <- Symbols[Symbols %in% tickers]
+ if (length(s) > 0) {
+ # only those that inherit stock or fund
+ s <- s[sapply(lapply(s, getInstrument, type=c("stock", "fund"),
+ silent = TRUE), is.instrument)]
+ }
+ if (length(s) == 0) {
+ if (!isTRUE(silent)) {
+ warning("instruments must be defined before this can update them.")
+ }
+ return(invisible())
+ }
+ x <- x[rownames(x) %in% s, ]
+ rn <- rownames(x)
+ for (i in 1:NROW(x)) {
+ instrument_attr(rn[i], "msName", x$Name[i])
+ instrument_attr(rn[i], "msCategory", x$Category[i])
+ #instrument_attr(x$Symbol[i], "msTradingVolume",
+ # as.numeric(gsub(",", "", x$TradingVolume[i])))
+ db <- getInstrument(rn[i])$defined.by
+ instrument_attr(rn[i], "defined.by", paste(c(db, "morningstar"),
+ collapse=";"))
+ instrument_attr(rn[i], "updated", Sys.time())
+ }
+ return(s)
+}
+
+
+#' @export
+#' @rdname update_instruments.morningstar
+update_instruments.ms <- update_instruments.morningstar
+
Added: pkg/FinancialInstrument/man/FindCommonInstrumentAttributes.Rd
===================================================================
--- pkg/FinancialInstrument/man/FindCommonInstrumentAttributes.Rd (rev 0)
+++ pkg/FinancialInstrument/man/FindCommonInstrumentAttributes.Rd 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,41 @@
+\name{FindCommonInstrumentAttributes}
+\alias{FindCommonInstrumentAttributes}
+\title{Find attributes that more than one instrument have in common}
+\usage{
+ FindCommonInstrumentAttributes(Symbols, ...)
+}
+\arguments{
+ \item{Symbols}{character vector of primary_ids of
+ instruments}
+
+ \item{\dots}{arguments to pass to
+ \code{\link[FinancialInstrument]{getInstrument}}}
+}
+\value{
+ character vector of names of attributes that all
+ \code{Symbols}' instruments have in common
+}
+\description{
+ Find attributes that more than one instrument have in
+ common
+}
+\note{
+ I really do not like the name of this function, so if it
+ survives, its name may change
+}
+\examples{
+\dontrun{
+ibak <- as.list(FinancialInstrument:::.instrument, all.names=TRUE)
+Symbols <- c("SPY", "AAPL")
+define_stocks(Symbols, addIBslot=FALSE)
+update_instruments.SPDR("SPY")
+update_instruments.TTR("AAPL", exchange="NASDAQ")
+FindCommonInstrumentAttributes(Symbols)
+FindCommonInstrumentAttributes(c(Symbols, "USD"))
+reloadInstruments(ibak)
+}
+}
+\author{
+ gsee
+}
+
Added: pkg/FinancialInstrument/man/Notionalize.Rd
===================================================================
--- pkg/FinancialInstrument/man/Notionalize.Rd (rev 0)
+++ pkg/FinancialInstrument/man/Notionalize.Rd 2012-06-25 15:23:47 UTC (rev 1071)
@@ -0,0 +1,50 @@
+\name{Notionalize}
+\alias{Denotionalize}
+\alias{Notionalize}
+\title{Convert price series to/from notional value}
+\usage{
+ Notionalize(x, name, env = .GlobalEnv)
+
+ Denotionalize(x, name, env = .GlobalEnv)
+}
+\arguments{
+ \item{x}{an xts object, or an object that is coercible to
+ xts}
+
+ \item{name}{primary_id of the instrument that has the
+ multiplier; usually the same as the name of \code{x}}
+
+ \item{env}{environment. where to find \code{x} if only
+ its name is provided}
+}
+\value{
+ an object of the same class as \code{x}
+}
+\description{
+ \code{Notionalize} multiplies all prices by the contract
+ multiplier \code{Denotionalize} divides all prices by the
+ contract multiplier
+}
+\details{
+ The mulitplier is only applied to columns with prices. A
+ column is considered to be a price column if its name
+ contains \dQuote{Open}, \dQuote{High}, \dQuote{Low},
+ \dQuote{Close}, \dQuote{Bid}, \dQuote{Ask},
+ \dQuote{Trade}, \dQuote{Mid}, or \dQuote{Price} and does
+ not contain \dQuote{Size}, \dQuote{Sz}, \dQuote{Volume},
+ \dQuote{Qty}, \dQuote{Quantity}, \dQuote{OpInt},
+ \dQuote{OpenInterest} (not case-sensitive)
+}
+\examples{
+\dontrun{
+source("http://tinyurl.com/download-tblox")
+getSymbols("CL", src='tblox')
+define_futures.tblox()
+tail(Notionalize(CL, "CL"))
+tail(Denotionalize(Notionalize(CL), "CL"))
+}
+}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/blotter -r 1071
More information about the Blotter-commits
mailing list