[Blotter-commits] r406 - pkg/blotter/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Oct 6 16:24:26 CEST 2010
Author: peter_carl
Date: 2010-10-06 16:24:26 +0200 (Wed, 06 Oct 2010)
New Revision: 406
Modified:
pkg/blotter/R/getByPortf.R
pkg/blotter/R/getBySymbol.R
pkg/blotter/R/getEndEq.R
pkg/blotter/R/initAcct.R
pkg/blotter/R/updateAcct.R
pkg/blotter/R/updateEndEq.R
Log:
- finished account multicurrency and vectorization
Modified: pkg/blotter/R/getByPortf.R
===================================================================
--- pkg/blotter/R/getByPortf.R 2010-10-05 13:20:59 UTC (rev 405)
+++ pkg/blotter/R/getByPortf.R 2010-10-06 14:24:26 UTC (rev 406)
@@ -3,7 +3,8 @@
# DESCRIPTION:
# Retrieves calculated attributes for each portfolio in the account
- # from the portfolio summary table. Assembles into a portfolio-by-time table
+ # from the portfolio summary table. Assembles into a portfolio-by-time table,
+ # normalized to the Account currency
# Inputs
# Account: an Account object containing Portfolio summaries
@@ -15,18 +16,39 @@
# regular xts object of values by portfolio
# FUNCTION
- if(is.null(Dates)) # if no date is specified, get all available dates
- Dates = time(Account[[2]])
+ zerofill <- function (x)
+ { # kind of like PerformanceAnalytics, but not quite
+ for (column in 1:NCOL(x)) {
+ x[,column] <- ifelse(is.na(x[,column]),0, x[,column])
+ }
+ return(x)
+ }
table = NULL
- i=1
- portfolios=names(Account)[-1]
+ portfolios=names(Account$portfolios)
for (portfolio in portfolios) {
- tmp_col= Account[[portfolio]][Dates,Attribute,drop=FALSE]
+ tmp_col= Account$portfolios[[portfolio]][Dates,Attribute,drop=FALSE]
colnames(tmp_col)<-portfolio
if(is.null(table)) table = tmp_col
else table = cbind(table, tmp_col)
}
+ switch(Attribute,
+ Long.Value =,
+ Short.Value =,
+ Net.Value =,
+ Gross.Value = {
+ if(NROW(table) > 1)
+ table = na.locf(table)
+ },
+ Txn.Fees =,
+ Realized.PL =,
+ Unrealized.PL =,
+ Net.Trading.PL =,
+ Gross.Trading.PL = {
+ if(NROW(table) > 1)
+ table = zerofill(table)
+ }
+ )
return(table)
}
Modified: pkg/blotter/R/getBySymbol.R
===================================================================
--- pkg/blotter/R/getBySymbol.R 2010-10-05 13:20:59 UTC (rev 405)
+++ pkg/blotter/R/getBySymbol.R 2010-10-06 14:24:26 UTC (rev 406)
@@ -1,4 +1,4 @@
-.getBySymbol <- function(Portfolio, Attribute, Dates=NULL, Symbols=NULL, Local=FALSE)
+.getBySymbol <- function(Portfolio, Attribute, Dates=NULL, Symbols=NULL, native=FALSE)
{ # @author Peter Carl
# DESCRIPTION:
@@ -19,11 +19,11 @@
if(is.null(Dates) | is.na(Dates)) # if no date is specified, get all available dates
Dates = time(Portfolio$symbols[[1]]$posPL)
# else Dates = time(Portfolio$symbols[[1]]$posPL[Dates])
- if(!is.null(attr(Portfolio,'currency')) & Local==FALSE) {
+ if(!is.null(attr(Portfolio,'currency')) & native==FALSE) {
p.ccy.str<-attr(Portfolio,'currency')
namePosPL = paste("posPL", p.ccy.str, sep=".")
} else {
- print("Returning position values in Local values")
+ print("Returning position values in native currency values")
namePosPL = "posPL"
# Alternatively, we could just use posPL without ccy extension
}
@@ -43,6 +43,7 @@
colnames(table) = symbols
class(table)<-class(xts())
return(table)
+### TODO: NA fill like getByPortfolio
## TODO: append summary information in last columns based on Attribute requested
# e.g., 'Pos.Value' would append Net.Value, Gross.Value, Long.Value, Short.Value
Modified: pkg/blotter/R/getEndEq.R
===================================================================
--- pkg/blotter/R/getEndEq.R 2010-10-05 13:20:59 UTC (rev 405)
+++ pkg/blotter/R/getEndEq.R 2010-10-06 14:24:26 UTC (rev 406)
@@ -18,7 +18,7 @@
# FUNCTION
toDate = paste('::', Date, sep="")
- EndEq = as.numeric(tail(Account[[1]][toDate,], n=1)[,"End.Eq"])
+ EndEq = as.numeric(tail(Account$summary[toDate,], n=1)[,"End.Eq"])
return(EndEq)
}
Modified: pkg/blotter/R/initAcct.R
===================================================================
--- pkg/blotter/R/initAcct.R 2010-10-05 13:20:59 UTC (rev 405)
+++ pkg/blotter/R/initAcct.R 2010-10-06 14:24:26 UTC (rev 406)
@@ -52,13 +52,13 @@
stop(paste("Account",name,"already exists, use updateAcct() or create a new account."))
# FUNCTION
- account=vector("list",length=(length(portfolios)+1))
- names(account)=c("TOTAL",paste("portfolio",portfolios,sep='.'))
- account[["TOTAL"]] = xts( as.matrix(t(c(0,0,0,0,0,0,0,0,0,0,initEq))), order.by=as.POSIXct(initDate) )
- colnames(account[["TOTAL"]]) = c('Additions', 'Withdrawals', 'Realized.PL', 'Unrealized.PL', 'Int.Income', 'Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL', 'Advisory.Fees', 'Net.Performance', 'End.Eq')
+ account=list()
+ account$portfolios=vector("list",length=length(portfolios))
+ names(account$portfolios)=portfolios
+ account$summary = xts( as.matrix(t(c(0,0,0,0,0,0,0,0,0,0,initEq))), order.by=as.POSIXct(initDate) )
+ colnames(account$summary) = c('Additions', 'Withdrawals', 'Realized.PL', 'Unrealized.PL', 'Int.Income', 'Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL', 'Advisory.Fees', 'Net.Performance', 'End.Eq')
for(portfolio in portfolios){
- account[[paste("portfolio",portfolio,sep=".")]] = xts( as.matrix(t(c(0,0,0,0,0,0,0,0,0))), order.by=as.POSIXct(initDate) )
- colnames(account[[paste("portfolio",portfolio,sep=".")]]) = c('Long.Value', 'Short.Value', 'Net.Value', 'Gross.Value', 'Realized.PL', 'Unrealized.PL', 'Gross.Trading.PL','Txn.Fees','Net.Trading.PL')
+ account$portfolios[[portfolio]] = initSummary(initDate=initDate)
}
# return(account)
class(account)<-c("portfolio_account","account")
Modified: pkg/blotter/R/updateAcct.R
===================================================================
--- pkg/blotter/R/updateAcct.R 2010-10-05 13:20:59 UTC (rev 405)
+++ pkg/blotter/R/updateAcct.R 2010-10-06 14:24:26 UTC (rev 406)
@@ -15,61 +15,104 @@
{ # @author Peter Carl
Account<-getAccount(name)
+ if(!is.null(attr(Account,'currency'))) {
+ a.ccy.str<-attr(Account,'currency')
+ }
+
+ #TODO trim to only time prior to Dates
- # FUNCTION
- Portfolios = names(Account)[-1]
- Portfolio = getPortfolio(Portfolios[1])
- # 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$symbols[[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
-# else Dates = time(Portfolio$symbols[[1]]$posPL[Dates])
-# }
-
- #TODO FIXME do two loops, one over portfolios to update each portfolio
- # and one over accounts, to aggregate, probably via matrix addition
-
- # 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)
+ Portfolios = names(Account$portfolios)
+ # Append the portfolio summary data to the portfolio slot
+ for(pname in Portfolios){
+ Portfolio = getPortfolio(pname)
+ if(!is.null(attr(Portfolio,'currency'))) {
+ p.ccy.str<-attr(Portfolio,'currency')
+ }
+
+ # Test whether portfolio and account are of the same ccy
+ psummary = Portfolio$summary[Dates]
+ if( a.ccy.str != p.ccy.str ){
+ # If not, translate the portfolio summary to the account currency
+
+ port_currency<-try(getInstrument(p.ccy.str))
+ if(inherits(port_currency,"try-error") | !is.instrument(port_currency)){
+ warning("Currency",p.ccy.str," not found, using currency multiplier of 1")
+ CcyMult<-1
+ } else {
+ FXrate.str<-paste(tmp_instr$currency,p.ccy.str,sep='')
+ FXrate<-try(get(FXrate.str))
+ if(inherits(FXrate,"try-error")){
+ FXrate.str<-paste(p.ccy.str,tmp_instr$currency,sep='')
+ FXrate<-try(get(FXrate.str))
+ if(inherits(FXrate,"try-error")){
+ warning("Exchange Rate",FXrate.str," not found for symbol,',Symbol,' using currency multiplier of 1")
+ CcyMult<-1
+ } else {
+ invert=TRUE
+ }
+ }
+ }
+ if(is.na(CcyMult) & !is.na(FXrate)) {
+ if(inherits(FXrate,'xts')){
+ CcyMult <- FXrate[Dates]
+ CcyMult <- na.locf(merge(CcyMult,index(psummary)))
+ CcyMult <- drop(CcyMult[index(psummary)])
+ } else {
+ CcyMult<-as.numeric(FXrate)
+ }
+ } else {
+ CcyMult<-1
+ }
+ if(isTRUE(invert)){
+ # portfolio and instrument have different currencies, and FXrate was in the wrong direction
+ CcyMult<-1/CcyMult
+ }
+
+ #multiply by the currency multiplier
+ psummary<-psummary*CcyMult
+ }
+ # now bind it
+ Account$portfolios[[pname]] = rbind(Account$portfolios[[pname]],psummary)
+ }
- # Append the portfolio summary data to the portfolio slot
- for(pname in Portfolios){
- Portfolio = getPortfolio(pname)
+ summary = NULL
+ # get the dimensions we need to work with
+ ## TODO Find more efficient way to establish dimensions of the result
+ table = .getByPortf(Account, 'Net.Trading.PL', Dates)
+ obsLength = length(index(table))
+ obsDates = index(table)
- CurrentDate = Dates[d]
- PrevDate = time(Portfolio$symbols[[1]]$posPL[Portfolio$symbols[[1]]$posPL[CurrentDate,which.i=TRUE]-1 ] ) # which.i is new in [.xts
- if (length(PrevDate)==0) next() #no price data, keep looking
- PrevDateWidth = xts:::.parseISO8601(PrevDate)
- PrevDateLast = PrevDateWidth$last.time
- CurrentSpan = paste(PrevDateLast, CurrentDate, sep="::")
-
- rows = calcPortfSummary(Portfolio, CurrentSpan)
- rows = na.omit(rows)
- Account[[pname]] = rbind(Account[[pname]],rows)
- }
- if(is.null(CurrentSpan)) next()
- # Now aggregate the portfolio information into the TOTAL slot
- TxnFees = calcAcctAttr(Account, Attribute = 'Txn.Fees', CurrentSpan)
- Additions = xts(rep(0,length(index(TxnFees))),order.by=index(TxnFees))
- Withdrawals = Additions
- IntIncome = Additions
- AdvisoryFees = Additions
- NetPerformance = Additions
- EndEq = Additions
- RealizedPL = calcAcctAttr(Account, 'Realized.PL', CurrentSpan)
- UnrealizedPL = calcAcctAttr(Account, 'Unrealized.PL', CurrentSpan)
- GrossTradingPL = calcAcctAttr(Account, 'Gross.Trading.PL', CurrentSpan)
- NetTradingPL = calcAcctAttr(Account, 'Net.Trading.PL', CurrentSpan)
- rows = cbind(Additions, Withdrawals, RealizedPL, UnrealizedPL, IntIncome, GrossTradingPL, TxnFees, NetTradingPL, AdvisoryFees, NetPerformance, EndEq)
- colnames(rows) = c('Additions', 'Withdrawals', 'Realized.PL', 'Unrealized.PL', 'Int.Income', 'Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL', 'Advisory.Fees', 'Net.Performance', 'End.Eq')
- Account[['TOTAL']] <- rbind(Account[['TOTAL']], rows)
+ # Now aggregate the portfolio information into the $summary slot
+ Attributes = c('Additions', 'Withdrawals', 'Realized.PL', 'Unrealized.PL', 'Int.Income', 'Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL', 'Advisory.Fees', 'Net.Performance', 'End.Eq')
+
+ for(Attribute in Attributes) {
+ switch(Attribute,
+ Realized.PL = ,
+ Unrealized.PL = ,
+ Gross.Trading.PL = ,
+ Txn.Fees = ,
+ Net.Trading.PL = {
+ table = .getByPortf(Account, Attribute, Dates)
+ result = xts(rowSums(table,na.rm=TRUE),order.by=index(table))
+ },
+ Additions = ,
+ Withdrawals = ,
+ Int.Income = ,
+ Advisory.Fees = ,
+ Net.Performance = ,
+ End.Eq = {
+ ## TODO no cash handling for now, add this in later, but for now, zeroes
+ result = xts(rep(0,obsLength),order.by=obsDates)
+ }
+ )
+ colnames(result) = Attribute
+ if(is.null(summary)) {summary=result}
+ else {summary=cbind(summary,result)}
+ }
+ Account$summary <- rbind(Account$summary, summary)
# This function does not calculate End.Eq
- }
+
assign(paste("account",name,sep='.'),Account, envir=.blotter)
return(name) #not sure this is a good idea
}
Modified: pkg/blotter/R/updateEndEq.R
===================================================================
--- pkg/blotter/R/updateEndEq.R 2010-10-05 13:20:59 UTC (rev 405)
+++ pkg/blotter/R/updateEndEq.R 2010-10-06 14:24:26 UTC (rev 406)
@@ -6,20 +6,41 @@
#' @export
updateEndEq <- function(Account, Dates=NULL)
{
- aname<-Account
+ # DESCRIPTION
+ # Calculates End.Eq and Net.Performance
+
+ # Requires that updateAcct has been run and any additional functions
+ # have alread appended information into that table (e.g., additions or
+ # withdrawals, fees, interest, etc.)
+
+ 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"))
if(is.null(Dates)) # if no date is specified, get all available dates
- Dates = time(Account[[1]])
+ Dates = time(Account$summary)
else
- Dates = time(Account[[1]][Dates])
+ Dates = time(Account$summary[Dates])
- # For each date, calculate realized and unrealized P&L
- for(d in 1:length(Dates)){ # d is a date slot counter
- Account = calcEndEq(aname, as.character(Dates[d])) ## WTF?
- }
+ ### TODO Vectorize this
+ # # For each date, calculate realized and unrealized P&L
+ # for(d in 1:length(Dates)){ # d is a date slot counter
+ # Account = calcEndEq(aname, as.character(Dates[d])) ## WTF?
+ # }
+
+ PrevDate = time(Account$summary[first(Account$summary[Dates,which.i=TRUE])-1,]) # get index of previous end date
+ PrevEndEq = getEndEq(aname, PrevDate)
+ Additions = Account$summary[Dates]$Additions
+ Withdrawals = Account$summary[Dates]$Withdrawals
+ NetPerformance = rowSums(Account$summary[Dates,c('Int.Income','Net.Trading.PL', 'Advisory.Fees')])
+ # assign NetPerformance into the account slot
+ Account$summary$Net.Performance[Dates] <- NetPerformance
+
+ # Create a vector of end equity without the previous value?
+ EndCapital = PrevEndEq + Additions + Withdrawals + NetPerformance
+ Account$summary$End.Eq[Dates] <- EndCapital
+
assign(paste("account",aname,sep='.'),Account, envir=.blotter)
return(aname) #not sure this is a good idea
}
More information about the Blotter-commits
mailing list