[Pnl-commits] r4 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 25 17:53:17 CET 2010
Author: mark
Date: 2010-03-25 17:53:17 +0100 (Thu, 25 Mar 2010)
New Revision: 4
Added:
pkg/R/
pkg/R/addDiv.R
pkg/R/addTxn.R
pkg/R/calcDiv.R
pkg/R/calcPnl.R
pkg/R/pnl.R
Log:
Added: pkg/R/addDiv.R
===================================================================
--- pkg/R/addDiv.R (rev 0)
+++ pkg/R/addDiv.R 2010-03-25 16:53:17 UTC (rev 4)
@@ -0,0 +1,14 @@
+#################################################################################
+# Add a cash dividend to the corporate actions
+# Corporate action types for dividends are:
+# 0 = cumdate cash dividend
+# 1 = paydate cash dividend
+#################################################################################
+addDiv <-
+function(corp, cumdate, paydate, amount=0.0) {
+ corp = rbind(corp, xts(matrix(c(0, 1, amount, amount), nrow=2), c(as.Date(cumdate), as.Date(paydate))))
+
+ if(nrow(corp) == 2) colnames(corp) = c("type", "amount")
+
+ return(corp)
+}
Added: pkg/R/addTxn.R
===================================================================
--- pkg/R/addTxn.R (rev 0)
+++ pkg/R/addTxn.R 2010-03-25 16:53:17 UTC (rev 4)
@@ -0,0 +1,17 @@
+#################################################################################
+# Add a transaction
+#
+# @param txn xts timeseries with transactions
+# @author Mark Breman
+# @export
+addTxn <-
+function(txn, date=as.character(Sys.Date()), size=0, price=0.0, fees=0.0) {
+ if(fees > 0) stop("fees must be <= 0")
+
+ txn = rbind(txn, xts(matrix(c(size, price, fees), ncol=3), as.Date(date)))
+
+ if(nrow(txn) == 1) colnames(txn) = c("size", "price", "fees")
+
+ return(txn)
+}
+
Added: pkg/R/calcDiv.R
===================================================================
--- pkg/R/calcDiv.R (rev 0)
+++ pkg/R/calcDiv.R 2010-03-25 16:53:17 UTC (rev 4)
@@ -0,0 +1,47 @@
+##################################################################################
+# Calculate unrealized and realized dividends from corporate actions and transactions,
+# and add to series
+#
+# constraints:
+# - dividends cumdate <= dividends paydate
+# - dividendN cumdate > dividendN-1 paydate
+#
+##################################################################################
+calcDiv <-
+function(series, txn, corp) {
+ divs=corp[which(corp$type %in% c(0,1)),]
+
+ if(!is.null(txn) & !is.null(divs)) {
+ # remove columns from possible previous runs
+ if("rdiv" %in% colnames(series)) series$rdiv = NULL
+ if("diva" %in% colnames(series)) series$diva = NULL
+ if("udiv" %in% colnames(series)) series$udiv = NULL
+
+ divs = rbind(divs, xts(matrix(c(0,0), ncol=2), as.Date(0)))
+ txn = rbind(txn, xts(matrix(c(0,0,0), ncol=3), as.Date(0)))
+
+ txn$pos = cumsum(txn$size)
+ divs = cbind(divs, na.locf(cbind(divs, txn$pos)$pos), join="left")
+
+ # add realized dividends
+ divs$rdiv = round(lag(divs$pos) * divs$amount, 2)
+ series = cbind(series, divs[-1, "rdiv"], fill=0)
+
+ # add dividend amount
+ diva = divs[which(divs$type==0), c("pos", "amount")]
+ colnames(diva) = c("pos", "diva")
+ series = cbind(series, diva[-1, "diva"], fill=0)
+
+ # add unrealized dividend
+ # TODO: udiv should not depend on rdiv, but how?
+ series$udiv = cumsum(round(series[, "diva"] * series[, "pos"] - series$rdiv, 2))
+
+
+ } else {
+ series$diva=0
+ series$udiv = 0
+ series$rdiv = 0
+ }
+
+ return(series)
+}
Added: pkg/R/calcPnl.R
===================================================================
--- pkg/R/calcPnl.R (rev 0)
+++ pkg/R/calcPnl.R 2010-03-25 16:53:17 UTC (rev 4)
@@ -0,0 +1,38 @@
+##################################################################################
+# Calculate trading-, unrealized- and realized pnl from transactions and price
+# series.
+#
+##################################################################################
+calcPnl <-
+function(series, closepricecol, txn) {
+ series$tpnl = (series$pos * series[,closepricecol]) - (lag(series$pos) * lag(series[,closepricecol])) + (-(series$size) * series$price)
+ series[is.na(series$tpnl), "tpnl"] = 0 # remove NA's from top row caused by lag()
+
+ # Calculate realized pnl from transactions
+ if(!is.null(txn)) {
+ if("rpnl" %in% colnames(series)) series$rpnl = NULL
+
+ txn = rbind(txn, xts(matrix(c(0,0,0), ncol=3), as.Date(0)))
+
+ txn$pos = cumsum(txn$size)
+ txn$ec = (-(txn$size) * txn$price) + txn$fees
+ txn$cumec = cumsum(txn$ec)
+
+ txn$rpnl = 0
+ t = unclass(txn)
+ t[which(t[, "pos"]==0), "rpnl"] = c(0, diff(t[which(t[,"pos"]==0), "cumec"]))
+ txn$rpnl = t[, "rpnl"]
+
+ series = cbind(series, as.xts(txn[-1, "rpnl"]), fill=0)
+
+ } else {
+ series$rpnl = 0
+ }
+
+ # TODO: upnl should not depend on rpnl, but how to do this without falling back on a loop?
+ series$upnl = cumsum(series$tpnl + series$fees - series$rpnl)
+
+ series[is.na(series$upnl), "upnl"] = 0 # remove NA from top row caused by cumsum()
+
+ return(series)
+}
Added: pkg/R/pnl.R
===================================================================
--- pkg/R/pnl.R (rev 0)
+++ pkg/R/pnl.R 2010-03-25 16:53:17 UTC (rev 4)
@@ -0,0 +1,44 @@
+###########################################################################################################
+# pnl - Calculate trading-, unrealized- and realized profit and loss.
+#
+# @param pseries xts timeseries with prices
+# @param closepricecol the column number in pseries that holds the close prices
+# @param txn xts timeseries with transactions
+# @param corp xts timeseries with corporate actions
+#
+# @author Mark Breman
+# @export
+pnl <-
+function(pseries, closepricecol=1, txn=NULL, corp=NULL) {
+ if(is.null(txn)) {
+ pseries$size=0
+ pseries$price=0
+ pseries$fees=0
+ pseries$pos=0
+ } else {
+ # for multiple transactions on one date
+ pseries = na.locf(cbind(pseries, index(txn))) # ..also for corp?
+
+ # remove columns from possible previous runs
+ if("size" %in% colnames(pseries)) pseries$size = NULL
+ if("price" %in% colnames(pseries)) pseries$price = NULL
+ if("fees" %in% colnames(pseries)) pseries$fees = NULL
+ if("pos" %in% colnames(pseries)) pseries$pos = NULL
+
+ pseries = cbind(pseries, txn[, c("size", "price", "fees")], fill=0)
+ pseries$pos = cumsum(pseries$size)
+
+ if(is.null(corp)) {
+ pseries$diva=0
+ pseries$udiv=0
+ pseries$rdiv=0
+ } else {
+ pseries = calcDiv(pseries, txn, corp)
+ }
+
+ pseries = calcPnl(pseries, closepricecol, txn)
+ }
+
+ return(pseries[, c("size", "price", "fees", "pos", "diva", "udiv", "rdiv", "tpnl", "upnl", "rpnl")])
+}
+
More information about the pnl-commits
mailing list