[Blotter-commits] r234 - in pkg/quantstrat: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 7 21:10:36 CET 2010
Author: braverock
Date: 2010-02-07 21:10:35 +0100 (Sun, 07 Feb 2010)
New Revision: 234
Added:
pkg/quantstrat/R/orders.R
pkg/quantstrat/man/addOrder.Rd
pkg/quantstrat/man/getOrderBook.Rd
pkg/quantstrat/man/getOrdersByStatus.Rd
pkg/quantstrat/man/initOrders.Rd
Removed:
pkg/quantstrat/R/traderules.R
Modified:
pkg/quantstrat/NAMESPACE
pkg/quantstrat/R/rules.R
Log:
- initial revision of orders subsystem, incomplete
Modified: pkg/quantstrat/NAMESPACE
===================================================================
--- pkg/quantstrat/NAMESPACE 2010-02-07 16:11:08 UTC (rev 233)
+++ pkg/quantstrat/NAMESPACE 2010-02-07 20:10:35 UTC (rev 234)
@@ -1,6 +1,12 @@
export(add.indicator)
export(applyIndicators)
export(match.names)
+export(getOrderBook)
+export(initOrders)
+export(getOrdersByStatus)
+export(addOrder)
+export(add.rule)
+export(applyRules)
export(add.signal)
export(applySignals)
export(sigComparison)
@@ -11,4 +17,3 @@
export(applyStrategy)
export(is.strategy)
export(getStrategy)
-export(add.rule)
Added: pkg/quantstrat/R/orders.R
===================================================================
--- pkg/quantstrat/R/orders.R (rev 0)
+++ pkg/quantstrat/R/orders.R 2010-02-07 20:10:35 UTC (rev 234)
@@ -0,0 +1,111 @@
+#' get the order book object
+#'
+#' I don't think this should be exported.
+#' @param portfolio text name of the portfolio the order book is associated with
+#' @export
+getOrderBook <- function(portfolio) #should symbol subsets be supported too? probably not.
+{
+ if(!grepl("order_book",portfolio)) orders<-try(get(paste("order_book",portfolio,sep='.'),envir=.strategy))
+ else orders<-try(get(portfolio,envir=.strategy))
+ if(inherits(orders,"try-error"))
+ stop(paste("Orders for ",portfolio," not found, use initOrders() to create a new order book for this portfolio"))
+ if(!inherits(orders,"order_book")) stop("Order Book for portfolio",portfolio,"does not appear to name an order book object.")
+ return(orders)
+}
+
+#' initialize order container
+#'
+#' This function sets up the order container by portfolio.
+#'
+#' If no symbols list is provided (the default) the function will attempt
+#' to retrieve the symbols list from the portfolio in the trade blotter.
+#'
+#' @param portfolio text name of the portfolio to associate the order book with
+#' @param symbols a list of identfiers of the instruments to be contained in the Portfolio. The name of any associated price objects (xts prices, usually OHLC) should match these
+#' @param initDate date (ISO8601) prior to the first close price given in mktdata, used to initialize the order book with a dummy order
+#' @export
+initOrders <- function(portfolio=NULL, symbols=NULL, initDate = '1999-12-31')
+{
+ # NOTE we could stor all of these in one object, but I think that might get big
+ orders<- try(getOrderBook(portfolio))
+ if(inherits(orders,"order_book")) {
+ stop(paste("Order Book for portfolio",portfolio,"already exists."))
+ } else {
+ orders<-list(portfolio=portfolio)
+ }
+ ordertemplate<-xts(c(0,NA,"init","long","closed",as.POSIXct(initDate)),order.by=as.POSIXct(initDate))
+ colnames(ordertemplate) <- c("Order.Qty","Order.Price","Order.Type","Order.Side","Order.Status","Order.StatusTime")
+
+ if(is.null(symbols)) {
+ pfolio<-getPortfolio(portfolio)
+ symbols<-names(pfolio)
+ }
+ if(!is.null(symbols)){
+ for (symbol in symbols){
+ orders[[portfolio]]$symbol <- ordertemplate
+ }
+ } else {
+ stop("You must specify a symbols list or a valid portfolio to retrieve the list from.")
+ }
+ class(orders)<-"order_book"
+ assign(paste("order_book",portfolio,sep='.'),orders,envir=.strategy)
+}
+
+#TODO getOrdersByStatus
+#' get orders by status
+#'
+#' should this be symbols in stead of symbol?
+#' @param portfolio text name of the portfolio to associate the order book with
+#' @param symbol identfier of the instrument to find orders for. The name of any associated price objects (xts prices, usually OHLC) should match these
+#' @param status one of "open", "closed", "canceled", or "replaced"
+#' @param date timestamp coercible to POSIXct that will be the period to find orders of the given status and ordertype
+#' @param ordertype one of "market","limit",or "stop"
+#' @export
+getOrdersByStatus <- function(portfolio,symbol,status="open",date=NULL,ordertype=NULL)
+{
+ stop("stub function needs to be implemented")
+}
+
+# TODO addOrder
+#' add an order to the order book
+#'
+#' we need to figure out how to handle stop entry and stop exit orders, maybe via a negative price to specify the pullback that would trigger the order at the market.
+#'
+#' trailing stops should be modeled with replaced orders as prices change
+#'
+#' @param portfolio text name of the portfolio to associate the order book with
+#' @param symbol identfier of the instrument to find orders for. The name of any associated price objects (xts prices, usually OHLC) should match these
+#' @param timestamp timestamp coercible to POSIXct that will be the time the order will be inserted on
+#' @param qty
+#' @param price
+#' @param ordertype one of "market","limit",or "stop"
+#' @param side one of either "long" or "short"
+#' @param status one of "open", "closed", "canceled", or "replaced"
+#' @param statustime timestamp of a status update, will be blank when order is initiated
+#' @export
+addOrder <- function(portfolio, symbol, timestamp, qty, price, ordertype, side, status="open", statustime='' )
+{
+ stop("stub function needs to be implemented")
+ # get order book
+ # insert new order
+ # assign order book back into place (do we need a non-exported "put" function?)
+}
+
+# TODO update an order
+
+# TODO ruleOrderProc
+# process orders at time t, generating transactions
+
+
+###############################################################################
+# R (http://r-project.org/) Quantitative Strategy Model Framework
+#
+# Copyright (c) 2009-2010
+# Peter Carl, Dirk Eddelbuettel, Brian G. Peterson, Jeffrey Ryan, and Joshua Ulrich
+#
+# This library is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id$
+#
+###############################################################################
Property changes on: pkg/quantstrat/R/orders.R
___________________________________________________________________
Name: svn:keywords
+ Revision Id Date Author
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2010-02-07 16:11:08 UTC (rev 233)
+++ pkg/quantstrat/R/rules.R 2010-02-07 20:10:35 UTC (rev 234)
@@ -52,7 +52,6 @@
tmp_rule<-list()
tmp_rule$name<-name
tmp_rule$type<-type
- # TODO change this to a separate slot!!!!!
tmp_rule$enabled<-enabled
if (!is.list(arguments)) stop("arguments must be passed as a named list")
arguments$label=label
@@ -150,7 +149,7 @@
} # end sub process function
#TODO FIXME we should probably do something more sophisticated, but this should work
- if(isTRUE(path.dep) & is.null(Dates)) Dates=time(mktdata) # sdhould this be index() instead?
+ if(isTRUE(path.dep) & is.null(Dates)) Dates=time(mktdata) # should this be index() instead?
if(!isTRUE(path.dep)) Dates=''
hold=FALSE
@@ -163,7 +162,7 @@
for ( type in names(strategy$rules)){
switch( type ,
pre = {
- # TODO check to see if wer need to relase hold
+ # TODO check to see if we need to release hold
# holdtill would be before current time stamp
if(length(strategy$rules[type])>=1)
ruleProc(strategy$rules$pre,Date=Date)
@@ -177,7 +176,7 @@
if(length(strategy$rules[type])>=1) {
ruleProc(strategy$rules[type],Date=Date)
} else {
- ruleOrderProc(Symbol=Symbol, Date=Date, Portfolio=Portfolio)
+ # TODO call ruleOrderProc(symbol=Symbol, Date=Date, portfolio=Portfolio)
}
},
rebalance =, exit = , enter = {
Deleted: pkg/quantstrat/R/traderules.R
===================================================================
--- pkg/quantstrat/R/traderules.R 2010-02-07 16:11:08 UTC (rev 233)
+++ pkg/quantstrat/R/traderules.R 2010-02-07 20:10:35 UTC (rev 234)
@@ -1,80 +0,0 @@
-#' add a rule to a strategy
-#'
-#' Rules will be processed in a very particular manner, so it bears going over.
-#'
-#' First, rules are either path dependent or non-path-dependent. Path dependent rules
-#' will be processed in every time increment for the \code{mktdata} passed into
-#' \code{\link{applyStrategy}}. Non path dependent rules will likely be quite rare in real life,
-#' and will be applied after indicators and signals, and before path-dependent rules are processed.
-#'
-#' All rules have a \code{type}. These may be any of:
-#' \itemize{
-#' \item{risk}{ rules that check and react to risk of positions, may stop all other rule execution temporarily or permanently}
-#' \item{order}{ rules for order processing of any open orders at time t, always path-dependent}
-#' \item{rebalance}{ rules executed specifically in a portfolio context, unnecessary in univariate strategies}
-#' \item{exit}{ rules to determine whether to exit a position}
-#' \item{enter}{ rules to determine whether to enter or increase a position}
-#' }
-#' The rules will be executed by type, in the order listed above.
-#' Multiple rules of each type may be defined, as with signals and indicators,
-#' they will be executed in order by index number with any other rules sharing the same
-#' type.
-#'
-#' The rule execution order was constructed because path-dependent rules may modify
-#' the ability of rules that have not fired yet to be evaluated. For example, a
-#' risk rule may flatten (close out) an entire position and put new orders
-#' on hold, effectively stopping all further execution of the strategy.
-#' Another example would be a rebalancing rule function that would enter
-#' orders to rebalance the portfolio, and would hold other strategy processing
-#' until the rebalancing period was over.
-#'
-#' We anticipate that rules will be the portion of a strategy most likely to
-#' not have suitable template code included with this package, as every strategy
-#' and environment are different, especially in this respect.
-#' We will attempt to provide enough examples and generic rules to give strategy
-#' authors a place to start.
-#'
-#' @param strategy an object of type 'strategy' to add the rule to
-#' @param name name of the rule, must correspond to an R function
-#' @param arguments default arguments to be passed to an rule function when executed
-#' @param label arbitrary text label for signal output, NULL default will be converted to '<name>.sig'
-#' @param type one of "risk","order","rebalance","exit","entry", see Details
-#' @param ... any other passthru parameters
-#' @param enabled TRUE/FALSE whether the rule is enabled for use in applying the strategy, default TRUE
-#' @param indexnum if you are updating a specific rule, the index number in the $rules[type] list to update
-#' @param path.dep TRUE/FALSE whether rule is path dependent, default TRUE, see Details
-#' @param store TRUE/FALSE whether to store the strategy in the .strategy environment, or return it. default FALSE
-#' @export
-add.rule <- function(strategy, name, arguments, label=NULL, type=c(NULL,"risk","order","rebalance","exit","entry"), ..., enabled=TRUE, indexnum=NULL, path.dep=TRUE, store=FALSE) {
- if(!is.strategy(strategy)) stop("You must pass in a strategy object to manipulate")
- type=type[1]
- if(is.null(type)) stop("You must specify a type")
- tmp_rule<-list()
- tmp_rule$name<-name
- tmp_rule$type<-type
- # TODO change this to a separate slot!!!!!
- tmp_rule$enabled<-enabled
- if (!is.list(arguments)) stop("arguments must be passed as a named list")
- arguments$label=label
- tmp_rule$arguments<-arguments
- if(!hasArg(indexnum) | (hasArg(indexnum) & is.null(indexnum))) indexnum = length(strategy$rules[type])+1
- tmp_rule$call<-match.call()
- strategy$rules[type][[indexnum]]<-tmp_rule
-
- if (store) assign(strategy$name,strategy,envir=as.environment(.strategy))
- else return(strategy)
-}
-
-
-###############################################################################
-# R (http://r-project.org/) Quantitative Strategy Model Framework
-#
-# Copyright (c) 2009-2010
-# Peter Carl, Dirk Eddelbuettel, Brian G. Peterson, Jeffrey Ryan, and Joshua Ulrich
-#
-# This library is distributed under the terms of the GNU Public License (GPL)
-# for full details see the file COPYING
-#
-# $Id$
-#
-###############################################################################
Added: pkg/quantstrat/man/addOrder.Rd
===================================================================
--- pkg/quantstrat/man/addOrder.Rd (rev 0)
+++ pkg/quantstrat/man/addOrder.Rd 2010-02-07 20:10:35 UTC (rev 234)
@@ -0,0 +1,17 @@
+\name{addOrder}
+\alias{addOrder}
+\title{add an order to the order book...}
+\usage{addOrder(portfolio, symbol, timestamp, qty, price, ordertype, side, status="open", statustime="")}
+\description{add an order to the order book}
+\details{we need to figure out how to handle stop entry and stop exit orders, maybe via a negative price to specify the pullback that would trigger the order at the market.
+
+trailing stops should be modeled with replaced orders as prices change}
+\arguments{\item{portfolio}{text name of the portfolio to associate the order book with}
+\item{symbol}{identfier of the instrument to find orders for. The name of any associated price objects (xts prices, usually OHLC) should match these}
+\item{timestamp}{timestamp coercible to POSIXct that will be the time the order will be inserted on}
+\item{qty}{}
+\item{price}{}
+\item{ordertype}{one of "market","limit",or "stop"}
+\item{side}{one of either "long" or "short"}
+\item{status}{one of "open", "closed", "canceled", or "replaced"}
+\item{statustime}{timestamp of a status update, will be blank when order is initiated}}
Property changes on: pkg/quantstrat/man/addOrder.Rd
___________________________________________________________________
Name: svn:keywords
+ Revision Id Date Author
Added: pkg/quantstrat/man/getOrderBook.Rd
===================================================================
--- pkg/quantstrat/man/getOrderBook.Rd (rev 0)
+++ pkg/quantstrat/man/getOrderBook.Rd 2010-02-07 20:10:35 UTC (rev 234)
@@ -0,0 +1,7 @@
+\name{getOrderBook}
+\alias{getOrderBook}
+\title{get the order book object...}
+\usage{getOrderBook(portfolio)}
+\description{get the order book object}
+\details{I don't think this should be exported.}
+\arguments{\item{portfolio}{text name of the portfolio the order book is associated with}}
Property changes on: pkg/quantstrat/man/getOrderBook.Rd
___________________________________________________________________
Name: svn:keywords
+ Revision Id Date Author
Added: pkg/quantstrat/man/getOrdersByStatus.Rd
===================================================================
--- pkg/quantstrat/man/getOrdersByStatus.Rd (rev 0)
+++ pkg/quantstrat/man/getOrdersByStatus.Rd 2010-02-07 20:10:35 UTC (rev 234)
@@ -0,0 +1,11 @@
+\name{getOrdersByStatus}
+\alias{getOrdersByStatus}
+\title{get orders by status...}
+\usage{getOrdersByStatus(portfolio, symbol, status="open", date, ordertype)}
+\description{get orders by status}
+\details{should this be symbols in stead of symbol?}
+\arguments{\item{portfolio}{text name of the portfolio to associate the order book with}
+\item{symbol}{identfier of the instrument to find orders for. The name of any associated price objects (xts prices, usually OHLC) should match these}
+\item{status}{one of "open", "closed", "canceled", or "replaced"}
+\item{date}{timestamp coercible to POSIXct that will be the period to find orders of the given status and ordertype}
+\item{ordertype}{one of "market","limit",or "stop"}}
Property changes on: pkg/quantstrat/man/getOrdersByStatus.Rd
___________________________________________________________________
Name: svn:keywords
+ Revision Id Date Author
Added: pkg/quantstrat/man/initOrders.Rd
===================================================================
--- pkg/quantstrat/man/initOrders.Rd (rev 0)
+++ pkg/quantstrat/man/initOrders.Rd 2010-02-07 20:10:35 UTC (rev 234)
@@ -0,0 +1,12 @@
+\name{initOrders}
+\alias{initOrders}
+\title{initialize order container...}
+\usage{initOrders(portfolio, symbols, initDate="1999-12-31")}
+\description{initialize order container}
+\details{This function sets up the order container by portfolio.
+
+If no symbols list is provided (the default) the function will attempt
+to retrieve the symbols list from the portfolio in the trade blotter.}
+\arguments{\item{portfolio}{text name of the portfolio to associate the order book with}
+\item{symbols}{a list of identfiers of the instruments to be contained in the Portfolio. The name of any associated price objects (xts prices, usually OHLC) should match these}
+\item{initDate}{date (ISO8601) prior to the first close price given in mktdata, used to initialize the order book with a dummy order}}
Property changes on: pkg/quantstrat/man/initOrders.Rd
___________________________________________________________________
Name: svn:keywords
+ Revision Id Date Author
More information about the Blotter-commits
mailing list