[Blotter-commits] r1659 - pkg/blotter/sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 3 18:55:20 CET 2014
Author: bodanker
Date: 2014-12-03 18:55:20 +0100 (Wed, 03 Dec 2014)
New Revision: 1659
Modified:
pkg/blotter/sandbox/blotter_R6.R
Log:
- More blotter_R6 experiments
Modified: pkg/blotter/sandbox/blotter_R6.R
===================================================================
--- pkg/blotter/sandbox/blotter_R6.R 2014-12-01 16:02:39 UTC (rev 1658)
+++ pkg/blotter/sandbox/blotter_R6.R 2014-12-03 17:55:20 UTC (rev 1659)
@@ -18,8 +18,28 @@
# Proposed blotter structure (comments welcome):
# > Account (R6 'Account' object)
+# $ addTxn / addTxns (addAcctTxn)
+# $ addPortfolio
+# $ Returns (AcctReturns)
+# $ PortfReturns (PortfReturns)
+# $ getPortfolioAttribute (getByPortf)
+# $ getEquity (getEndEq)
+# $ updateAcct (updateAcct)
+# $ updateEndEq (updateEndEq)
# -> Portfolios (list|env of R6 'Portfolio' objects)
+# $ addInstrument (addPortfInstr)
+# $ calcPortfWgt (calcPortfWgt)
+# $ getSymbolAttribute (getBySymbol)
+# $ updatePortf
# -> Positions (list|env of R6 'Position' objects)
+# $ addTxn / addTxns (addTxn / addTxns)
+# $ getPos
+# $ getPosQty
+# $ getTxn
+# $ tradeStats
+# $ perTradeStats
+# $ chart.Posn
+# $ chart.ME
# -> Instrument
# -> Transaction
# - trades, splits, dividends, expirations, assignments, etc.
@@ -38,26 +58,153 @@
# If we choose either one, we need to ensure that the "name" member of the
# new Portfolio object matches the "name" of the Account$portfolios "list".
+#acct$portfolios$MyPort$positions$SPY$addTxn()
+
+# Q: Can we add stuff to the public environment internally?
+# A: No, because self is locked
+Simple <- R6Class("Simple",
+ public = list(
+ x = 1,
+ add = function(name, value) {
+ assign(name, value, self)
+ }
+ )
+)
+s <- Simple$new()
+s$add("y",2) # fails
+# but maybe we can lock the binding of the portfolios in the environment?
+Simple <- R6Class("Simple",
+ public = list(
+ initialize = function() {
+ self$portfolios <- new.env()
+ lockBinding("portfolios",self)
+ },
+ x = 1,
+ portfolios = NULL,
+ add = function(name, value) {
+ unlockBinding("portfolios",self)
+ assign(name, value, self$portfolios)
+ lockBinding("portfolios",self)
+ }
+ )
+)
+s <- Simple$new()
+s$add("y",2) # works!
+# but this also works unless the environment is locked...
+rm(y, envir=s$portfolios)
+
+
library(R6)
library(blotter)
+Account <- R6Class(classname = "Account",
+ public = list(
+ portfolios = NULL,
+ initialize = function(portfolios, date, equity, currency) {
+ # create the portfolios environment, then lock its binding
+ # still need to lock portfolios itself though, but there's no
+ # way to unlock environments in base R
+ self$portfolios <- new.env()
+ lockBinding("portfolios", self)
+
+ if(!missing(currency)) private$currency. <- currency
+ },
+ deposit = function(date, amount) {
+ private$deposits. <- rbind(private$deposits., xts(amount, date))
+ #invisible(self) # if you want to allow chained calls
+ },
+ withdrawal = function(date, amount) {
+ private$withdrawals. <- rbind(private$withdrawals., xts(amount, date))
+ #invisible(self) # if you want to allow chained calls
+ },
+ interest = function(date, amount) {
+ private$interest. <- rbind(private$interest., xts(amount, date))
+ #invisible(self) # if you want to allow chained calls
+ },
+ addPortfolio <- function(portfolio) {
+ if(inherits(portfolio, "Portfolio")) {
+ # unlock/relock portfolios environment here too, once it can be unlocked
+ unlockBinding("portfolios", self)
+ assign(portfolio$name, value, portfolios)
+ lockBinding("portfolios", self)
+ #invisible(self) # if you want to allow chained calls
+ } else {
+ stop(deparse(substitute(portfolio)), " is not a Portfolio object", call.=FALSE)
+ }
+ }
+ ),
+ private = list(
+ currency. = NA_character_,
+ deposits. = NULL,
+ interest. = NULL,
+ withdrawals. = NULL
+ ),
+ active = list(
+ equity = function(value) {
+ if(missing(value)) {
+ stop("equity calculation not yet implemented")
+ } else {
+ stop("equity cannot be directly updated")
+ }
+ }
+ )
+)
+
+Portfolio <- R6Class(classname = "Portfolio",
+ public = list(
+ positions = NULL,
+ initialize = function(positions, date, currency) {
+ # create the positions environment, then lock its binding
+ # still need to lock positions itself though, but there's no
+ # way to unlock environments in base R
+ self$positions <- new.env()
+ lockBinding("positions", self)
+
+ if(!missing(currency)) private$currency. <- currency
+ },
+ addPosition <- function(position) {
+ if(inherits(positions, "Position")) {
+ # unlock/relock positions environment here too, once it can be unlocked
+ unlockBinding("positions", self)
+ assign(position$symbol, value, positions)
+ lockBinding("positions", self)
+ #invisible(self) # if you want to allow chained calls
+ } else {
+ stop(deparse(substitute(position)), " is not a Position object", call.=FALSE)
+ }
+ }
+ ),
+ private = list(
+ currency. = NA_character_
+ ),
+ active = list(
+# equity = function(value) {
+# if(missing(value)) {
+# stop("equity calculation not yet implemented")
+# } else {
+# stop("equity cannot be directly updated")
+# }
+# }
+ )
+)
+
# I'm not sure "Position" is the correct name for this thing, but I was trying
# to create the most basic component of the blotter structure.
Position <- R6Class(classname = "Position",
public = list(
#initialize = function(instrument, transactions) {
initialize = function(symbol, transactions, currency) {
- if(!missing(symbol)) private$.symbol <- symbol
- if(!missing(currency)) private$.currency <- currency
+ if(!missing(symbol)) private$symbol. <- symbol
+ if(!missing(currency)) private$currency. <- currency
},
# addTxn {{{
addTxn = function(date, quantity, price, fees=0, ..., ConMult=1, verbose=TRUE) {
- null.txn <- is.null(private$.txn)
+ null.txn <- is.null(private$txn.)
#PrevPosQty <- getPos(date, 'Pos.Qty') # returns position 'as-of' date
if(null.txn)
PrevPosQty <- 0
else {
- PrevPosQty <- private$.txn[paste0("/",date), 'Pos.Qty']
+ PrevPosQty <- private$txn.[paste0("/",date), 'Pos.Qty']
PrevPosQty <- PrevPosQty[nrow(PrevPosQty),]
}
@@ -104,7 +251,7 @@
if(null.txn)
PrevPosAvgCost <- 0
else {
- PrevPosAvgCost <- private$.txn[paste0("/",date), 'Pos.Avg.Cost']
+ PrevPosAvgCost <- private$txn.[paste0("/",date), 'Pos.Avg.Cost']
PrevPosAvgCost <- PrevPosAvgCost[nrow(PrevPosAvgCost),]
}
PosAvgCost <- blotter:::.calcPosAvgCost(PrevPosQty, PrevPosAvgCost, TxnValue, PosQty, ConMult)
@@ -126,42 +273,42 @@
txnCols <- c("Txn.Qty", "Txn.Price", "Txn.Value", "Txn.Avg.Cost",
"Pos.Qty", "Pos.Avg.Cost", "Gross.Txn.Realized.PL", "Txn.Fees",
"Net.Txn.Realized.PL", "Con.Mult")
- private$.txn <- rbind(private$.txn, xts(t(txn), date, dimnames=list(NULL, txnCols)))
+ private$txn. <- rbind(private$txn., xts(t(txn), date, dimnames=list(NULL, txnCols)))
if(verbose)
- print(paste(format(date, "%Y-%m-%d %H:%M:%S"), private$.symbol, quantity, "@", price, sep=" "))
+ print(paste(format(date, "%Y-%m-%d %H:%M:%S"), private$symbol., quantity, "@", price, sep=" "))
invisible(self)
} #}}}
),
private = list(
- .symbol = NA_character_,
- .currency = NA_character_,
- .txn = NULL
+ symbol. = NA_character_,
+ currency. = NA_character_,
+ txn. = NULL
),
# use active bindings for type-checking; is there a better way?
active = list(
symbol = function(value) {
if(missing(value)) {
- private$.symbol
+ private$symbol.
} else {
stop("symbol is read-only")
}
},
currency = function(value) {
if(missing(value)) {
- private$.currency
+ private$currency.
} else {
if(is.character(value) && length(value)==1)
- private$.currency <- value
+ private$currency. <- value
else
stop(deparse(substitute(value)), " is an invalid currency name")
}
},
transactions = function(value) {
if(missing(value)) {
- if(!is.null(private$.txn))
- private$.txn[,c("Txn.Qty", "Txn.Price", "Txn.Fees",
+ if(!is.null(private$txn.))
+ private$txn.[,c("Txn.Qty", "Txn.Price", "Txn.Fees",
"Txn.Value", "Txn.Avg.Cost", "Net.Txn.Realized.PL")]
} else {
stop("use addTxn to add a transaction")
@@ -169,8 +316,8 @@
},
txns = function(value) {
if(missing(value)) {
- if(!is.null(private$.txn))
- private$.txn[,c("Txn.Qty", "Txn.Price", "Txn.Fees",
+ if(!is.null(private$txn.))
+ private$txn.[,c("Txn.Qty", "Txn.Price", "Txn.Fees",
"Txn.Value", "Txn.Avg.Cost", "Net.Txn.Realized.PL")]
} else {
stop("use addTxn to add a transaction")
@@ -178,7 +325,7 @@
},
txn = function(value) {
if(missing(value)) {
- private$.txn
+ private$txn.
} else {
stop("txn is read-only")
}
@@ -213,83 +360,3 @@
}
-
-# other stuff; not sure it's useful
-if(FALSE){
-Portfolio <- R6Class(classname = "Portfolio",
- public = list(
- initialize = function(name, positions, currency) {
- if(!missing(name))
- private$.name <- name
- if(!missing(positions)) {
- if(is.list(positions))
- for(p in positions)
- assign(p$symbol, p, private$.positions)
- else
- assign(positions$symbol, positions, private$.positions)
- }
- },
- update = function(symbols, dates, prices, interval) { }
- ),
- private = list(
- .positions = new.env(hash=TRUE),
- .name = "default"
- ),
- active = list(
- name = function(value) {
- if(missing(value)) {
- private$.name
- } else {
- if(is.character(value) && length(value)==1)
- private$.name <- value
- else
- stop(deparse(substitute(value)), " is an invalid portfolio name")
- }
- },
- positions = function(value) {
- value_name <- deparse(substitute(value))
- if(missing(value)) {
- #if(value_name!="")
- # return a copy of the .positions environment as a list, because
- # we do not want users to be able to change positions manually
- # as.list(get(value_name, private$.positions, inherits=FALSE))
- as.list(private$.positions)
- #else
- # NULL
- } else {
- if(inherits(value, "Position")) {
- assign(value_name, value, private$.positions)
- } else {
- stop(value_name, " is not a Position object", call.=FALSE)
- }
- }
- }
- )
-)
-pos <- Position$new('foo')
-pos$addTxn(Sys.Date()-1L, 10, 90, 0)
-pos$addTxn(Sys.Date(), -10, 100, 0)
-pos$txns
-p <- Portfolio$new("hello_world", pos, "USD")
-p$positions
-
-# prototype
-Positions <- R6Class(classname = "Positions",
- public = list(
- add = function(position) {
- if(missing(position))
- invisible()
- if(inherits(position, "Position")) {
- assign(position$symbol, position, private$.positions)
- } else {
- position_name <- deparse(substitute(position))
- stop(position_name, " is not a Position object", call.=FALSE)
- }
- }
- ),
- private = list(
- .positions = new.env(hash=TRUE)
- )
-)
-}
-
More information about the Blotter-commits
mailing list