SCM

SCM Repository

[blotter] Annotation of /pkg/blotter/R/updatePortf.R
ViewVC logotype

Annotation of /pkg/blotter/R/updatePortf.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1504 - (view) (download)

1 : braverock 593 #' update Portfilio P&L over a Dates range
2 : braverock 1495 #'
3 : braverock 593 #' The \code{updatePortf} function goes through each symbol and calculates the PL for each period prices are available.
4 :     #'
5 : braverock 1495 #' Note that the portfolio will be marked on every time stamp where prices are available.
6 : braverock 593 #' As such, your \code{Dates} range must reflect timestamps which appear in the price stream.
7 : braverock 1495 #' Also note that you probably don't want to mark the portfolio on every tick,
8 :     #'
9 :     #'
10 : braverock 593 #' @return assigns position information and PL into the environment
11 : braverock 1495 #'
12 : braverock 593 #' @param Portfolio string identifying a portfolio
13 : braverock 1495 #' @param Symbols character vector identifying symbols to update the portfolio for, default NULL
14 : braverock 593 #' @param Dates xts-style ISO-8601 time range to run updatePortf over, default NULL (will use times from Prices
15 :     #' @param Prices optional xts object containing prices and timestamps to mark the book on, default NULL
16 : braverock 742 #' @param \dots any other passthrough parameters
17 : braverock 133 #' @export
18 : braverock 492 updatePortf <- function(Portfolio, Symbols=NULL, Dates=NULL, Prices=NULL, ...)
19 : braverock 403 { #' @author Peter Carl, Brian Peterson
20 : braverock 1503 pname<-Portfolio
21 :     Portfolio<-getPortfolio(pname) # TODO add Date handling
22 :    
23 :     # FUNCTION
24 :     if(is.null(Symbols)){
25 :     Symbols = ls(Portfolio$symbols)
26 :     }
27 :     for(symbol in Symbols){
28 :     tmp_instr<-try(getInstrument(symbol), silent=TRUE)
29 :     .updatePosPL(Portfolio=pname, Symbol=as.character(symbol), Dates=Dates, Prices=Prices, ...=...)
30 :     }
31 :    
32 :     # Calculate and store portfolio summary table
33 :     Portfolio<-getPortfolio(pname) # refresh with an updated object
34 :     #if(is.null(Dates)) Dates <- xts:::time.xts(Portfolio$symbols[[1]]$posPL) #not quite right, only using first symbol...
35 : bodanker 1504 if(is.null(Dates)) Dates <- unique(do.call(c,c(lapply(Portfolio$symbols, function(x) index(x[["posPL"]][Dates]) ), use.names=FALSE, recursive=FALSE)))
36 : braverock 1503
37 :     #Symbols = ls(Portfolio$symbols)
38 :     Attributes = c('Long.Value', 'Short.Value', 'Net.Value', 'Gross.Value', 'Period.Realized.PL', 'Period.Unrealized.PL', 'Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')
39 :     summary = NULL
40 :     tmp.attr=NULL
41 :     for(attribute in Attributes) {
42 :     result=NULL
43 :     switch(attribute,
44 :     Net.Value =,
45 :     Gross.Value =,
46 :     Long.Value =,
47 :     Short.Value =,{
48 :     # all these use Pos.Value
49 :     if(is.null(tmp.attr)){
50 :     table = .getBySymbol(Portfolio = Portfolio, Attribute = "Pos.Value", Dates = Dates, Symbols = Symbols)
51 :     tmp.attr="Pos.Value"
52 :     }
53 :     switch(attribute,
54 :     Gross.Value = { result = xts(rowSums(abs(table), na.rm=TRUE), order.by=index(table))},
55 :     Long.Value = { tmat = apply(table,MARGIN=c(1,2),FUN=max,0)# comes out a matrix
56 :     result = xts(rowSums(tmat, na.rm=TRUE), order.by=index(table))
57 :     },
58 :     Short.Value = { tmat = apply(table,MARGIN=c(1,2),FUN=min,0) # comes out a matrix
59 :     result = xts(rowSums(tmat, na.rm=TRUE), order.by=index(table))
60 :     },
61 :     Net.Value = { result = xts(rowSums(table, na.rm=TRUE), order.by=index(table)) }
62 :     )
63 :     },
64 :     Period.Realized.PL =,
65 :     Period.Unrealized.PL =,
66 :     Gross.Trading.PL =,
67 :     Txn.Fees =,
68 :     Net.Trading.PL = {
69 :     table = .getBySymbol(Portfolio = Portfolio, Attribute = attribute, Dates = Dates, Symbols = Symbols)
70 :     tmp.attr = NULL
71 :     result = xts(rowSums(table, na.rm=TRUE), order.by=index(table))
72 :     }
73 :     )
74 :    
75 :     colnames(result) = attribute
76 :     if(is.null(summary)) {summary=result}
77 :     else {summary=cbind(summary,result)}
78 :     }
79 :    
80 :     # get rid of duplicated indices in the summary data,
81 :     # thanks to Guy Yollin for the bug report and Josh Ulrich for the elegant approach to fixing it
82 :     d <- duplicated(.index(summary)) | duplicated(.index(summary), fromLast=TRUE)
83 :     if(any(d)){
84 :     f <- function(x) {
85 :     cLast <- c('Long.Value', 'Short.Value', 'Net.Value', 'Gross.Value')
86 :     cSums <- c('Period.Realized.PL', 'Period.Unrealized.PL', 'Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL')
87 :     setNames( merge(last(x[,cLast]), xts(t(colSums(x[,cSums],na.rm=TRUE)),last(index(x)))), colnames(x) )
88 :     }
89 :     summary.dups <- summary[d,]
90 :     ds <- duplicated(.index(summary.dups)) & !duplicated(.index(summary.dups), fromLast=TRUE)
91 :     slist <- period.apply(summary.dups, c(0, which(ds)), f)
92 :     summary <- rbind(summary[!d,], slist) # put it all back together
93 :     }
94 :    
95 :     # if(!is.timeBased(Dates)) Dates = xts:::time.xts(Portfolio$symbols[[1]][["posPL"]][Dates])
96 :     #xts(,do.call(unlist,c(lapply(symbols,index),use.names=FALSE)))
97 : bodanker 1504 if(!is.timeBased(Dates)) Dates <- unique(do.call(c,c(lapply(Portfolio$symbols, function(x) index(x[["posPL"]][Dates]) ), use.names=FALSE, recursive=FALSE)))
98 : braverock 1503 startDate = first(xts:::.parseISO8601(Dates))$first.time-.00001
99 :     # trim summary slot to not double count, related to bug 831 on R-Forge, and rbind new summary
100 :     if( as.POSIXct(attr(Portfolio,'initDate'))>=startDate || length(Portfolio$summary)==0 ){
101 :     Portfolio$summary<-summary #changes to subset might not return a empty dimnames set of columns
102 :     }else{
103 :     Portfolio$summary<-rbind(Portfolio$summary[paste('::',startDate,sep='')],summary)
104 :     }
105 :     # assign Portfolio to environment
106 :     assign( paste("portfolio",pname,sep='.'), Portfolio, envir=.blotter )
107 :    
108 :     return(pname) #not sure this is a good idea
109 : peter_carl 3 }
110 :    
111 :     ###############################################################################
112 :     # Blotter: Tools for transaction-oriented trading systems development
113 : braverock 1495 # for R (see http://r-project.org/)
114 : braverock 516 # Copyright (c) 2008-2011 Peter Carl and Brian G. Peterson
115 : peter_carl 3 #
116 :     # This library is distributed under the terms of the GNU Public License (GPL)
117 :     # for full details see the file COPYING
118 :     #
119 : peter_carl 44 # $Id$
120 : peter_carl 3 #
121 :     ###############################################################################

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge