From noreply at r-forge.r-project.org Sat Jan 9 00:10:37 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 9 Jan 2016 00:10:37 +0100 (CET) Subject: [Blotter-commits] r1730 - in pkg/quantstrat: R man Message-ID: <20160108231037.CB5A4187490@r-forge.r-project.org> Author: bodanker Date: 2016-01-09 00:10:37 +0100 (Sat, 09 Jan 2016) New Revision: 1730 Modified: pkg/quantstrat/R/ruleRevoke.R pkg/quantstrat/man/ruleRevoke.Rd Log: Only cancel/revoke open orders ruleRevoke would incorrectly revoke all orders, all the time (even closed orders). Add curIndex handling for faster processing, and add a check to ensure updateOrders is called appropriately (ruleSignal has a similar check). Update docs to add '...' to function arguments. Thanks to Joseph Dunn for the report and patch! Modified: pkg/quantstrat/R/ruleRevoke.R =================================================================== --- pkg/quantstrat/R/ruleRevoke.R 2015-12-26 19:19:52 UTC (rev 1729) +++ pkg/quantstrat/R/ruleRevoke.R 2016-01-08 23:10:37 UTC (rev 1730) @@ -18,15 +18,25 @@ #' @param portfolio text name of the portfolio to place orders in #' @param symbol identifier of the instrument to revoke orders for #' @param ruletype must be 'risk' for ruleRevoke, see \code{\link{add.rule}} +#' @param ... any other passthru parameters #' @author Niklas Kolster, Jan Humme #' @seealso \code{\link{osNoOp}} , \code{\link{add.rule}} #' @export -ruleRevoke <- ruleCancel <- function(data=mktdata, timestamp, sigcol, sigval, orderside=NULL, orderset=NULL, portfolio, symbol, ruletype) +ruleRevoke <- ruleCancel <- function(data=mktdata, timestamp, sigcol, sigval, orderside=NULL, orderset=NULL, portfolio, symbol, ruletype, ...) { - if(ruletype!='risk') stop('Ruletype for ruleRevoke or ruleCancel must be "risk".') + if (ruletype != 'risk') { + stop('Ruletype for ruleRevoke or ruleCancel must be "risk".') + } - pos <- getPosQty(portfolio, symbol, timestamp) - if(pos == 0) + # Get row index of timestamp for faster subsetting + if (hasArg(curIndex)) { + curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame()) + } else { + curIndex <- mktdata[timestamp,which.i=TRUE] + } + + if (curIndex > 0 && curIndex <= nrow(mktdata) && + !is.na(mktdata[curIndex,sigcol]) && mktdata[curIndex,sigcol] == sigval) { updateOrders(portfolio=portfolio, symbol=symbol, Modified: pkg/quantstrat/man/ruleRevoke.Rd =================================================================== --- pkg/quantstrat/man/ruleRevoke.Rd 2015-12-26 19:19:52 UTC (rev 1729) +++ pkg/quantstrat/man/ruleRevoke.Rd 2016-01-08 23:10:37 UTC (rev 1730) @@ -5,7 +5,7 @@ \title{rule to revoke(cancel) an unfilled limit order on a signal} \usage{ ruleRevoke(data = mktdata, timestamp, sigcol, sigval, orderside = NULL, - orderset = NULL, portfolio, symbol, ruletype) + orderset = NULL, portfolio, symbol, ruletype, ...) } \arguments{ \item{data}{an xts object containing market data. depending on rules, may need to be in OHLCV or BBO formats, and may include indicator and signal information} @@ -25,6 +25,8 @@ \item{symbol}{identifier of the instrument to revoke orders for} \item{ruletype}{must be 'risk' for ruleRevoke, see \code{\link{add.rule}}} + +\item{...}{any other passthru parameters} } \description{ As described elsewhere in the documentation, quantstrat models From noreply at r-forge.r-project.org Sat Jan 16 14:31:12 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 16 Jan 2016 14:31:12 +0100 (CET) Subject: [Blotter-commits] r1731 - in pkg/blotter/tests: . unitTests Message-ID: <20160116133112.BD7BC1868DF@r-forge.r-project.org> Author: bodanker Date: 2016-01-16 14:31:12 +0100 (Sat, 16 Jan 2016) New Revision: 1731 Added: pkg/blotter/tests/doRUnit.R pkg/blotter/tests/unitTests/ pkg/blotter/tests/unitTests/Makefile pkg/blotter/tests/unitTests/runitAddTxn.R pkg/blotter/tests/unitTests/runitCalcValues.R pkg/blotter/tests/unitTests/runitUpdatePortf.R Removed: pkg/blotter/tests/runitAddTxn.R pkg/blotter/tests/runitCalcValues.R pkg/blotter/tests/runitUpdatePortf.R pkg/blotter/tests/testSuite.R Log: Get unit tests running during R CMD check The RUnit test suite was not set up correctly, so no unit tests were actually being run during R CMD check. While R CMD check reported that it was running tests, it couldn't have actually been running them, because 7 of the tests currently fail. Added: pkg/blotter/tests/doRUnit.R =================================================================== --- pkg/blotter/tests/doRUnit.R (rev 0) +++ pkg/blotter/tests/doRUnit.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -0,0 +1,59 @@ +## unit tests will not be done if RUnit is not available +if(require("RUnit", quietly=TRUE)) { + + ## --- Setup --- + + pkg <- "blotter" # <-- Change to package name! + if(Sys.getenv("RCMDCHECK") == "FALSE") { + ## Path to unit tests for standalone running under Makefile (not R CMD check) + ## PKG/tests/../inst/unitTests + path <- file.path(getwd(), "..", "tests", "unitTests") + } else { + ## Path to unit tests for R CMD check + ## PKG.Rcheck/tests/../PKG/unitTests + path <- system.file(package=pkg, "../tests/unitTests") + } + cat("\nRunning unit tests\n") + print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path)) + + library(package=pkg, character.only=TRUE) + + ## If desired, load the name space to allow testing of private functions + ## if (is.element(pkg, loadedNamespaces())) + ## attach(loadNamespace(pkg), name=paste("namespace", pkg, sep=":"), pos=3) + ## + ## or simply call PKG:::myPrivateFunction() in tests + + ## --- Testing --- + + ## Define tests + testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), + dirs=path) + ## Run + tests <- runTestSuite(testSuite) + + ## Default report name + pathReport <- file.path(path, "report") + + ## Report to stdout and text files + cat("------------------- UNIT TEST SUMMARY ---------------------\n\n") + printTextProtocol(tests, showDetails=FALSE) + printTextProtocol(tests, showDetails=FALSE, + fileName=paste(pathReport, "Summary.txt", sep="")) + printTextProtocol(tests, showDetails=TRUE, + fileName=paste(pathReport, ".txt", sep="")) + + ## Report to HTML file + printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep="")) + + ## Return stop() to cause R CMD check stop in case of + ## - failures i.e. FALSE to unit tests or + ## - errors i.e. R errors + tmp <- getErrors(tests) + if(tmp$nFail > 0 | tmp$nErr > 0) { + stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, + ", #R errors: ", tmp$nErr, ")\n\n", sep="")) + } +} else { + warning("cannot run unit tests -- package RUnit is not available") +} Deleted: pkg/blotter/tests/runitAddTxn.R =================================================================== --- pkg/blotter/tests/runitAddTxn.R 2016-01-08 23:10:37 UTC (rev 1730) +++ pkg/blotter/tests/runitAddTxn.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -1,45 +0,0 @@ -# Author: Peter Carl, RUnit port by Ben McCann - -#Sys.setenv(TZ="America/Chicago") # as the data set got save with this TZ -#options("width"=78) # to tie down the print() statement width -#verbose <- FALSE - -test.addTxn <- function() { - currency("USD") - symbols <- c("IBM") - for (symbol in symbols){ - stock(symbol, currency="USD", multiplier=1) - } - data(IBM) # data included in package - - # Initialize a portfolio object 'p' - # Creating portfolio: - p = initPortf(symbols=symbols) - - # Trades must be made in date order. - # Make a couple of trades in IBM - addTxn(p, "IBM", '2007-01-03', 50, 96.5, TxnFees=0.05 * 50) - addTxn(p, "IBM", '2007-01-04', -50, 97.1, TxnFees=0.05 * 50) - addTxn(p, "IBM", '2007-01-08', -10, 99.2, TxnFees=0.05 * 10) - addTxn(p, "IBM", '2007-01-09', -10, 100.1, TxnFees=0.05 * 10) - addTxn(p, "IBM", '2007-01-17', -10, 100.25, TxnFees=0.05 * 10) - addTxn(p, "IBM", '2007-01-19', 30, 95, TxnFees=0.05 * 30) - addTxn(p, "IBM", '2007-01-22', 25, 96.3, TxnFees=0.05 * 25) - addTxn(p, "IBM", '2007-01-23', 25, 96.42, TxnFees=0.05 * 25) - addTxn(p, "IBM", '2007-01-26', -25, 97.52, TxnFees=0.05 * 25) - addTxn(p, "IBM", '2007-01-31', -25, 98.80, TxnFees=0.05 * 25) - - portfolio <- getPortfolio(p) - transactions <- portfolio[["IBM"]][["txn"]] - checkEquals(13, sum(transactions$Txn.Fees)) - checkEquals(0, sum(transactions$Txn.Qty)) - - # TODO: fix bug in calcPortfSummary - # summary <- calcPortfSummary(portfolio) -} - -.tearDown <- function() { - rm(list=ls(all=TRUE)) - .blotter <- new.env() - .instrument <- new.env() -} Deleted: pkg/blotter/tests/runitCalcValues.R =================================================================== --- pkg/blotter/tests/runitCalcValues.R 2016-01-08 23:10:37 UTC (rev 1730) +++ pkg/blotter/tests/runitCalcValues.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -1,17 +0,0 @@ -# Author: Peter Carl, RUnit port by Ben McCann - -test.calcTxnValue <- function() { - checkEquals(99, calcTxnValue(TxnQty=10, TxnPrice=10, TxnFees=1)) -} - -test.calcTxnAvgCost <- function() { - checkEquals(9.9, calcTxnAvgCost(TxnValue=99, TxnQty=10)) -} - -test.calcPosAvgCost <- function() { - checkEquals(101, calcPosAvgCost(PrevPosQty=10, PrevPosAvgCost=100, TxnValue=1020, PosQty=20)) -} - -test.calcRealizedPL <- function() { - checkEquals(11.2, calcRealizedPL(TxnQty=-10, TxnAvgCost=101.1, PrevPosAvgCost=99.98, PosQty=40, PrevPosQty=50)) -} Deleted: pkg/blotter/tests/runitUpdatePortf.R =================================================================== --- pkg/blotter/tests/runitUpdatePortf.R 2016-01-08 23:10:37 UTC (rev 1730) +++ pkg/blotter/tests/runitUpdatePortf.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -1,34 +0,0 @@ -# Author: Peter Carl, RUnit port by Ben McCann - -.tearDown <- function() { - rm(list=ls(all=TRUE, pos=.blotter), pos=.blotter) - rm(list=ls(all=TRUE, pos=.instrument), pos=.instrument) -} - -test.txnFees <- function() { - data(IBM) # data included in package - currency("USD") - symbols <- c("IBM") - for (symbol in symbols){ - stock(symbol, currency="USD", multiplier=1) - } - - ## simple portfolio with one transaction - p1 <- initPortf(name="p1", symbols=symbols) - p1 <- addTxn(Portfolio="p1", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=0.05*100) - p1 <- updatePortf(Portfolio="p1", Dates='2007-01-03::2007-01-10') - a1 <- initAcct(name="a1", portfolios="p1") - a1 <- updateAcct(a1,'2007-01') - a1 <- updateEndEq(a1,'2007-01') - - ## (really) simple transaction cost function - fiveCents <- function(qty, prc) return(0.05*qty) - p2 <- initPortf(name="p2", symbols=symbols) - p2 <- addTxn(Portfolio="p2", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=fiveCents) - p2 <- updatePortf(Portfolio="p2", Dates='2007-01-03::2007-01-10') - a2 <- initAcct(name="a2", portfolios="p2") - a2 <- updateAcct(a2,'2007-01') - a2 <- updateEndEq(a2,'2007-01') - - checkEquals(getAccount('a1')$summary$End.Eq, getAccount('a2')$summary$End.Eq) -} Deleted: pkg/blotter/tests/testSuite.R =================================================================== --- pkg/blotter/tests/testSuite.R 2016-01-08 23:10:37 UTC (rev 1730) +++ pkg/blotter/tests/testSuite.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -1,18 +0,0 @@ -# RUnit blotter port/framework by Ben McCann - -# Set working directory to this directory before running - -# Load deps -library(RUnit) -library(quantmod) -library(blotter) - -#Load blotter files. When is this necessary? -for (file in list.files("../R", pattern="*.R$", full.names=TRUE)) { - source(file) -} - -# Tests -testsuite.blotter <- defineTestSuite("blotter", dirs = ".") -testResult <- runTestSuite(testsuite.blotter) -printTextProtocol(testResult) Added: pkg/blotter/tests/unitTests/Makefile =================================================================== --- pkg/blotter/tests/unitTests/Makefile (rev 0) +++ pkg/blotter/tests/unitTests/Makefile 2016-01-16 13:31:12 UTC (rev 1731) @@ -0,0 +1,15 @@ +TOP=../.. +PKG=${shell cd ${TOP};pwd} +SUITE=doRUnit.R +R=/usr/bin/R + +all: inst test + +inst: # Install package + cd ${TOP}/..;\ + ${R} CMD INSTALL ${PKG} + +test: # Run unit tests + export RCMDCHECK=FALSE;\ + cd ${TOP}/tests;\ + ${R} --vanilla --slave < ${SUITE} Copied: pkg/blotter/tests/unitTests/runitAddTxn.R (from rev 1721, pkg/blotter/tests/runitAddTxn.R) =================================================================== --- pkg/blotter/tests/unitTests/runitAddTxn.R (rev 0) +++ pkg/blotter/tests/unitTests/runitAddTxn.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -0,0 +1,45 @@ +# Author: Peter Carl, RUnit port by Ben McCann + +#Sys.setenv(TZ="America/Chicago") # as the data set got save with this TZ +#options("width"=78) # to tie down the print() statement width +#verbose <- FALSE + +test.addTxn <- function() { + currency("USD") + symbols <- c("IBM") + for (symbol in symbols){ + stock(symbol, currency="USD", multiplier=1) + } + data(IBM) # data included in package + + # Initialize a portfolio object 'p' + # Creating portfolio: + p = initPortf(symbols=symbols) + + # Trades must be made in date order. + # Make a couple of trades in IBM + addTxn(p, "IBM", '2007-01-03', 50, 96.5, TxnFees=0.05 * 50) + addTxn(p, "IBM", '2007-01-04', -50, 97.1, TxnFees=0.05 * 50) + addTxn(p, "IBM", '2007-01-08', -10, 99.2, TxnFees=0.05 * 10) + addTxn(p, "IBM", '2007-01-09', -10, 100.1, TxnFees=0.05 * 10) + addTxn(p, "IBM", '2007-01-17', -10, 100.25, TxnFees=0.05 * 10) + addTxn(p, "IBM", '2007-01-19', 30, 95, TxnFees=0.05 * 30) + addTxn(p, "IBM", '2007-01-22', 25, 96.3, TxnFees=0.05 * 25) + addTxn(p, "IBM", '2007-01-23', 25, 96.42, TxnFees=0.05 * 25) + addTxn(p, "IBM", '2007-01-26', -25, 97.52, TxnFees=0.05 * 25) + addTxn(p, "IBM", '2007-01-31', -25, 98.80, TxnFees=0.05 * 25) + + portfolio <- getPortfolio(p) + transactions <- portfolio[["IBM"]][["txn"]] + checkEquals(13, sum(transactions$Txn.Fees)) + checkEquals(0, sum(transactions$Txn.Qty)) + + # TODO: fix bug in calcPortfSummary + # summary <- calcPortfSummary(portfolio) +} + +.tearDown <- function() { + rm(list=ls(all=TRUE)) + .blotter <- new.env() + .instrument <- new.env() +} Copied: pkg/blotter/tests/unitTests/runitCalcValues.R (from rev 1721, pkg/blotter/tests/runitCalcValues.R) =================================================================== --- pkg/blotter/tests/unitTests/runitCalcValues.R (rev 0) +++ pkg/blotter/tests/unitTests/runitCalcValues.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -0,0 +1,17 @@ +# Author: Peter Carl, RUnit port by Ben McCann + +test.calcTxnValue <- function() { + checkEquals(99, calcTxnValue(TxnQty=10, TxnPrice=10, TxnFees=1)) +} + +test.calcTxnAvgCost <- function() { + checkEquals(9.9, calcTxnAvgCost(TxnValue=99, TxnQty=10)) +} + +test.calcPosAvgCost <- function() { + checkEquals(101, calcPosAvgCost(PrevPosQty=10, PrevPosAvgCost=100, TxnValue=1020, PosQty=20)) +} + +test.calcRealizedPL <- function() { + checkEquals(11.2, calcRealizedPL(TxnQty=-10, TxnAvgCost=101.1, PrevPosAvgCost=99.98, PosQty=40, PrevPosQty=50)) +} Copied: pkg/blotter/tests/unitTests/runitUpdatePortf.R (from rev 1721, pkg/blotter/tests/runitUpdatePortf.R) =================================================================== --- pkg/blotter/tests/unitTests/runitUpdatePortf.R (rev 0) +++ pkg/blotter/tests/unitTests/runitUpdatePortf.R 2016-01-16 13:31:12 UTC (rev 1731) @@ -0,0 +1,34 @@ +# Author: Peter Carl, RUnit port by Ben McCann + +.tearDown <- function() { + rm(list=ls(all=TRUE, pos=.blotter), pos=.blotter) + rm(list=ls(all=TRUE, pos=.instrument), pos=.instrument) +} + +test.txnFees <- function() { + data(IBM) # data included in package + currency("USD") + symbols <- c("IBM") + for (symbol in symbols){ + stock(symbol, currency="USD", multiplier=1) + } + + ## simple portfolio with one transaction + p1 <- initPortf(name="p1", symbols=symbols) + p1 <- addTxn(Portfolio="p1", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=0.05*100) + p1 <- updatePortf(Portfolio="p1", Dates='2007-01-03::2007-01-10') + a1 <- initAcct(name="a1", portfolios="p1") + a1 <- updateAcct(a1,'2007-01') + a1 <- updateEndEq(a1,'2007-01') + + ## (really) simple transaction cost function + fiveCents <- function(qty, prc) return(0.05*qty) + p2 <- initPortf(name="p2", symbols=symbols) + p2 <- addTxn(Portfolio="p2", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=fiveCents) + p2 <- updatePortf(Portfolio="p2", Dates='2007-01-03::2007-01-10') + a2 <- initAcct(name="a2", portfolios="p2") + a2 <- updateAcct(a2,'2007-01') + a2 <- updateEndEq(a2,'2007-01') + + checkEquals(getAccount('a1')$summary$End.Eq, getAccount('a2')$summary$End.Eq) +} From noreply at r-forge.r-project.org Sat Jan 16 15:48:03 2016 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 16 Jan 2016 15:48:03 +0100 (CET) Subject: [Blotter-commits] r1732 - pkg/blotter/tests/unitTests Message-ID: <20160116144803.2F00518779F@r-forge.r-project.org> Author: bodanker Date: 2016-01-16 15:48:02 +0100 (Sat, 16 Jan 2016) New Revision: 1732 Modified: pkg/blotter/tests/unitTests/runitAddTxn.R pkg/blotter/tests/unitTests/runitCalcValues.R pkg/blotter/tests/unitTests/runitUpdatePortf.R Log: Fix unit tests Some function names have changed to include a leading dot, and they are no longer exported, so we need to access them with the ::: operator. Thanks to cloudcello for the report and patch (#6284). Make transaction fees negative when calling addTxn. Change portfolio and account names to avoid clashing with anything a user might have created. Clean up objects and environments when tests exit (instead of deleting everything). I couldn't figure out how to do it with .setUp/.tearDown, so I used on.exit instead. The issue with .setUp/.tearDown was likely due to scoping issues, and I didn't want to assign to the .GlobalEnv. Remove test.calcRealizedPL because calcRealizedPL was removed in r411. Add test.calcPosAvgCost_C to test C version of .calcPosAvgCost. Modified: pkg/blotter/tests/unitTests/runitAddTxn.R =================================================================== --- pkg/blotter/tests/unitTests/runitAddTxn.R 2016-01-16 13:31:12 UTC (rev 1731) +++ pkg/blotter/tests/unitTests/runitAddTxn.R 2016-01-16 14:48:02 UTC (rev 1732) @@ -1,45 +1,44 @@ # Author: Peter Carl, RUnit port by Ben McCann -#Sys.setenv(TZ="America/Chicago") # as the data set got save with this TZ -#options("width"=78) # to tie down the print() statement width -#verbose <- FALSE - test.addTxn <- function() { + on.exit({ + # remove objects created by unit tests + try(rm_currencies("USD")) + try(rm_stocks(symbols)) + try(rm(list=p, pos=.blotter)) + try(rm(IBM)) + }) + currency("USD") symbols <- c("IBM") for (symbol in symbols){ stock(symbol, currency="USD", multiplier=1) } - data(IBM) # data included in package + data(IBM, package="blotter") # Initialize a portfolio object 'p' # Creating portfolio: - p = initPortf(symbols=symbols) + p <- initPortf("runitAddTxn", symbols=symbols) # Trades must be made in date order. # Make a couple of trades in IBM - addTxn(p, "IBM", '2007-01-03', 50, 96.5, TxnFees=0.05 * 50) - addTxn(p, "IBM", '2007-01-04', -50, 97.1, TxnFees=0.05 * 50) - addTxn(p, "IBM", '2007-01-08', -10, 99.2, TxnFees=0.05 * 10) - addTxn(p, "IBM", '2007-01-09', -10, 100.1, TxnFees=0.05 * 10) - addTxn(p, "IBM", '2007-01-17', -10, 100.25, TxnFees=0.05 * 10) - addTxn(p, "IBM", '2007-01-19', 30, 95, TxnFees=0.05 * 30) - addTxn(p, "IBM", '2007-01-22', 25, 96.3, TxnFees=0.05 * 25) - addTxn(p, "IBM", '2007-01-23', 25, 96.42, TxnFees=0.05 * 25) - addTxn(p, "IBM", '2007-01-26', -25, 97.52, TxnFees=0.05 * 25) - addTxn(p, "IBM", '2007-01-31', -25, 98.80, TxnFees=0.05 * 25) + addTxn(p, "IBM", '2007-01-03', 50, 96.5, TxnFees=-0.05 * 50) + addTxn(p, "IBM", '2007-01-04', -50, 97.1, TxnFees=-0.05 * 50) + addTxn(p, "IBM", '2007-01-08', -10, 99.2, TxnFees=-0.05 * 10) + addTxn(p, "IBM", '2007-01-09', -10, 100.1, TxnFees=-0.05 * 10) + addTxn(p, "IBM", '2007-01-17', -10, 100.25, TxnFees=-0.05 * 10) + addTxn(p, "IBM", '2007-01-19', 30, 95, TxnFees=-0.05 * 30) + addTxn(p, "IBM", '2007-01-22', 25, 96.3, TxnFees=-0.05 * 25) + addTxn(p, "IBM", '2007-01-23', 25, 96.42, TxnFees=-0.05 * 25) + addTxn(p, "IBM", '2007-01-26', -25, 97.52, TxnFees=-0.05 * 25) + addTxn(p, "IBM", '2007-01-31', -25, 98.80, TxnFees=-0.05 * 25) portfolio <- getPortfolio(p) - transactions <- portfolio[["IBM"]][["txn"]] - checkEquals(13, sum(transactions$Txn.Fees)) + transactions <- portfolio$symbols[["IBM"]]$txn + checkEquals(-13, sum(transactions$Txn.Fees)) checkEquals(0, sum(transactions$Txn.Qty)) # TODO: fix bug in calcPortfSummary # summary <- calcPortfSummary(portfolio) } -.tearDown <- function() { - rm(list=ls(all=TRUE)) - .blotter <- new.env() - .instrument <- new.env() -} Modified: pkg/blotter/tests/unitTests/runitCalcValues.R =================================================================== --- pkg/blotter/tests/unitTests/runitCalcValues.R 2016-01-16 13:31:12 UTC (rev 1731) +++ pkg/blotter/tests/unitTests/runitCalcValues.R 2016-01-16 14:48:02 UTC (rev 1732) @@ -1,17 +1,18 @@ # Author: Peter Carl, RUnit port by Ben McCann test.calcTxnValue <- function() { - checkEquals(99, calcTxnValue(TxnQty=10, TxnPrice=10, TxnFees=1)) + checkEquals(99, blotter:::.calcTxnValue(TxnQty=10, TxnPrice=10, TxnFees=1)) } test.calcTxnAvgCost <- function() { - checkEquals(9.9, calcTxnAvgCost(TxnValue=99, TxnQty=10)) + checkEquals(9.9, blotter:::.calcTxnAvgCost(TxnValue=99, TxnQty=10)) } test.calcPosAvgCost <- function() { - checkEquals(101, calcPosAvgCost(PrevPosQty=10, PrevPosAvgCost=100, TxnValue=1020, PosQty=20)) + checkEquals(101, blotter:::.calcPosAvgCost(PrevPosQty=10, PrevPosAvgCost=100, TxnValue=1020, PosQty=20)) } -test.calcRealizedPL <- function() { - checkEquals(11.2, calcRealizedPL(TxnQty=-10, TxnAvgCost=101.1, PrevPosAvgCost=99.98, PosQty=40, PrevPosQty=50)) +test.calcPosAvgCost_C <- function() { + checkEquals(101, blotter:::.calcPosAvgCost_C(PrevPosQty=10, PrevPosAvgCost=100, TxnValue=1020, PosQty=20)) } + Modified: pkg/blotter/tests/unitTests/runitUpdatePortf.R =================================================================== --- pkg/blotter/tests/unitTests/runitUpdatePortf.R 2016-01-16 13:31:12 UTC (rev 1731) +++ pkg/blotter/tests/unitTests/runitUpdatePortf.R 2016-01-16 14:48:02 UTC (rev 1732) @@ -1,34 +1,37 @@ # Author: Peter Carl, RUnit port by Ben McCann -.tearDown <- function() { - rm(list=ls(all=TRUE, pos=.blotter), pos=.blotter) - rm(list=ls(all=TRUE, pos=.instrument), pos=.instrument) -} +test.txnFees <- function() { + on.exit({ + # remove objects created by unit tests + try(rm_currencies("USD")) + try(rm_stocks(symbols)) + try(rm(list=c(p1,a1), pos=.blotter)) + try(rm(IBM)) + }) -test.txnFees <- function() { - data(IBM) # data included in package currency("USD") symbols <- c("IBM") for (symbol in symbols){ stock(symbol, currency="USD", multiplier=1) } + data(IBM, package="blotter") ## simple portfolio with one transaction - p1 <- initPortf(name="p1", symbols=symbols) - p1 <- addTxn(Portfolio="p1", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=0.05*100) - p1 <- updatePortf(Portfolio="p1", Dates='2007-01-03::2007-01-10') - a1 <- initAcct(name="a1", portfolios="p1") + p1 <- initPortf(name="p1runitUpdatePortf", symbols=symbols) + p1 <- addTxn(Portfolio="p1runitUpdatePortf", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=-0.05*100) + p1 <- updatePortf(Portfolio="p1runitUpdatePortf", Dates='2007-01-03::2007-01-10') + a1 <- initAcct(name="a1runitUpdatePortf", portfolios="p1runitUpdatePortf") a1 <- updateAcct(a1,'2007-01') a1 <- updateEndEq(a1,'2007-01') ## (really) simple transaction cost function - fiveCents <- function(qty, prc) return(0.05*qty) - p2 <- initPortf(name="p2", symbols=symbols) - p2 <- addTxn(Portfolio="p2", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=fiveCents) - p2 <- updatePortf(Portfolio="p2", Dates='2007-01-03::2007-01-10') - a2 <- initAcct(name="a2", portfolios="p2") + fiveCents <- function(qty, prc, ...) return(-0.05*qty) + p2 <- initPortf(name="p2runitUpdatePortf", symbols=symbols) + p2 <- addTxn(Portfolio="p2runitUpdatePortf", Symbol="IBM", TxnDate='2007-01-04', TxnQty=100, TxnPrice=96.5, TxnFees=fiveCents) + p2 <- updatePortf(Portfolio="p2runitUpdatePortf", Dates='2007-01-03::2007-01-10') + a2 <- initAcct(name="a2runitUpdatePortf", portfolios="p2runitUpdatePortf") a2 <- updateAcct(a2,'2007-01') a2 <- updateEndEq(a2,'2007-01') - checkEquals(getAccount('a1')$summary$End.Eq, getAccount('a2')$summary$End.Eq) + checkEquals(getAccount(a1)$summary$End.Eq, getAccount(a2)$summary$End.Eq) }