[Blotter-commits] r209 - pkg/blotter/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jan 27 22:50:30 CET 2010


Author: braverock
Date: 2010-01-27 22:50:29 +0100 (Wed, 27 Jan 2010)
New Revision: 209

Added:
   pkg/blotter/R/chart.Spread.R
Modified:
   pkg/blotter/R/calcAcctAttr.R
   pkg/blotter/R/calcPortfAttr.R
   pkg/blotter/R/calcPortfSummary.R
   pkg/blotter/R/getByPortf.R
   pkg/blotter/R/getBySymbol.R
   pkg/blotter/R/updateAcct.R
   pkg/blotter/R/updatePortf.R
   pkg/blotter/R/updatePosPL.R
Log:
- multiple updates to error checking and making demo work, including updates to accounts for intraday trades/updates 

Modified: pkg/blotter/R/calcAcctAttr.R
===================================================================
--- pkg/blotter/R/calcAcctAttr.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/calcAcctAttr.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -17,7 +17,7 @@
     else
         Date = time(Account[[2]][Date])
     table = xts(NULL, order.by=Date) ## Reference time index
-    table = getByPortf(Account, Attribute, Date)
+    table = .getByPortf(Account, Attribute, Date)
     result = xts(apply(table, FUN='sum', MARGIN=1), Date)
     colnames(result) = Attribute
     return(result)

Modified: pkg/blotter/R/calcPortfAttr.R
===================================================================
--- pkg/blotter/R/calcPortfAttr.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/calcPortfAttr.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -1,11 +1,11 @@
-`calcPortfAttr` <-
-function(Portfolio, Attribute, Date=NULL, Symbols = NULL)
+calcPortfAttr <- function(Portfolio, Attribute, Date=NULL, Symbols = NULL)
 {
+    if(!inherits(Portfolio,"portfolio")) stop("Portfolio passed is not a portfolio object.")
     symbols = names(Portfolio)
-    if(is.null(Date)) # if no date is specified, get all available dates
+    if(is.null(Date)|is.na(Date)) # if no date is specified, get all available dates
         Date = time(Portfolio[[1]]$posPL)
-    else
-        Date = time(Portfolio[[1]]$posPL[Date])
+    else Date = time(Portfolio[[1]]$posPL[Date])
+
     table = xts(NULL, order.by=Date) ## Reference time index
 
     switch(Attribute,

Modified: pkg/blotter/R/calcPortfSummary.R
===================================================================
--- pkg/blotter/R/calcPortfSummary.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/calcPortfSummary.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -1,15 +1,14 @@
-`calcPortfSummary` <-
-function(Portfolio, Date=NULL)
+calcPortfSummary <- function(Portfolio, Date=NULL)
 { # @ author Peter Carl
-
+    if(!inherits(Portfolio,"portfolio")) stop("Portfolio passed is not a portfolio object.")
     # DESCRIPTION
     # Create portfolio summary with the following columns
     # Long.Value, Short.Value, Net.Value, Trading.PL
 
-    if(is.null(Date)) # if no date is specified, get all available dates
-        Date = time(Portfolio[[1]]$posPL)
-    else
-        Date = time(Portfolio[[1]]$posPL[Date])
+    if(is.null(Date) | is.na(Date)) # if no date is specified, get all available dates
+        Date = time(Portfolio[[1]]$posPL )
+    else Date = time(Portfolio[[1]]$posPL[Date])
+    
     TradingPL = calcPortfAttr(Portfolio, 'Trading.PL', Date)
     RealizedPL = calcPortfAttr(Portfolio, 'Realized.PL', Date)
     UnrealizedPL = calcPortfAttr(Portfolio, 'Unrealized.PL', Date)

Added: pkg/blotter/R/chart.Spread.R
===================================================================
--- pkg/blotter/R/chart.Spread.R	                        (rev 0)
+++ pkg/blotter/R/chart.Spread.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -0,0 +1,95 @@
+#' @export
+chart.Spread <- function(Account, Portfolio, Spread=NULL, Symbols = NULL, Dates = NULL, ...)
+{ # @author Peter Carl
+    
+    pname<-Portfolio
+    Portfolio<-getPortfolio(pname,Dates)
+
+    pacctdata<-getPortfAcct(Account,Portfolio=pname, Dates=NULL)
+    
+    tmp_instr<-getInstrument(Spread)
+    if(!inherits(tmp_instr,"spread")) stop (paste("Instrument",Spread," is not a spread, please use the primary_id of a spread."))
+    
+    # DESCRIPTION
+    # Charts the transaction series of a symbol against prices
+
+    # Inputs
+    # Portfolio: a portfolio object structured with initPortf()
+    # Symbol: an instrument identifier for a symbol included in the portfolio,
+    #   e.g., IBM
+    # Dates: dates to return the calculation over formatted as xts range
+
+    # Outputs
+    # Timeseries object with weights by date in rows and symbolname in columns
+
+    # FUNCTION
+
+    require(quantmod)
+    Prices=get(Spread)
+    #buys and sells will be done on the first positive ratio instrument in a spread
+    Symbol<-tmp_instr$memberlist$members[which(tmp_instr$memberlist$memberratio>0)][1]
+    
+    
+    freq = periodicity(Prices)
+    switch(freq$scale,
+            seconds = { mult=1 },
+            minute = { mult=60 },
+            hourly = { mult=3600 },
+            daily = { mult=86400 },
+            {mult=86400}
+    )
+    if(!isTRUE(freq$frequency*mult == round(freq$frequency,0)*mult)) { 
+        # if the equality
+        n=round((freq$frequency/mult),0)*mult
+    } else { n=mult }
+    Prices=align.time(Prices,n) 
+    tzero = xts(0,order.by=index(Prices[1,]))
+    Trades = Portfolio[[Symbol]]$txn$Txn.Price*Portfolio[[Symbol]]$txn$Txn.Qty
+    Buys = Portfolio[[Symbol]]$txn$Txn.Price[which(Trades>0)]
+    Buys = align.time(rbind(Buys,tzero),n)[-1]
+    #because this is a spread, we need to use the price of the spread at the time of the synthetic 'buy'
+    Buys = Prices[index(Buys)]
+    Sells = Portfolio[[Symbol]]$txn$Txn.Price[which(Trades<0)]
+    Sells = align.time(rbind(Sells,tzero),n)[-1]
+    #because this is a spread, we need to use the price of the spread at the time of the synthetic 'sell'
+    Sells = Prices[index(Sells)]
+    #     # These aren't quite right, as abs(Pos.Qty) should be less than prior abs(Pos.Qty)
+    # SellCover = Portfolio[[Symbol]]$txn$Txn.Price * (Portfolio[[Symbol]]$txn$Txn.Qty<0) * (Portfolio[[Symbol]]$txn$Pos.Qty==0)
+    # BuyCover = Portfolio[[Symbol]]$txn$Txn.Price * (Portfolio[[Symbol]]$txn$Txn.Qty>0) * (Portfolio[[Symbol]]$txn$Pos.Qty==0)
+    # 
+    #     #Symbol 24 (up) and 25 (dn) can take bkgd colors
+    # addTA(BuyCover,pch=24,type="p",col="green", bg="orange", on=1)
+    # addTA(SellCover,pch=25,type="p",col="red", bg="orange", on=1)
+
+    chartSeries(Prices, TA=NULL,...)
+    plot(addTA(Buys,pch=2,type='p',col='green', on=1));
+    plot(addTA(Sells,pch=6,type='p',col='red', on=1));
+
+    #Position = Portfolio[[Symbol]]$posPL$Pos.Qty # use $txn instead, and make it match the prices index
+    i=1
+    for(Symbol in tmp_instr$memberlist$members){
+        Position = Portfolio[[Symbol]]$txn$Pos.Qty
+        Position = na.locf(merge(Position,index(Prices)))
+        plot(addTA(Position,type='b',col=i, lwd=1, on=2));
+        i=i+1
+    }
+
+    #FIXME right now we don't separate trading PL by *Spread*, just by *Portfolios*, so this isn't quite right in the general case
+    #TODO change this to use a two-line shaded graphic as soon as Jeff provides the infrastructure
+    TradingPL = pacctdata$Trading.PL
+    if(length(TradingPL)>1) TradingPL = na.locf(merge(TradingPL,index(Prices)))
+    else TradingPL = NULL
+    if(!is.null(TradingPL))  plot(addTA(TradingPL, col='darkgreen', lwd=2))
+}
+
+###############################################################################
+# Blotter: Tools for transaction-oriented trading systems development
+# for R (see http://r-project.org/) 
+# Copyright (c) 2008-2010 Peter Carl and Brian G. Peterson
+#
+# 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/blotter/R/chart.Spread.R
___________________________________________________________________
Name: svn:keywords
   + Revision Id Date Author

Modified: pkg/blotter/R/getByPortf.R
===================================================================
--- pkg/blotter/R/getByPortf.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/getByPortf.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -1,10 +1,5 @@
-`getByPortf` <-
-function(Account, Attribute, Date=NULL)
+.getByPortf <- function(Account, Attribute, Date=NULL)
 { # @author Peter Carl
-    aname<-Account
-    Account<-try(get(paste("account",aname,sep='.'), envir=.blotter))
-    if(inherits(Account,"try-error"))
-        stop(paste("Account",aname," not found, use initAcct() to create a new account"))
     
     # DESCRIPTION:
     # Retrieves calculated attributes for each portfolio in the account

Modified: pkg/blotter/R/getBySymbol.R
===================================================================
--- pkg/blotter/R/getBySymbol.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/getBySymbol.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -17,9 +17,10 @@
 
     # FUNCTION
     if(is.null(Date)) # if no date is specified, get all available dates
-        Date = time(Portfolio[[1]]$txn)
-#    else
-#        Date = time(Portfolio[[1]]$txn[Date])
+        Date = time(Portfolio[[1]]$posPL)
+    else
+        Date = time(Portfolio[[1]]$posPL[Date])
+
     table = xts(NULL, order.by=Date) 
       ## Need a reference time index
     if(is.null(Symbols))
@@ -29,7 +30,6 @@
     
     for (symbol in symbols) {
         table = merge(table, Portfolio[[symbol]]$posPL[Date,Attribute,drop=FALSE])
-        #table = cbind(table, Portfolio[[i]]$posPL[Date,Attribute,drop=FALSE])
     }
     colnames(table) = symbols
     return(table)

Modified: pkg/blotter/R/updateAcct.R
===================================================================
--- pkg/blotter/R/updateAcct.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/updateAcct.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -25,19 +25,18 @@
     # TODO FIXME this so that it finds the date range in *any*/all portfolios, not just the first
     if(is.null(Dates)) 
         #[[1]] here is the first instrument in the portfolio
-        Dates = time(Portfolio[[1]]$txn ) # if no date is specified, get all available dates
-    if(length(Dates)==1){
+        Dates = time(Portfolio[[1]]$posPL ) # if no date is specified, get all available dates
+#    if(!is.timeBased(Dates) ){
         # Dates is an xts range, turn it into a list of Dates
-        Dates = time(Portfolio[[1]]$txn[Dates])
-    } 
-
+    else Dates = time(Portfolio[[1]]$posPL[Dates])
+#    } 
     # For each date, calculate realized and unrealized P&L
     for(d in 1:length(Dates)){ # d is a date slot counter
     # I shouldn't have to do this but I lose the class for the element when I do
     # for(date in Dates)
         # Append the portfolio summary data to the portfolio slot
         for(i in 1:length(Portfolios)){
-            Portfolio = get(Portfolios[i],envir=.blotter)
+            Portfolio = getPortfolio(Portfolios[i])
             row = calcPortfSummary(Portfolio, Dates[d])
             Account[[i+1]] = rbind(Account[[i+1]],row)
         }

Modified: pkg/blotter/R/updatePortf.R
===================================================================
--- pkg/blotter/R/updatePortf.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/updatePortf.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -15,10 +15,7 @@
 updatePortf <- function(Portfolio, Dates)
 { #' @author Peter Carl
     pname<-Portfolio
-    Portfolio<-try(get(paste("portfolio",pname,sep='.'),envir=.blotter),silent=TRUE)
-    if(inherits(Portfolio,"try-error"))
-        stop(paste("Portfolio",pname," not found, use initPortf() to create a new portfolio"))
-    
+    Portfolio<-getPortfolio(pname) # TODO add Date handling
 
     # FUNCTION
     symbols = names(Portfolio)
@@ -30,7 +27,6 @@
             updatePosPL(pname, symbol, Dates, Cl(get(symbol)))            
         }  
     }
-    assign(paste("portfolio",pname,sep='.'),Portfolio,envir=.blotter) 
     return(pname) #not sure this is a good idea
 }
 

Modified: pkg/blotter/R/updatePosPL.R
===================================================================
--- pkg/blotter/R/updatePosPL.R	2010-01-27 20:19:23 UTC (rev 208)
+++ pkg/blotter/R/updatePosPL.R	2010-01-27 21:50:29 UTC (rev 209)
@@ -11,9 +11,7 @@
 { # @author Peter Carl
 
     pname<-Portfolio
-    Portfolio<-get(paste("portfolio",pname,sep='.'),envir=.blotter,inherits=TRUE)
-    if(inherits(Portfolio,"try-error"))
-        stop(paste("Portfolio",name," not found, use initPortf() to create a new account"))
+    Portfolio<-getPortfolio(pname) #TODO add Dates
     
     # FUNCTION
     PosAvgCost = 0
@@ -32,7 +30,7 @@
         Dates = time(Prices)
 #     else if(length(Dates)>1)# test to see if it's a vector of dates, which would pass through
     else 
-        Dates = time(Prices[Dates,])
+        Dates = time(Prices[Dates])
 
 #     Dates = strtrim(strptime(Dates, tformat), nchar(tformat)+2)
 
@@ -97,7 +95,7 @@
         Portfolio[[Symbol]]$posPL <- rbind(Portfolio[[Symbol]]$posPL, NewPeriod) 
     }
     # return(Portfolio)
-    assign(paste("portfolio",pname,sep='.'),Portfolio,envir=.blotter)
+    assign( paste("portfolio",pname,sep='.'), Portfolio, envir=.blotter )
 }
 
 ###############################################################################



More information about the Blotter-commits mailing list