[Blotter-commits] r381 - in pkg/blotter: R demo

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Aug 24 21:27:25 CEST 2010


Author: braverock
Date: 2010-08-24 21:27:24 +0200 (Tue, 24 Aug 2010)
New Revision: 381

Modified:
   pkg/blotter/R/initPosPL.R
   pkg/blotter/R/updatePosPL.R
   pkg/blotter/demo/turtles.R
Log:
- fix edge case in updatePosPL where there was not enough information to calc period P&L
- update turtles demo to use chart.Posn

Modified: pkg/blotter/R/initPosPL.R
===================================================================
--- pkg/blotter/R/initPosPL.R	2010-08-23 17:45:00 UTC (rev 380)
+++ pkg/blotter/R/initPosPL.R	2010-08-24 19:27:24 UTC (rev 381)
@@ -17,8 +17,8 @@
     # Constructs multi-column xts object used to store derived position information
 
     # FUNCTION
-    posPL <- xts( as.matrix(t(c(initPosQty,initConMult,initCcyMult,0,0,0,0,0,0,0))), order.by=as.POSIXct(initDate) )
-    colnames(posPL) <- c('Pos.Qty', 'Con.Mult', 'Ccy.Mult', 'Pos.Value', 'Txn.Value',  'Realized.PL', 'Unrealized.PL','Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')
+    posPL <- xts( as.matrix(t(c(initPosQty,initConMult,initCcyMult,0,0,0,0,0,0,0,0))), order.by=as.POSIXct(initDate) )
+    colnames(posPL) <- c('Pos.Qty', 'Con.Mult', 'Ccy.Mult', 'Pos.Value', 'Pos.Avg.Cost', 'Txn.Value',  'Realized.PL', 'Unrealized.PL','Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')
     class(posPL)<- c("posPL",class(posPL))
     return(posPL)
 }

Modified: pkg/blotter/R/updatePosPL.R
===================================================================
--- pkg/blotter/R/updatePosPL.R	2010-08-23 17:45:00 UTC (rev 380)
+++ pkg/blotter/R/updatePosPL.R	2010-08-24 19:27:24 UTC (rev 381)
@@ -10,7 +10,7 @@
 #' @export
 updatePosPL <- function(Portfolio, Symbol, Dates=NULL, Prices=NULL, ConMult=NULL, ...)
 { # @author Peter Carl, Brian Peterson
-
+	rmfirst=FALSE
     pname<-Portfolio
     Portfolio<-getPortfolio(pname) 
 	p.ccy.str<-attr(Portfolio,'currency')
@@ -21,20 +21,25 @@
     }
 	
 	if(is.null(Prices)){
-		Prices=getPrice(get(Symbol, envir=as.environment(.GlobalEnv)))
+		prices=getPrice(get(Symbol, envir=as.environment(.GlobalEnv)))
 	} 
 	
     if(is.null(Dates)) {# if no date is specified, get all available dates
-        Dates = time(Prices)
-	} else if(!is.timeBased(Dates)) Dates = time(Prices[Dates])
+        Dates = time(prices)
+	} else if(!is.timeBased(Dates)) Dates = time(prices[Dates])
 
 	# line up Prices dates with Dates set/index/span passed in.
-	startDate = xts:::.parseISO8601(first(Dates))$first.time-1 #does this need to be a smaller delta for millisecond data?
+	startDate = xts:::.parseISO8601(first(Dates))$first.time-1 #does this need to be a smaller/larger delta for millisecond data?
 	endDate   = xts:::.parseISO8601(last(Dates))$last.time
 	dateRange = paste(startDate,endDate,sep='::')
-
-	if(ncol(Prices)>1) Prices=getPrice(Prices,Symbol)
-	Prices <- Prices[dateRange][,1] # only take the first column, if there is more than one
+	
+	#subset Prices by dateRange too...
+	Prices<-prices[dateRange]
+	
+	if(ncol(Prices)>1) Prices=getPrice(prices,Symbol)[dateRange] 
+	
+	# Prices <- Prices[dateRange][,1] # only take the first column, if there is more than one
+	
 	colnames(Prices)<-'Prices' # name it so we can refer to it by name later
 	
 	#	***** Vectorization *****#
@@ -43,23 +48,34 @@
 	Portfolio$symbols[[Symbol]][[paste('posPL',p.ccy.str,sep='.')]]<-Portfolio$symbols[[Symbol]][[paste('posPL',p.ccy.str,sep='.')]][paste('::',startDate,sep='')]
 	
 	Txns <- Portfolio$symbols[[Symbol]]$txn[dateRange]
+	if(nrow(Txns)==1){
+		newtxn <- last(Portfolio$symbols[[Symbol]]$posPL)[,colnames(Txns)]
+		Txns <- rbind(Txns,newtxn)
+		rmfirst=TRUE
+	}
 	if(nrow(Txns)==0) {
-		message("No Transactions to process for ",Symbol," in ",dateRange)
-		return()
-		#TODO this isn't quite right either, but it will suffice to avoid errors for what we need for the moment...
-		#eventually, we'll need to get the last row in the posPL table, and mark from there if we have a position
-	}
+		Txns <- last(Portfolio$symbols[[Symbol]]$posPL)
+		rmfirst=TRUE
+	} 
+	
 	#	 line up transaction with Dates list
 	tmpPL <- merge(Txns, Prices) # most Txn columns will get discarded later
+
+	if(is.na(tmpPL$Prices[1])){
+		tmpPL$Prices[1] <- last(prices[paste('::',startDate,sep='')])
+	}
+
 	# na.locf any missing prices with last observation (this assumption seems the only rational one for vectorization)
 	tmpPL$Prices <- na.locf(tmpPL$Prices)
 
 	# na.locf Pos.Qty,Con.Mult,Pos.Avg.Cost to instantiate $posPL new rows
 	tmpPL$Pos.Qty <- na.locf(tmpPL$Pos.Qty)
 	tmpPL$Pos.Qty <- ifelse(is.na(tmpPL$Pos.Qty),0, tmpPL$Pos.Qty)
+
 	tmpPL$Con.Mult <- na.locf(tmpPL$Con.Mult)
 	tmpPL$Con.Mult <- ifelse(is.na(tmpPL$Con.Mult) ,1, tmpPL$Con.Mult)
-	tmpPL$Pos.Avg.Cost <- na.locf(tmpPL$Pos.Avg.Cost) # Pos.Avg.Cost column will get discarded later
+	
+	tmpPL$Pos.Avg.Cost <- na.locf(tmpPL$Pos.Avg.Cost)
 	tmpPL$Pos.Avg.Cost <- ifelse(is.na(tmpPL$Pos.Avg.Cost),0, tmpPL$Pos.Avg.Cost)
 	
 	# zerofill Txn.Value, Txn.Fees
@@ -70,7 +86,7 @@
 	tmpPL$Pos.Value <- tmpPL$Pos.Qty * tmpPL$Con.Mult * tmpPL$Prices
 	
 	# matrix calc Unrealized.PL as Pos.Qty*(Price-Pos.Avg.Cost)*Con.Mult
-	tmpPL$Unrealized.PL <- tmpPL$Pos.Qty*(tmpPL$Prices-tmpPL$Pos.Avg.Cost)*tmpPL$Con.Mult
+	tmpPL$Unrealized.PL <- round(tmpPL$Pos.Qty*(tmpPL$Prices-tmpPL$Pos.Avg.Cost)*tmpPL$Con.Mult,2)
 	
 	# matrix calc Gross.Trading.PL as Pos.Value-Lag(Pos.Value)-Txn.Value
 	tmpPL$Gross.Trading.PL <- tmpPL$Pos.Value-Lag(tmpPL$Pos.Value)- tmpPL$Txn.Value
@@ -86,9 +102,10 @@
 	tmpPL$Ccy.Mult<-rep(1,nrow(tmpPL))
 	
 	# reorder,discard  columns for insert into portfolio object
-	tmpPL <- tmpPL[,c('Pos.Qty', 'Con.Mult', 'Ccy.Mult', 'Pos.Value', 'Txn.Value',  'Realized.PL', 'Unrealized.PL','Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')]
+	tmpPL <- tmpPL[,c('Pos.Qty', 'Con.Mult', 'Ccy.Mult', 'Pos.Value', 'Pos.Avg.Cost', 'Txn.Value',  'Realized.PL', 'Unrealized.PL','Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')]
 
 	# rbind to $posPL slot
+	if(isTRUE(rmfirst)) tmpPL<-tmpPL[-1,] #remove the constructed first row, so we don't insert dups in the table
 	Portfolio$symbols[[Symbol]]$posPL<-rbind(Portfolio$symbols[[Symbol]]$posPL,tmpPL)
 		
 
@@ -145,10 +162,11 @@
 	
 	#multiply the correct columns    
     columns<-c('Pos.Value', 'Txn.Value',  'Realized.PL', 'Unrealized.PL','Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')
-    for (column in columns){
-        TmpPeriods[,column]<-TmpPeriods[,column]*CcyMult
-    }
-    TmpPeriods[,'Ccy.Mult']<-CcyMult
+#    for (column in columns){
+#        TmpPeriods[,column]<-TmpPeriods[,column]*CcyMult
+#    }
+	TmpPeriods[,columns]<-TmpPeriods[,columns]*CcyMult
+	TmpPeriods[,'Ccy.Mult']<-CcyMult
     #stick it in posPL.ccy
     Portfolio$symbols[[Symbol]][[paste('posPL',p.ccy.str,sep='.')]]<-rbind(Portfolio$symbols[[Symbol]][[paste('posPL',p.ccy.str,sep='.')]],TmpPeriods)
     # assign Portfolio to environment

Modified: pkg/blotter/demo/turtles.R
===================================================================
--- pkg/blotter/demo/turtles.R	2010-08-23 17:45:00 UTC (rev 380)
+++ pkg/blotter/demo/turtles.R	2010-08-24 19:27:24 UTC (rev 381)
@@ -105,18 +105,17 @@
 # Create trades
 for( i in 57:NROW(x) ) { # Assumes all dates are the same
   CurrentDate=time(x)[i]
-  print(CurrentDate)
+  #print(CurrentDate)
   equity = getEndEq(account, CurrentDate)
 
   for(symbol in symbols){
-#      print(symbol)
     x=get(symbol)
     ClosePrice = as.numeric(Cl(x[i,]))
 
     Posn = getPosQty(Portfolio=portfolio, Symbol=symbol, Date=CurrentDate)
     s = tail(getPortfolio(portfolio)[[symbol]]$strat,1)
-#      print(s)
-    Units = as.numeric(s[,'Pos.Units'])
+
+	Units = as.numeric(s[,'Pos.Units'])
     TxnPrice = as.numeric(s[,'Txn.Price'])
     N = as.numeric(s[,'Txn.N'])
     Stop = as.numeric(s[,'Stop.Price'])
@@ -169,19 +168,14 @@
 cat('Return: ',(getEndEq(Account=account, Date=CurrentDate)-initEq)/initEq,'\n')
 
 if (require(quantmod)) {
-  Portfolio<-getPortfolio(portfolio)  
-  Buys = Portfolio[["XLF"]]$txn$Txn.Price*(Portfolio[["XLF"]]$txn[,'Txn.Qty']>0)
-  Sells = Portfolio[["XLF"]]$txn$Txn.Price*(Portfolio[["XLF"]]$txn[,'Txn.Qty']<0)
-  Position = Portfolio[["XLF"]]$posPL[,'Pos.Qty']
-  CumPL = cumsum(Portfolio[["XLF"]]$posPL[,'Trading.PL'])
-  chartSeries(XLF['2008::2009',], TA=NULL, type='bar', theme=chartTheme("white",up.col='lightgreen',dn.col='pink'))
-  plot(addTA(Buys['2008::2009',],pch=2,type='p',col='darkgreen', on=1));
-  plot(addTA(Sells['2008::2009',],pch=6,type='p',col='darkred', on=1));
-  plot(addTA(Position['2008::2009',],type='h',col='blue', lwd=2));
-  plot(addTA(CumPL['2008::2009',], col='darkgreen', lwd=2))
+	for(symbol in symbols){
+		dev.new()
+		chart.Posn(Portfolio='turtles',Symbol=symbol)
+	}
 }
 
 if(require(PerformanceAnalytics)){
     return = Delt(getAccount(account)[["TOTAL"]]$End.Eq)
+	dev.new()
     charts.PerformanceSummary(as.zoo(return),main="Turtle Demo Performance")   
 }



More information about the Blotter-commits mailing list