From noreply at r-forge.r-project.org Fri Nov 1 16:51:45 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Nov 2013 16:51:45 +0100 (CET) Subject: [Blotter-commits] r1561 - pkg/quantstrat/R Message-ID: <20131101155145.9C88018616A@r-forge.r-project.org> Author: bodanker Date: 2013-11-01 16:51:45 +0100 (Fri, 01 Nov 2013) New Revision: 1561 Modified: pkg/quantstrat/R/indicators.R pkg/quantstrat/R/initialize.R pkg/quantstrat/R/rules.R pkg/quantstrat/R/signals.R pkg/quantstrat/R/wrapup.R Log: - update modify.args handling of '...' Modified: pkg/quantstrat/R/indicators.R =================================================================== --- pkg/quantstrat/R/indicators.R 2013-10-31 12:14:45 UTC (rev 1560) +++ pkg/quantstrat/R/indicators.R 2013-11-01 15:51:45 UTC (rev 1561) @@ -172,9 +172,11 @@ .formals <- formals(indicator$name) .formals <- modify.args(.formals, indicator$arguments, dots=TRUE) # now add arguments from parameters - .formals <- modify.args(.formals, parameters) + .formals <- modify.args(.formals, parameters, dots=TRUE) # now add dots - .formals <- modify.args(.formals, ...) + .formals <- modify.args(.formals, NULL, ..., dots=TRUE) + # remove ... to avoid matching multiple args + .formals$`...` <- NULL tmp_val <- do.call(indicator$name, .formals) Modified: pkg/quantstrat/R/initialize.R =================================================================== --- pkg/quantstrat/R/initialize.R 2013-10-31 12:14:45 UTC (rev 1560) +++ pkg/quantstrat/R/initialize.R 2013-11-01 15:51:45 UTC (rev 1561) @@ -98,9 +98,11 @@ .formals <- formals(init_o$name) .formals <- modify.args(.formals, init_o$arguments, dots=TRUE) # now add arguments from parameters - .formals <- modify.args(.formals, parameters) + .formals <- modify.args(.formals, parameters, dots=TRUE) # now add dots - .formals <- modify.args(.formals, ...) + .formals <- modify.args(.formals, NULL, ..., dots=TRUE) + # remove ... to avoid matching multiple args + .formals$`...` <- NULL do.call(init_o$name, .formals) } Modified: pkg/quantstrat/R/rules.R =================================================================== --- pkg/quantstrat/R/rules.R 2013-10-31 12:14:45 UTC (rev 1560) +++ pkg/quantstrat/R/rules.R 2013-11-01 15:51:45 UTC (rev 1561) @@ -693,9 +693,11 @@ .formals <- formals(rule$name) .formals <- modify.args(.formals, rule$arguments, dots=TRUE) # now add arguments from parameters - .formals <- modify.args(.formals, parameters) + .formals <- modify.args(.formals, parameters, dots=TRUE) # now add dots - .formals <- modify.args(.formals, ..., dots=TRUE) + .formals <- modify.args(.formals, NULL, ..., dots=TRUE) + # remove ... to avoid matching multiple args + .formals$`...` <- NULL # any rule-specific prefer-parameters should override global prefer parameter if(!is.null(rule$arguments$prefer)) .formals$prefer = rule$arguments$prefer Modified: pkg/quantstrat/R/signals.R =================================================================== --- pkg/quantstrat/R/signals.R 2013-10-31 12:14:45 UTC (rev 1560) +++ pkg/quantstrat/R/signals.R 2013-11-01 15:51:45 UTC (rev 1561) @@ -103,9 +103,11 @@ .formals <- formals(signal$name) .formals <- modify.args(.formals, signal$arguments, dots=TRUE) # now add arguments from parameters - .formals <- modify.args(.formals, parameters) + .formals <- modify.args(.formals, parameters, dots=TRUE) # now add dots - .formals <- modify.args(.formals, ...) + .formals <- modify.args(.formals, NULL, ..., dots=TRUE) + # remove ... to avoid matching multiple args + .formals$`...` <- NULL tmp_val <- do.call(signal$name, .formals) Modified: pkg/quantstrat/R/wrapup.R =================================================================== --- pkg/quantstrat/R/wrapup.R 2013-10-31 12:14:45 UTC (rev 1560) +++ pkg/quantstrat/R/wrapup.R 2013-11-01 15:51:45 UTC (rev 1561) @@ -113,9 +113,11 @@ .formals <- formals(wrapup_o$name) .formals <- modify.args(.formals, wrapup_o$arguments, dots=TRUE) # now add arguments from parameters - .formals <- modify.args(.formals, parameters) + .formals <- modify.args(.formals, parameters, dots=TRUE) # now add dots - .formals <- modify.args(.formals, ...) + .formals <- modify.args(.formals, NULL, ..., dots=TRUE) + # remove ... to avoid matching multiple args + .formals$`...` <- NULL out[[wrapup_o$name]] <- do.call(wrapup_o$name, .formals) } From noreply at r-forge.r-project.org Sat Nov 2 19:04:32 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 2 Nov 2013 19:04:32 +0100 (CET) Subject: [Blotter-commits] r1562 - in pkg/quantstrat: . R src Message-ID: <20131102180432.73EF818536B@r-forge.r-project.org> Author: bodanker Date: 2013-11-02 19:04:32 +0100 (Sat, 02 Nov 2013) New Revision: 1562 Added: pkg/quantstrat/src/ pkg/quantstrat/src/firstThreshold.c Modified: pkg/quantstrat/NAMESPACE pkg/quantstrat/R/rules.R pkg/quantstrat/R/signals.R Log: - replace which(sigThreshold(...))[1] with C-based .firstThreshold function - only sort dindex if necessary; xts::isOrdered provides a quick check Modified: pkg/quantstrat/NAMESPACE =================================================================== --- pkg/quantstrat/NAMESPACE 2013-11-01 15:51:45 UTC (rev 1561) +++ pkg/quantstrat/NAMESPACE 2013-11-02 18:04:32 UTC (rev 1562) @@ -52,3 +52,4 @@ export(updateOrders) export(updateStrategy) export(walk.forward) +useDynLib(quantstrat) Modified: pkg/quantstrat/R/rules.R =================================================================== --- pkg/quantstrat/R/rules.R 2013-11-01 15:51:45 UTC (rev 1561) +++ pkg/quantstrat/R/rules.R 2013-11-02 18:04:32 UTC (rev 1562) @@ -269,7 +269,9 @@ #remove.Data <- function(x) remove(x, .Data) get.dindex <- function() get("dindex",pos=.Data) # inherits=TRUE) assign.dindex <- function(dindex) { - dindex<-sort(unique(dindex)) + dindex <- unique(dindex) + if(!isOrdered(dindex)) + dindex <- sort(dindex) #print(dindex) assign("dindex", dindex, .Data) } @@ -409,11 +411,11 @@ } if (is.na(col)) stop("no price discernable for stoplimit in applyRules") } - cross<-sigThreshold(label='tmpstop',data=mktdata,column=col,threshold=tmpprice,relationship=relationship) - cross <- cross[timespan][-1] # don't look for crosses on curIndex - if(any(cross)){ + # use .firstThreshold to find the location of the first tmpprice that crosses mktdata[,col] + cross <- .firstThreshold(data=mktdata, col, tmpprice, relationship, start=curIndex+1) # don't look for crosses on curIndex + if(cross < nrow(mktdata)){ # find first index that would cross after this index - newidx <- curIndex + which(cross)[1] + newidx <- cross # insert that into dindex assign.dindex(c(get.dindex(),newidx)) } @@ -457,10 +459,9 @@ } if (is.na(col)) stop("no price discernable for limit in applyRules") } - # use sigThreshold - cross<-sigThreshold(label='tmplimit',data=mktdata,column=col,threshold=tmpprice,relationship=relationship) - cross <- cross[timespan][-1] # don't look for crosses on curIndex - if(any(cross)){ + # use .firstThreshold to find the location of the first tmpprice that crosses mktdata[,col] + cross <- .firstThreshold(data=mktdata, col, tmpprice, relationship, start=curIndex+1) # don't look for crosses on curIndex + if(cross < nrow(mktdata)){ # find first index that would cross after this index # # current index = which(cross[timespan])[1] @@ -468,7 +469,7 @@ # need to subtract 1 index==1 means current position # # newidx <- curIndex + which(cross[timespan])[1] #- 1 #curIndex/timestamp was 1 in the subset, we need a -1 offset? - newidx <- curIndex + which(cross)[1] + newidx <- cross #if there are is no cross curIndex will be incremented on line 496 # with curIndex<-min(dindex[dindex>curIndex]). @@ -529,11 +530,11 @@ relationship="lte" } # check if order will be filled - cross <- sigThreshold(data=mkt_price_series, label='tmptrail',column=col,threshold=tmpprice,relationship=relationship) - + # use .firstThreshold to find the location of the first tmpprice that crosses mktdata[,col] + cross <- .firstThreshold(data=mktdata, col, tmpprice, relationship, start=curIndex+1) # don't look for crosses on curIndex # update dindex if order is moved or filled - if(any(move_order) || any(cross)){ - moveidx <- curIndex + min(which(move_order)[1], which(cross)[1], na.rm=TRUE) + if(any(move_order) || cross < nrow(mktdata)){ + moveidx <- curIndex + min(which(move_order)[1], cross, na.rm=TRUE) assign.dindex(c(get.dindex(), moveidx)) } } # end loop over open trailing orders Modified: pkg/quantstrat/R/signals.R =================================================================== --- pkg/quantstrat/R/signals.R 2013-11-01 15:51:45 UTC (rev 1561) +++ pkg/quantstrat/R/signals.R 2013-11-02 18:04:32 UTC (rev 1562) @@ -272,10 +272,29 @@ 'le' = {ret_sig = data[,colNum] <= threshold} ) if(isTRUE(cross)) ret_sig <- diff(ret_sig)==1 - colnames(ret_sig)<-label + if(!missing(label)) # colnames<- copies; avoid if possible + colnames(ret_sig)<-label return(ret_sig) } +#' @useDynLib quantstrat +.firstThreshold <- function(data=mktdata, column, threshold=0, relationship, start=1) { + colNum <- match.names(column, colnames(data)) + rel <- switch(relationship[1], + '>' = , + 'gt' = 1, + '<' = , + 'lt' = 2, + 'eq' = 3, #FIXME any way to specify '='? + 'gte' = , + 'gteq' = , + 'ge' = 4, #FIXME these fail with an 'unexpected =' error if you use '>=' + 'lte' = , + 'lteq' = , + 'le' = 5) + .Call('firstThreshold', data[,colNum], threshold, rel, start) +} + #' generate a signal from a formula #' #' This code takes advantage of some base R functionality that can treat an R object (in this case the internal mktdata object in quantstrat) as an environment or 'frame' using \code{\link{parent.frame}}. Added: pkg/quantstrat/src/firstThreshold.c =================================================================== --- pkg/quantstrat/src/firstThreshold.c (rev 0) +++ pkg/quantstrat/src/firstThreshold.c 2013-11-02 18:04:32 UTC (rev 1562) @@ -0,0 +1,55 @@ +#include +#include + +SEXP firstThreshold(SEXP x, SEXP th, SEXP rel, SEXP start) +{ + int i, int_rel, int_start; + double *real_x=NULL, real_th; + + if(ncols(x) > 1) + error("only univariate data allowed"); + + /* this currently only works for real x and th arguments + * support for other types may be added later */ + real_th = asReal(th); + int_rel = asInteger(rel); + int_start = asInteger(start)-1; + + switch(int_rel) { + case 1: /* > */ + real_x = REAL(x); + for(i=int_start; i real_th) + return(ScalarInteger(i+1)); + break; + case 2: /* < */ + real_x = REAL(x); + for(i=int_start; i= */ + real_x = REAL(x); + for(i=int_start; i= real_th) + return(ScalarInteger(i+1)); + break; + case 5: /* <= */ + real_x = REAL(x); + for(i=int_start; i Author: bodanker Date: 2013-11-04 15:56:55 +0100 (Mon, 04 Nov 2013) New Revision: 1563 Modified: pkg/blotter/R/updatePosPL.R Log: - drop dims so recycling will occur - fix column names Modified: pkg/blotter/R/updatePosPL.R =================================================================== --- pkg/blotter/R/updatePosPL.R 2013-11-02 18:04:32 UTC (rev 1562) +++ pkg/blotter/R/updatePosPL.R 2013-11-04 14:56:55 UTC (rev 1563) @@ -183,7 +183,7 @@ if(ncol(FXrate)>1) CcyMult <- getPrice(FXrate[dateRange],...) else CcyMult <- FXrate[dateRange] CcyMult <- na.locf(merge(CcyMult,index(TmpPeriods))) - CcyMult <- drop(CcyMult[index(TmpPeriods)]) + CcyMult <- CcyMult[index(TmpPeriods)] } else { CcyMult<-as.numeric(FXrate) } @@ -200,8 +200,8 @@ } else { #multiply the correct columns columns<-c('Pos.Value', 'Txn.Value', 'Pos.Avg.Cost', 'Period.Realized.PL', 'Period.Unrealized.PL','Gross.Trading.PL', 'Txn.Fees', 'Net.Trading.PL') - TmpPeriods[,columns]<-TmpPeriods[,columns]*CcyMult - TmpPeriods[,'Ccy.Mult']<-CcyMult + TmpPeriods[,columns] <- TmpPeriods[,columns] * drop(CcyMult) # drop dims so recycling will occur + TmpPeriods[,'Ccy.Mult'] <- CcyMult #add change in Pos.Value in base currency LagValue <- as.numeric(last(Portfolio[['symbols']][[Symbol]][[paste('posPL',p.ccy.str,sep='.')]][,'Pos.Value'])) @@ -209,8 +209,8 @@ LagPos.Value <- lag(TmpPeriods[,'Pos.Value'],1) LagPos.Value[1] <- LagValue CcyMove <- TmpPeriods[,'Pos.Value'] - LagPos.Value - TmpPeriods[,'Txn.Value'] - TmpPeriods[,'Period.Unrealized.PL'] - TmpPeriods[,'Period.Realized.PL'] - columns<-c('Gross.Trading.PL','Net.Trading.PL','Period.Unrealized') - TmpPeriods[,columns] <- TmpPeriods[,columns] + CcyMove + columns<-c('Gross.Trading.PL','Net.Trading.PL','Period.Unrealized.PL') + TmpPeriods[,columns] <- TmpPeriods[,columns] + drop(CcyMove) # drop dims so recycling will occur #stick it in posPL.ccy Portfolio[['symbols']][[Symbol]][[paste('posPL',p.ccy.str,sep='.')]]<-rbind(Portfolio[['symbols']][[Symbol]][[paste('posPL',p.ccy.str,sep='.')]],TmpPeriods) From noreply at r-forge.r-project.org Mon Nov 4 17:53:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 4 Nov 2013 17:53:04 +0100 (CET) Subject: [Blotter-commits] r1564 - pkg/quantstrat/R Message-ID: <20131104165304.A7AB9185024@r-forge.r-project.org> Author: bodanker Date: 2013-11-04 17:53:04 +0100 (Mon, 04 Nov 2013) New Revision: 1564 Modified: pkg/quantstrat/R/rules.R Log: - get curIndex from '...' if rule$timespan isn't NULL; thanks to Jan Humme Modified: pkg/quantstrat/R/rules.R =================================================================== --- pkg/quantstrat/R/rules.R 2013-11-04 14:56:55 UTC (rev 1563) +++ pkg/quantstrat/R/rules.R 2013-11-04 16:53:04 UTC (rev 1564) @@ -683,7 +683,15 @@ if(!isTRUE(rule$enabled)) next() # check to see if we should run in this timespan - if(!is.null(rule$timespan) && nrow(mktdata[curIndex][rule$timespan])==0) next() + if(!is.null(rule$timespan)) { + # Get row index of timestamp for faster subsetting + if(hasArg(curIndex)) + curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame()) + else + curIndex <- timestamp + if(nrow(mktdata[curIndex][rule$timespan])==0) + next() + } # modify a few things rule$arguments$timestamp = timestamp From noreply at r-forge.r-project.org Mon Nov 4 21:15:00 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 4 Nov 2013 21:15:00 +0100 (CET) Subject: [Blotter-commits] r1565 - in pkg/quantstrat: R demo Message-ID: <20131104201500.BC5A8185113@r-forge.r-project.org> Author: opentrades Date: 2013-11-04 21:15:00 +0100 (Mon, 04 Nov 2013) New Revision: 1565 Modified: pkg/quantstrat/R/paramsets.R pkg/quantstrat/demo/luxor.3.paramset.sma.R pkg/quantstrat/demo/luxor.4.paramset.timespan.R Log: - fixed single paramset distribution - fixed luxor demo 4 timespans - small output file name adjustment for luxor.3 and luxor.4 demos Modified: pkg/quantstrat/R/paramsets.R =================================================================== --- pkg/quantstrat/R/paramsets.R 2013-11-04 16:53:04 UTC (rev 1564) +++ pkg/quantstrat/R/paramsets.R 2013-11-04 20:15:00 UTC (rev 1565) @@ -36,6 +36,11 @@ # ############################################################################### +# TODO: fix put.portfolio() to use environments +# TODO: fix expand.grid +# TODO: "and" multiple constraints i.o. "or" + + #require(foreach, quietly=TRUE) require('foreach') #require(iterators, quietly=TRUE) @@ -141,9 +146,13 @@ nsamples <- min(nsamples, nrow(param.combos)) param.combos <- param.combos[sample(nrow(param.combos), size=nsamples),] - param.combos <- param.combos[with(param.combos,order(param.combos[,1],param.combos[,2])),] + + if(NCOL(param.combos) == 1) + param.combos <- param.combos[order(param.combos)] + else + param.combos <- param.combos[with(param.combos,order(param.combos[,1],param.combos[,2])),] - param.combos + data.frame(param.combos) } install.param.combo <- function(strategy, param.combo, paramset.label) Modified: pkg/quantstrat/demo/luxor.3.paramset.sma.R =================================================================== --- pkg/quantstrat/demo/luxor.3.paramset.sma.R 2013-11-04 16:53:04 UTC (rev 1564) +++ pkg/quantstrat/demo/luxor.3.paramset.sma.R 2013-11-04 20:15:00 UTC (rev 1565) @@ -46,5 +46,5 @@ print(stats) -save(stats, file='luxor.3.paramset.SMA.RData') +save(stats, file='luxor.3.paramset.sma.RData') Modified: pkg/quantstrat/demo/luxor.4.paramset.timespan.R =================================================================== --- pkg/quantstrat/demo/luxor.4.paramset.timespan.R 2013-11-04 16:53:04 UTC (rev 1564) +++ pkg/quantstrat/demo/luxor.4.paramset.timespan.R 2013-11-04 20:15:00 UTC (rev 1565) @@ -8,8 +8,6 @@ # # Paragraph 3.4: luxor timespan paramset optimization -stop('#### DEMO BROKEN - BEING FIXED ###') - require(quantstrat) source(paste0(path.package("quantstrat"),"/demo/luxor.include.R")) @@ -47,5 +45,5 @@ print(stats) -save(stats, file='luxor.4.paramset.Timespan.RData') +save(stats, file='luxor.4.paramset.timespan.RData') From noreply at r-forge.r-project.org Sat Nov 9 01:02:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 9 Nov 2013 01:02:25 +0100 (CET) Subject: [Blotter-commits] r1566 - in pkg/quantstrat: . R man Message-ID: <20131109000225.B8D57184FD6@r-forge.r-project.org> Author: bodanker Date: 2013-11-09 01:02:24 +0100 (Sat, 09 Nov 2013) New Revision: 1566 Modified: pkg/quantstrat/DESCRIPTION pkg/quantstrat/R/paramsets.R pkg/quantstrat/man/apply.paramset.Rd Log: - allow user-supplied paramsets - pass '...' to updatePortf and applyStrategy - don't specify Dates/Prices in updatePorf (they may be in '...') - set .maxcombine to work if param.combos only has 1 row - bump version Modified: pkg/quantstrat/DESCRIPTION =================================================================== --- pkg/quantstrat/DESCRIPTION 2013-11-04 20:15:00 UTC (rev 1565) +++ pkg/quantstrat/DESCRIPTION 2013-11-09 00:02:24 UTC (rev 1566) @@ -1,7 +1,7 @@ Package: quantstrat Type: Package Title: Quantitative Strategy Model Framework -Version: 0.7.11 +Version: 0.8.0 Date: $Date$ Author: Peter Carl, Brian G. Peterson, Joshua Ulrich, Jan Humme Depends: Modified: pkg/quantstrat/R/paramsets.R =================================================================== --- pkg/quantstrat/R/paramsets.R 2013-11-04 20:15:00 UTC (rev 1565) +++ pkg/quantstrat/R/paramsets.R 2013-11-09 00:02:24 UTC (rev 1566) @@ -361,13 +361,14 @@ #' @param packages a vector specifying names of R packages to be loaded by the slave, default NULL #' @param audit a user-specified environment to store a copy of all portfolios, orderbooks and other data from the tests, or NULL to trash this information #' @param verbose return full information, in particular the .blotter environment, default FALSE +#' @param paramsets a user-sepcified (sub)set of paramsets to run #' @param ... any other passthru parameters #' #' @author Jan Humme #' @export #' @seealso \code{\link{add.distribution.constraint}}, \code{\link{add.distribution.constraint}}, \code{\link{delete.paramset}} -apply.paramset <- function(strategy.st, paramset.label, portfolio.st, account.st, mktdata=NULL, nsamples=0, user.func=NULL, user.args=NULL, calc='slave', audit=NULL, packages=NULL, verbose=FALSE, ...) +apply.paramset <- function(strategy.st, paramset.label, portfolio.st, account.st, mktdata=NULL, nsamples=0, user.func=NULL, user.args=NULL, calc='slave', audit=NULL, packages=NULL, verbose=FALSE, paramsets, ...) { must.have.args(match.call(), c('strategy.st', 'paramset.label', 'portfolio.st')) @@ -383,11 +384,17 @@ distributions <- strategy$paramsets[[paramset.label]]$distributions constraints <- strategy$paramsets[[paramset.label]]$constraints - param.combos <- expand.distributions(distributions) - param.combos <- apply.constraints(constraints, distributions, param.combos) - rownames(param.combos) <- NULL # reset rownames - if(nsamples > 0) - param.combos <- select.samples(nsamples, param.combos) + if(missing(paramsets)) + { + param.combos <- expand.distributions(distributions) + param.combos <- apply.constraints(constraints, distributions, param.combos) + param.combos <- expand.constrained.distributions(constraints, distributions) + rownames(param.combos) <- NULL # reset rownames + if(nsamples > 0) + param.combos <- select.samples(nsamples, param.combos) + } else { + param.combos <- paramsets + } env.functions <- c('clone.portfolio', 'clone.orderbook', 'install.param.combo') env.instrument <- as.list(FinancialInstrument:::.instrument) @@ -417,7 +424,7 @@ if(calc == 'master') { # calculate tradeStats on portfolio - updatePortf(r$portfolio.st, Dates=paste('::',as.Date(Sys.time()),sep=''), Prices=mktdata) + updatePortf(r$portfolio.st, ...) r$tradeStats <- tradeStats(r$portfolio.st) # run user specified function, if they provided one @@ -438,11 +445,18 @@ return(results) } - results <- foreach(param.combo=iter(param.combos,by='row'), + # create foreach object + fe <- foreach(param.combo=iter(param.combos,by='row'), .verbose=verbose, .errorhandling='pass', .packages=c('quantstrat', packages), - .combine=combine, .multicombine=TRUE, .maxcombine=nrow(param.combos), - .export=c(env.functions, 'env.instrument')) %dopar% + .combine=combine, .multicombine=TRUE, .maxcombine=max(2,nrow(param.combos)), + .export=c(env.functions, 'env.instrument'), ...) + # remove all but the param.combo iterator before calling %dopar% + # this allows us to pass '...' through foreach to the expression + fe$args <- fe$args[1] + fe$argnames <- fe$argnames[1] + # now call %dopar% + results <- fe %dopar% { print(param.combo) @@ -501,7 +515,7 @@ if(calc == 'slave') { - updatePortf(result$portfolio.st, Dates=paste('::',as.Date(Sys.time()),sep=''), Prices=mktdata, ...) + updatePortf(result$portfolio.st, ...) result$tradeStats <- tradeStats(result$portfolio.st) if(!is.null(user.func) && !is.null(user.args)) Modified: pkg/quantstrat/man/apply.paramset.Rd =================================================================== --- pkg/quantstrat/man/apply.paramset.Rd 2013-11-04 20:15:00 UTC (rev 1565) +++ pkg/quantstrat/man/apply.paramset.Rd 2013-11-09 00:02:24 UTC (rev 1566) @@ -5,7 +5,8 @@ apply.paramset(strategy.st, paramset.label, portfolio.st, account.st, mktdata = NULL, nsamples = 0, user.func = NULL, user.args = NULL, calc = "slave", - audit = NULL, packages = NULL, verbose = FALSE, ...) + audit = NULL, packages = NULL, verbose = FALSE, + paramsets, ...) } \arguments{ \item{strategy.st}{the name of the strategy object} @@ -50,6 +51,9 @@ \item{verbose}{return full information, in particular the .blotter environment, default FALSE} + \item{paramsets}{a user-sepcified (sub)set of paramsets + to run} + \item{...}{any other passthru parameters} } \description{ From noreply at r-forge.r-project.org Sat Nov 9 01:04:44 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 9 Nov 2013 01:04:44 +0100 (CET) Subject: [Blotter-commits] r1567 - pkg/blotter/R Message-ID: <20131109000444.6407B1853AE@r-forge.r-project.org> Author: bodanker Date: 2013-11-09 01:04:43 +0100 (Sat, 09 Nov 2013) New Revision: 1567 Modified: pkg/blotter/R/updatePortf.R pkg/blotter/R/updatePosPL.R Log: - updatePortf (and .updatePosPL) gain an 'Interval' argument Modified: pkg/blotter/R/updatePortf.R =================================================================== --- pkg/blotter/R/updatePortf.R 2013-11-09 00:02:24 UTC (rev 1566) +++ pkg/blotter/R/updatePortf.R 2013-11-09 00:04:43 UTC (rev 1567) @@ -11,11 +11,14 @@ #' #' @param Portfolio string identifying a portfolio #' @param Symbols character vector identifying symbols to update the portfolio for, default NULL -#' @param Dates xts-style ISO-8601 time range to run updatePortf over, default NULL (will use times from Prices +#' @param Dates optional xts-style ISO-8601 time range to run updatePortf over, default NULL (will use times from Prices) #' @param Prices optional xts object containing prices and timestamps to mark the book on, default NULL +#' @param Interval optional character string, containing one of "millisecond" (or "ms"), "microsecond" (or "us"), +#' "second", "minute", "hour", "day", "week", "month", "quarter", or "year". This can optionally be preceded by +#' a positive integer, or followed by "s". #' @param \dots any other passthrough parameters #' @export -updatePortf <- function(Portfolio, Symbols=NULL, Dates=NULL, Prices=NULL, ...) +updatePortf <- function(Portfolio, Symbols=NULL, Dates=NULL, Prices=NULL, Interval=Interval, ...) { #' @author Peter Carl, Brian Peterson pname<-Portfolio Portfolio<-.getPortfolio(pname) # TODO add Date handling @@ -26,7 +29,7 @@ } for(symbol in Symbols){ tmp_instr<-try(getInstrument(symbol), silent=TRUE) - .updatePosPL(Portfolio=pname, Symbol=as.character(symbol), Dates=Dates, Prices=Prices, ...=...) + .updatePosPL(Portfolio=pname, Symbol=as.character(symbol), Dates=Dates, Prices=Prices, Interval=Interval, ...=...) } # Calculate and store portfolio summary table Modified: pkg/blotter/R/updatePosPL.R =================================================================== --- pkg/blotter/R/updatePosPL.R 2013-11-09 00:02:24 UTC (rev 1566) +++ pkg/blotter/R/updatePosPL.R 2013-11-09 00:04:43 UTC (rev 1567) @@ -9,7 +9,7 @@ #' @return Regular time series of position information and PL #' @author Peter Carl, Brian Peterson #' @rdname updatePosPL -.updatePosPL <- function(Portfolio, Symbol, Dates=NULL, Prices=NULL, ConMult=NULL, ...) +.updatePosPL <- function(Portfolio, Symbol, Dates=NULL, Prices=NULL, ConMult=NULL, Interval=NULL, ...) { # @author Peter Carl, Brian Peterson rmfirst=FALSE prices=NULL @@ -41,6 +41,10 @@ index(prices[paste('/',.parseISO8601(Dates)$last.time,sep='')]) } else xts:::time.xts(prices[Dates]) } + if(!is.null(Interval)) { + ep_args <- .parse_interval(Interval) + prices <- prices[endpoints(prices, on=ep_args$on, k=ep_args$k)] + } if(ncol(prices)>1) prices=getPrice(Prices,Symbol) @@ -220,6 +224,27 @@ #assign( paste("portfolio",pname,sep='.'), Portfolio, envir=.blotter ) } +.parse_interval <- function(interval) { + + # taken/modified from xts:::last.xts + ip <- gsub("^([[:digit:]]*)([[:alpha:]]+)", "\\1 \\2", interval) + ip <- strsplit(ip, " ", fixed = TRUE)[[1]] + if (length(ip) > 2 || length(ip) < 1) + stop(paste("incorrectly specified", sQuote("interval"))) + + rpu <- ip[length(ip)] + rpf <- ifelse(length(ip) > 1, as.numeric(ip[1]), 1) + + dt.list <- c("milliseconds", "ms", "microseconds", "us", "secs", + "mins", "hours", "days", "weeks", "months", "quarters", "years") + dt.ind <- pmatch(rpu, dt.list) + if(is.na(dt.ind)) + stop("could not uniquely match '", rpu, "' in '", paste0(dt.list,collapse=",'", "'")) + dt <- dt.list[dt.ind] + + list(on=dt, k=rpf) +} + ############################################################################### # Blotter: Tools for transaction-oriented trading systems development # for R (see http://r-project.org/) From noreply at r-forge.r-project.org Sat Nov 9 01:07:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 9 Nov 2013 01:07:37 +0100 (CET) Subject: [Blotter-commits] r1568 - in pkg/blotter: R man Message-ID: <20131109000737.7A2E31853AE@r-forge.r-project.org> Author: bodanker Date: 2013-11-09 01:07:37 +0100 (Sat, 09 Nov 2013) New Revision: 1568 Modified: pkg/blotter/R/updatePosPL.R pkg/blotter/man/updatePortf.Rd pkg/blotter/man/updatePosPL.Rd Log: - roxygenize docs for updatePortf and .updatePosPL Modified: pkg/blotter/R/updatePosPL.R =================================================================== --- pkg/blotter/R/updatePosPL.R 2013-11-09 00:04:43 UTC (rev 1567) +++ pkg/blotter/R/updatePosPL.R 2013-11-09 00:07:37 UTC (rev 1568) @@ -5,6 +5,9 @@ #' @param Dates xts subset of dates, e.g., "2007-01::2008-04-15". These dates must appear in the price stream #' @param Prices periodic prices in an xts object with a columnname compatible with \code{getPrice} #' @param ConMult if necessary, numeric contract multiplier, not needed if instrument is defined. +#' @param Interval optional character string, containing one of "millisecond" (or "ms"), "microsecond" (or "us"), +#' "second", "minute", "hour", "day", "week", "month", "quarter", or "year". This can optionally be preceded by +#' a positive integer, or followed by "s". #' @param \dots any other passthru parameters #' @return Regular time series of position information and PL #' @author Peter Carl, Brian Peterson Modified: pkg/blotter/man/updatePortf.Rd =================================================================== --- pkg/blotter/man/updatePortf.Rd 2013-11-09 00:04:43 UTC (rev 1567) +++ pkg/blotter/man/updatePortf.Rd 2013-11-09 00:07:37 UTC (rev 1568) @@ -3,7 +3,7 @@ \title{update Portfilio P&L over a Dates range} \usage{ updatePortf(Portfolio, Symbols = NULL, Dates = NULL, - Prices = NULL, ...) + Prices = NULL, Interval = Interval, ...) } \arguments{ \item{Portfolio}{string identifying a portfolio} @@ -11,13 +11,19 @@ \item{Symbols}{character vector identifying symbols to update the portfolio for, default NULL} - \item{Dates}{xts-style ISO-8601 time range to run - updatePortf over, default NULL (will use times from - Prices} + \item{Dates}{optional xts-style ISO-8601 time range to + run updatePortf over, default NULL (will use times from + Prices)} \item{Prices}{optional xts object containing prices and timestamps to mark the book on, default NULL} + \item{Interval}{optional character string, containing one + of "millisecond" (or "ms"), "microsecond" (or "us"), + "second", "minute", "hour", "day", "week", "month", + "quarter", or "year". This can optionally be preceded by + a positive integer, or followed by "s".} + \item{\dots}{any other passthrough parameters} } \value{ Modified: pkg/blotter/man/updatePosPL.Rd =================================================================== --- pkg/blotter/man/updatePosPL.Rd 2013-11-09 00:04:43 UTC (rev 1567) +++ pkg/blotter/man/updatePosPL.Rd 2013-11-09 00:07:37 UTC (rev 1568) @@ -3,7 +3,7 @@ \title{Calculates position PL from the position data and corresponding close price data.} \usage{ .updatePosPL(Portfolio, Symbol, Dates = NULL, - Prices = NULL, ConMult = NULL, ...) + Prices = NULL, ConMult = NULL, Interval = NULL, ...) } \arguments{ \item{Portfolio}{a portfolio name to a portfolio @@ -22,6 +22,12 @@ \item{ConMult}{if necessary, numeric contract multiplier, not needed if instrument is defined.} + \item{Interval}{optional character string, containing one + of "millisecond" (or "ms"), "microsecond" (or "us"), + "second", "minute", "hour", "day", "week", "month", + "quarter", or "year". This can optionally be preceded by + a positive integer, or followed by "s".} + \item{\dots}{any other passthru parameters} } \value{ From noreply at r-forge.r-project.org Mon Nov 11 03:54:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 11 Nov 2013 03:54:15 +0100 (CET) Subject: [Blotter-commits] r1569 - pkg/blotter/R Message-ID: <20131111025415.B3120180922@r-forge.r-project.org> Author: bodanker Date: 2013-11-11 03:54:11 +0100 (Mon, 11 Nov 2013) New Revision: 1569 Modified: pkg/blotter/R/updatePosPL.R Log: - patch Interval arg handling Modified: pkg/blotter/R/updatePosPL.R =================================================================== --- pkg/blotter/R/updatePosPL.R 2013-11-09 00:07:37 UTC (rev 1568) +++ pkg/blotter/R/updatePosPL.R 2013-11-11 02:54:11 UTC (rev 1569) @@ -44,7 +44,7 @@ index(prices[paste('/',.parseISO8601(Dates)$last.time,sep='')]) } else xts:::time.xts(prices[Dates]) } - if(!is.null(Interval)) { + if(!missing(Interval) && !is.null(Interval)) { ep_args <- .parse_interval(Interval) prices <- prices[endpoints(prices, on=ep_args$on, k=ep_args$k)] } From noreply at r-forge.r-project.org Tue Nov 12 16:48:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 12 Nov 2013 16:48:11 +0100 (CET) Subject: [Blotter-commits] r1570 - in pkg/quantstrat: R man Message-ID: <20131112154811.92B7E185472@r-forge.r-project.org> Author: bodanker Date: 2013-11-12 16:48:10 +0100 (Tue, 12 Nov 2013) New Revision: 1570 Added: pkg/quantstrat/man/sigTimestamp.Rd Modified: pkg/quantstrat/R/signals.R Log: - add sigTimestamp Modified: pkg/quantstrat/R/signals.R =================================================================== --- pkg/quantstrat/R/signals.R 2013-11-11 02:54:11 UTC (rev 1569) +++ pkg/quantstrat/R/signals.R 2013-11-12 15:48:10 UTC (rev 1570) @@ -320,6 +320,52 @@ return(ret_sig) } +#' generate a signal on a timestamp +#' +#' This will generate a signal on a specific timestamp or at a specific time every day, week, weekday, etc. +#' +#' @param label text label to apply to the output +#' @param data data to apply formula to +#' @param timestamp either a POSIXct-based object, or a character string denoting a 24-hour time (e.g. "09:00", "16:00") +#' @param on only used if \code{timestamp} is character; passed to \code{\link[xts]{split.xts}}, therefore \code{on} +#' may be a character describing the time period as listed in \code{\link[xts]{endpoints}}, or a vector coercible to +#' factor (e.g. \code{\link[xts]{.indexday}}) +#' @export +sigTimestamp <- function(label, data=mktdata, timestamp, on="days") { + + # default label + if(missing(label)) + label <- "timestamp" + + # initialize ret$timestamp to the index of mktdata + ret <- .xts(logical(nrow(data)), .index(data), dimnames=list(NULL,label)) + + # default if timestamp and on are missing + if(missing(timestamp) && missing(on)) { + ret[end(data)] <- TRUE + return(ret) + } + + # timestamp can be a time-based timestamp + if(is.timeBased(timestamp)) { + after.sig <- .firstThreshold(index(data), timestamp, "lt") + if(length(after.sig) != 0) + ret$timestamp[after.sig] <- TRUE + } else + # timestamp can be a timestamp of day + if(is.character(timestamp)) { + time.str <- paste("T00:00/T",timestamp,sep="") + funDay <- function(x, time.str) last(x[time.str]) + funOn <- function(y, time.str) lapply(y, funDay, time.str) + after.sig <- do.call(rbind, lapply(split(ret, on), funDay, time.str)) + if(nrow(after.sig) != 0) + ret[index(after.sig)] <- TRUE + } else { + stop("don't know how to handle 'timestamp' of class ", class(timestamp)) + } + return(ret) +} + #TODO Going Up/Going Down maybe better implemented as slope/diff() indicator, then coupled with threshold signal #TODO set/reset indicator/signal for n-periods since some other signal is set, or signal set for n periods Added: pkg/quantstrat/man/sigTimestamp.Rd =================================================================== --- pkg/quantstrat/man/sigTimestamp.Rd (rev 0) +++ pkg/quantstrat/man/sigTimestamp.Rd 2013-11-12 15:48:10 UTC (rev 1570) @@ -0,0 +1,27 @@ +\name{sigTimestamp} +\alias{sigTimestamp} +\title{generate a signal on a timestamp} +\usage{ + sigTimestamp(label, data = mktdata, timestamp, + on = "days") +} +\arguments{ + \item{label}{text label to apply to the output} + + \item{data}{data to apply formula to} + + \item{timestamp}{either a POSIXct-based object, or a + character string denoting a 24-hour time (e.g. 09:00, + 16:00)} + + \item{on}{only used if \code{timestamp} is character; + passed to \code{\link[xts]{split.xts}}, therefore + \code{on} may be a character describing the time period + as listed in \code{\link[xts]{endpoints}}, or a vector + coercible to factor (e.g. \code{\link[xts]{.indexday}})} +} +\description{ + This will generate a signal on a specific timestamp or at + a specific time every day, week, weekday, etc. +} + From noreply at r-forge.r-project.org Wed Nov 13 21:19:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 13 Nov 2013 21:19:57 +0100 (CET) Subject: [Blotter-commits] r1571 - in pkg/quantstrat: R src Message-ID: <20131113201957.D957C1864F2@r-forge.r-project.org> Author: bodanker Date: 2013-11-13 21:19:57 +0100 (Wed, 13 Nov 2013) New Revision: 1571 Added: pkg/quantstrat/src/firstCross.c Modified: pkg/quantstrat/R/rules.R pkg/quantstrat/R/signals.R Log: - rename .firstThreshold to .firstCross - refactor applyRules - subset mktdata outside of nextIndex and curIndex loop Modified: pkg/quantstrat/R/rules.R =================================================================== --- pkg/quantstrat/R/rules.R 2013-11-12 15:48:10 UTC (rev 1570) +++ pkg/quantstrat/R/rules.R 2013-11-13 20:19:57 UTC (rev 1571) @@ -326,16 +326,81 @@ Dates='' dindex=1 } # end dindex initialization - - nextIndex<-function(curIndex,...){ + + # Find the next index the market will cross a resting order's price + # or if we need to move a trailing order. Returns a named list. + dindexOrderProc <- function(Order, mktPrices, curIndex) { + out <- list() + + # get order information + orderQty <- Order[1L,'Order.Qty'] + if (orderQty=='all' || orderQty=='trigger' || orderQty=='0'){ + # no position, so figure out when the index may be needed + side <- Order[1L,'Order.Side'] + if(side=='long') + orderQty <- -1 + else + orderQty <- 1 + } + orderQty <- as.numeric(orderQty) + orderPrice <- as.numeric(Order[1L,'Order.Price']) + orderType <- Order[1L,'Order.Type'] + + # default mktPrice + mktPrice <- mktPrices[[orderType]]$price + + # process order + if (orderQty > 0) { # buying + # determine relationship + relationship <- + switch(orderType, + limit = if(mktPrices$isOHLC) 'lt' else 'lte', # will be filled if market Ask/Lo go below orderPrice + stoptrailing = 'gte', # look for places where Mkt Bid >= our Ask + stoplimit = if(mktPrices$isOHLC) 'gt' else 'gte') # will be filled if market Ask/Hi go above orderPrice + + if(mktPrices$isOHLC || mktPrices$isBBO) # get buy market price for this order type, if it exists + mktPrice <- mktPrices[[orderType]]$posQty + } else { # selling + # determine relationship + relationship <- + switch(orderType, + limit = if(mktPrices$isOHLC) 'gt' else 'gte', # will be filled if market Bid/Hi go above orderPrice + stoptrailing = 'lte', # look for places where Mkt Ask <= our Bid + stoplimit = if(mktPrices$isOHLC) 'lt' else 'lte') # will be filled if market Bid/Lo go below orderPrice + + if(mktPrices$isOHLC || mktPrices$isBBO) # get sell market price for this order type, if it exists + mktPrice <- mktPrices[[orderType]]$negQty + } + # ensure we have a mktPrice + if (is.na(mktPrice) || is.null(mktPrice)) + stop("no price discernable for ", orderType, " in applyRules") + + # use .firstCross to find the location of the first orderPrice that crosses mktdata[,col] + # *after* curIndex, since that is the soonest we can get filled. + out$cross <- .firstCross(mktPrice, orderPrice, relationship, start=curIndex+1L) + + # check if trailing order needs to be moved + out$move_order <- FALSE + if(orderType %in% "stoptrailing") { + orderThreshold <- as.numeric(Order[1L,'Order.Threshold']) + if(orderQty > 0) { + relationship <- "lt" + newOrderPrice <- orderPrice - abs(orderThreshold) + } else { + relationship <- "gt" + newOrderPrice <- orderPrice + abs(orderThreshold) + } + out$move_order <- .firstCross(mktPrice, newOrderPrice, relationship, start=curIndex+1L) + } + out + } + + nextIndex <- function(curIndex, ..., mktPrices){ if (!isTRUE(path.dep)){ curIndex = FALSE return(curIndex) } - dindex<-get.dindex() - #message(dindex," in nextIndex(), at ",curIndex) - hasmktord <- FALSE nidx=FALSE neworders=NULL @@ -347,208 +412,65 @@ if(length(oo.idx)==0){ nidx=FALSE } else { # open orders, - isOHLCmktdata <- is.OHLC(mktdata) - isBBOmktdata <- is.BBO(mktdata) #check for open orders at curIndex timespan<-paste(timestamp,"::",sep='') #no check to see if timestamp came through dots? Does it come from the search path? -gsee - if(nrow(ordersubset[oo.idx,][timespan])==0 && # prior open orders already in dindex; no need to recheck - !any(ordersubset$Order.Type[oo.idx]=="stoptrailing")) # ... but stoptrailing may need to move + if(nrow(ordersubset[oo.idx,][timespan])==0 && # prior open orders already in dindex; no need to recheck + !any(ordersubset[oo.idx,"Order.Type"] %in% "stoptrailing")) # ... but trailing orders may need to move { # no open orders between now and the next index nidx=FALSE } else { - ordersubset.oo.idx <- ordersubset[oo.idx,] - if(length(which('market'==ordersubset.oo.idx[,'Order.Type'])) > 0) - { - # if block above had a prefer exclusion, as below: - # || hasArg('prefer') - # 'prefer' arguments would loop through all observations. - # we could probably change the code below on finding price to handle prefer, but not sure it matters - - #if any type is market - # set to curIndex+1 - #curIndex<-curIndex+1 - if (is.na(curIndex) || (curIndex + 1) > nrow(mktdata)) curIndex=FALSE - hasmktord <- TRUE - #return(curIndex) # move to next index, a market order in this index would have trumped any other open order - } + openOrderSubset <- ordersubset[oo.idx,] - stoplimitorders <- which('stoplimit'==ordersubset.oo.idx[,'Order.Type']) - for(slorder in stoplimitorders) + # process open market orders + if(any('market'==openOrderSubset[,'Order.Type'])) { - tmpqty <- ordersubset.oo.idx[slorder,'Order.Qty'] - if (tmpqty=='all' || tmpqty=='trigger' || tmpqty==0){ - #tmpqty<-osNoOp(timestamp=timestamp, orderqty=tmpqty, portfolio=portfolio, symbol=symbol,ruletype='exit' ) - #no position, so do some sleight of hand to figure out when the index may be needed - side <- ordersubset.oo.idx[slorder,'Order.Side'] - if(side=='long') tmpqty=-1 - else tmpqty=1 - } - tmpqty<-as.numeric(tmpqty) - tmpprice <- as.numeric(ordersubset.oo.idx[slorder,'Order.Price']) - if (tmpqty > 0) { #buy if mktprice moves above stoplimitorder price - relationship='gte' #if the Ask or Hi go above threshold our stop will be filled - if(isBBOmktdata) { - col<-first(colnames(mktdata)[has.Ask(mktdata,which=TRUE)]) - } else if (isOHLCmktdata) { - col<-first(colnames(mktdata)[has.Hi(mktdata,which=TRUE)]) - relationship="gt" #gt i.o. gte: we don't want unrealistic fills for OHLC - } else { #univariate or something built with fn_SpreadBuilder - col<-first(colnames(mktdata)[grep(prefer, colnames(mktdata))]) - # perhaps we need a has.Price check - } - if (is.na(col)) stop("no price discernable for stoplimit in applyRules") - } else { #sell if mktprice moves below stoplimitorder price - relationship="lte" #if Bid or Lo go below threshold, our stop will be filled - if(isBBOmktdata) { - col<-first(colnames(mktdata)[has.Bid(mktdata,which=TRUE)]) - } else if (isOHLCmktdata) { - col<-first(colnames(mktdata)[has.Lo(mktdata,which=TRUE)]) - relationship="lt" #lt i.o. lte: we don't want unrealistic fills for OHLC - } else { - col<-first(colnames(mktdata)[grep(prefer, colnames(mktdata))]) - } - if (is.na(col)) stop("no price discernable for stoplimit in applyRules") - } - # use .firstThreshold to find the location of the first tmpprice that crosses mktdata[,col] - cross <- .firstThreshold(data=mktdata, col, tmpprice, relationship, start=curIndex+1) # don't look for crosses on curIndex - if(cross < nrow(mktdata)){ - # find first index that would cross after this index - newidx <- cross - # insert that into dindex - assign.dindex(c(get.dindex(),newidx)) - } + # if there are any market orders, set hasmktord to TRUE + # other orders still need to be processed? -JMU + hasmktord <- TRUE } - limitorders <- which('limit'==ordersubset.oo.idx[,'Order.Type']) - for(lorder in limitorders) - { - tmpqty<-ordersubset.oo.idx[lorder,'Order.Qty'] - if (tmpqty=='all' || tmpqty=='trigger' || tmpqty==0){ - #tmpqty<-osNoOp(timestamp=timestamp, orderqty=tmpqty, portfolio=portfolio, symbol=symbol,ruletype='exit' ) - #no position, so do some sleight of hand to figure out when the index may be needed - side <- ordersubset.oo.idx[lorder,'Order.Side'] - if(side=='long') tmpqty <- -1 - else tmpqty <- 1 - } - tmpqty<-as.numeric(tmpqty) - tmpprice<-as.numeric(ordersubset.oo.idx[lorder,'Order.Price']) - if(tmpqty>0){ - #buying - relationship="lte" #look for places where Mkt Ask <= our Bid - if(isBBOmktdata) { - col<-first(colnames(mktdata)[has.Ask(mktdata,which=TRUE)]) - } else if (isOHLCmktdata) { - col<-first(colnames(mktdata)[has.Lo(mktdata,which=TRUE)]) - relationship="lt" #lt i.o. lte: we don't want unrealistic fills for OHLC - } else { - col<-first(colnames(mktdata)[grep(prefer, colnames(mktdata))]) - } - if (is.na(col)) stop("no price discernable for limit in applyRules") - } else { - #selling - relationship="gte" #look for places where Mkt Bid >= our Ask - if(isBBOmktdata) { - col<-first(colnames(mktdata)[has.Bid(mktdata,which=TRUE)]) - } else if (isOHLCmktdata) { - col<-first(colnames(mktdata)[has.Hi(mktdata,which=TRUE)]) - relationship="gt" #gt i.o. gte: we don't want unrealistic fills for OHLC - } else { - col<-first(colnames(mktdata)[grep(prefer, colnames(mktdata))]) - } - if (is.na(col)) stop("no price discernable for limit in applyRules") - } - # use .firstThreshold to find the location of the first tmpprice that crosses mktdata[,col] - cross <- .firstThreshold(data=mktdata, col, tmpprice, relationship, start=curIndex+1) # don't look for crosses on curIndex - if(cross < nrow(mktdata)){ - # find first index that would cross after this index - # - # current index = which(cross[timespan])[1] - # since the soonest we can get filled is next timestamp we are looking for which(cross[timespan])[2]. - # need to subtract 1 index==1 means current position - # - # newidx <- curIndex + which(cross[timespan])[1] #- 1 #curIndex/timestamp was 1 in the subset, we need a -1 offset? - newidx <- cross + # process open resting, but non-trailing orders + # - dindex can be updated after processing all open orders + openOrders <- which(openOrderSubset[,'Order.Type'] %in% c("limit","stoplimit")) + if(length(openOrders) > 0) { + # dindexOrderProc$cross will be nrow(x) if there's no cross, and nrow(x) is always in dindex + newIndex <- sapply(openOrders, function(i) dindexOrderProc(openOrderSubset[i,], mktPrices, curIndex)$cross) + assign.dindex(c(get.dindex(),newIndex)) + } - #if there are is no cross curIndex will be incremented on line 496 - # with curIndex<-min(dindex[dindex>curIndex]). - #we cannot get filled at this timestamp. The soonest we could get filled is next timestamp... - #see also that market order increments curIndex before returning it. Going by the docs, - #I think this is by design. i.e. no instant fills. -gsee - - # insert that into dindex - assign.dindex(c(get.dindex(),newidx)) - } - } # end loop over open limit orders - - trailorders <- which('stoptrailing'==ordersubset.oo.idx[,'Order.Type']) - for(torder in trailorders) + # process open trailing orders + # - dindex should be updated after processing each open trailing order, + # regardless of trailing order type (only stoptrailing is currently implemented) + openOrders <- which(openOrderSubset[,'Order.Type'] %in% "stoptrailing") + for(openOrder in openOrders) { - onum<-oo.idx[torder] - orderThreshold <- as.numeric(ordersubset[onum,'Order.Threshold']) - tmpqty<-ordersubset[onum,'Order.Qty'] - if (tmpqty=='all' || tmpqty=='trigger' || tmpqty==0){ - #tmpqty<-osNoOp(timestamp=timestamp, orderqty=tmpqty, portfolio=portfolio, symbol=symbol,ruletype='exit' ) - #no position, so do some sleight of hand to figure out when the index may be needed - side <- ordersubset.oo.idx[torder,'Order.Side'] - if(side=='long') tmpqty=-1 - else tmpqty=1 - } - tmpqty<-as.numeric(tmpqty) - tmpprice<-as.numeric(ordersubset[onum,'Order.Price']) + # determine timespan we should search for trailing order executions + dindex <- get.dindex() + dindexNext <- dindex[.firstCross(dindex, curIndex, "gt")] - if(isBBOmktdata) { - if(tmpqty > 0){ # positive quantity 'buy' - prefer='offer' - } else { - prefer='bid' - } - } else if (isOHLCmktdata) { - prefer='close' - } + newIndex <- dindexOrderProc(openOrderSubset[openOrder,], mktPrices, curIndex) - dindex<-get.dindex() - ddindex <- dindex[dindex>curIndex] - if(length(ddindex) == 0) - return(FALSE) - - nextidx <- min(ddindex) - nextstamp <- format(index(mktdata[nextidx,]), "%Y-%m-%d %H:%M:%OS6") - timespan <- paste(format(timestamp, "%Y-%m-%d %H:%M:%OS6"),"::",nextstamp,sep='') - - #get the subset of prices - mkt_price_series <-getPrice(mktdata[timespan],prefer=prefer)[-1] # don't look for crosses on curIndex - col<-first(colnames(mkt_price_series)) - - # check if order needs to be moved - if(tmpqty > 0){ # positive quantity 'buy' - move_order <- tmpprice - abs(orderThreshold) > mkt_price_series - relationship="gte" - } else { # negative quantity 'sell' - move_order <- tmpprice + abs(orderThreshold) < mkt_price_series - relationship="lte" - } - # check if order will be filled - # use .firstThreshold to find the location of the first tmpprice that crosses mktdata[,col] - cross <- .firstThreshold(data=mktdata, col, tmpprice, relationship, start=curIndex+1) # don't look for crosses on curIndex # update dindex if order is moved or filled - if(any(move_order) || cross < nrow(mktdata)){ - moveidx <- curIndex + min(which(move_order)[1], cross, na.rm=TRUE) - assign.dindex(c(get.dindex(), moveidx)) + if(newIndex$move_order < dindexNext || newIndex$cross < dindex[length(dindex)]) { + assign.dindex(c(dindex, min(newIndex$move_order, newIndex$cross, na.rm=TRUE))) } } # end loop over open trailing orders - } # end else clause for any open orders in this timespan + } # end else clause for any open orders in this timespan } # end any open orders closure if(curIndex){ - if(hasmktord) { - curIndex <- curIndex+1 + if(hasmktord) { + curIndex <- curIndex+1 # why isn't this put into dindex? -JMU } else { dindex<-get.dindex() - if (any(dindex > curIndex)) { - curIndex<-min(dindex[dindex>curIndex]) - } else curIndex <- FALSE + dindexNext <- dindex[.firstCross(dindex, curIndex, "gt")] + if (dindexNext < dindex[length(dindex)]) { + curIndex <- dindexNext + } else { + curIndex <- FALSE + } } } @@ -566,6 +488,42 @@ curIndex<-1 freq <- periodicity(mktdata) # run once and pass to ruleOrderProc + # do order price subsetting outside of nextIndex and curIndex loop + # this avoids repeated [.xts calls; and mktPrices is never altered, so copies aren't made + if(is.BBO(mktdata)) { + mktPrices <- list( + stoplimit = list( + posQty = mktdata[,has.Ask(mktdata,which=TRUE)[1]], + negQty = mktdata[,has.Bid(mktdata,which=TRUE)[1]]), + limit = list( + posQty = mktdata[,has.Ask(mktdata,which=TRUE)[1]], + negQty = mktdata[,has.Bid(mktdata,which=TRUE)[1]]), + stoptrailing = list( + posQty = getPrice(mktdata, prefer='offer')[,1], + negQty = getPrice(mktdata, prefer='bid')[,1])) + } else if (is.OHLC(mktdata)) { + mktPrices <- list( + stoplimit = list( + posQty = mktdata[,has.Hi(mktdata,which=TRUE)[1]], + negQty = mktdata[,has.Lo(mktdata,which=TRUE)[1]]), + limit = list( + posQty = mktdata[,has.Lo(mktdata,which=TRUE)[1]], + negQty = mktdata[,has.Hi(mktdata,which=TRUE)[1]]), + stoptrailing = list( + posQty = getPrice(mktdata, prefer='close')[,1], + negQty = getPrice(mktdata, prefer='close')[,1])) + } else { # univariate or something built with fn_SpreadBuilder + mktPrices <- list( + stoplimit = list( + price = getPrice(mktdata, prefer=prefer)[,1]), + limit = list( + price = getPrice(mktdata, prefer=prefer)[,1]), + stoptrailing = list( + price = getPrice(mktdata, prefer=prefer)[,1])) + } + mktPrices$isOHLC <- is.OHLC(mktdata) + mktPrices$isBBO <- is.BBO(mktdata) + while(curIndex){ timestamp=Dates[curIndex] @@ -652,7 +610,7 @@ } ) # end switch } #end type loop - if(isTRUE(path.dep)) curIndex<-nextIndex(curIndex, ...) #timestamp comes from environment, not dots? -gsee + if(isTRUE(path.dep)) curIndex <- nextIndex(curIndex, ..., mktPrices=mktPrices) #timestamp comes from environment, not dots? -gsee else curIndex=FALSE } # end index while loop @@ -683,15 +641,7 @@ if(!isTRUE(rule$enabled)) next() # check to see if we should run in this timespan - if(!is.null(rule$timespan)) { - # Get row index of timestamp for faster subsetting - if(hasArg(curIndex)) - curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame()) - else - curIndex <- timestamp - if(nrow(mktdata[curIndex][rule$timespan])==0) - next() - } + if(!is.null(rule$timespan) && nrow(mktdata[curIndex][rule$timespan])==0) next() # modify a few things rule$arguments$timestamp = timestamp Modified: pkg/quantstrat/R/signals.R =================================================================== --- pkg/quantstrat/R/signals.R 2013-11-12 15:48:10 UTC (rev 1570) +++ pkg/quantstrat/R/signals.R 2013-11-13 20:19:57 UTC (rev 1571) @@ -278,8 +278,7 @@ } #' @useDynLib quantstrat -.firstThreshold <- function(data=mktdata, column, threshold=0, relationship, start=1) { - colNum <- match.names(column, colnames(data)) +.firstCross <- function(Data, threshold=0, relationship, start=1) { rel <- switch(relationship[1], '>' = , 'gt' = 1, @@ -292,7 +291,7 @@ 'lte' = , 'lteq' = , 'le' = 5) - .Call('firstThreshold', data[,colNum], threshold, rel, start) + .Call('firstCross', Data, threshold, rel, start) } #' generate a signal from a formula Copied: pkg/quantstrat/src/firstCross.c (from rev 1570, pkg/quantstrat/src/firstThreshold.c) =================================================================== --- pkg/quantstrat/src/firstCross.c (rev 0) +++ pkg/quantstrat/src/firstCross.c 2013-11-13 20:19:57 UTC (rev 1571) @@ -0,0 +1,55 @@ +#include +#include + +SEXP firstCross(SEXP x, SEXP th, SEXP rel, SEXP start) +{ + int i, int_rel, int_start; + double *real_x=NULL, real_th; + + if(ncols(x) > 1) + error("only univariate data allowed"); + + /* this currently only works for real x and th arguments + * support for other types may be added later */ + real_th = asReal(th); + int_rel = asInteger(rel); + int_start = asInteger(start)-1; + + switch(int_rel) { + case 1: /* > */ + real_x = REAL(x); + for(i=int_start; i real_th) + return(ScalarInteger(i+1)); + break; + case 2: /* < */ + real_x = REAL(x); + for(i=int_start; i= */ + real_x = REAL(x); + for(i=int_start; i= real_th) + return(ScalarInteger(i+1)); + break; + case 5: /* <= */ + real_x = REAL(x); + for(i=int_start; i Author: bodanker Date: 2013-11-13 21:58:15 +0100 (Wed, 13 Nov 2013) New Revision: 1572 Removed: pkg/quantstrat/src/firstThreshold.c Modified: pkg/quantstrat/R/rules.R Log: - rename .firstThreshold to .firstCross - r1564 fix accidentally removed - delete src/firstThreshold.c Modified: pkg/quantstrat/R/rules.R =================================================================== --- pkg/quantstrat/R/rules.R 2013-11-13 20:19:57 UTC (rev 1571) +++ pkg/quantstrat/R/rules.R 2013-11-13 20:58:15 UTC (rev 1572) @@ -641,7 +641,15 @@ if(!isTRUE(rule$enabled)) next() # check to see if we should run in this timespan - if(!is.null(rule$timespan) && nrow(mktdata[curIndex][rule$timespan])==0) next() + if(!is.null(rule$timespan)) { + # Get row index of timestamp for faster subsetting + if(hasArg(curIndex)) + curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame()) + else + curIndex <- timestamp + if(nrow(mktdata[curIndex][rule$timespan])==0) + next() + } # modify a few things rule$arguments$timestamp = timestamp Deleted: pkg/quantstrat/src/firstThreshold.c =================================================================== --- pkg/quantstrat/src/firstThreshold.c 2013-11-13 20:19:57 UTC (rev 1571) +++ pkg/quantstrat/src/firstThreshold.c 2013-11-13 20:58:15 UTC (rev 1572) @@ -1,55 +0,0 @@ -#include -#include - -SEXP firstThreshold(SEXP x, SEXP th, SEXP rel, SEXP start) -{ - int i, int_rel, int_start; - double *real_x=NULL, real_th; - - if(ncols(x) > 1) - error("only univariate data allowed"); - - /* this currently only works for real x and th arguments - * support for other types may be added later */ - real_th = asReal(th); - int_rel = asInteger(rel); - int_start = asInteger(start)-1; - - switch(int_rel) { - case 1: /* > */ - real_x = REAL(x); - for(i=int_start; i real_th) - return(ScalarInteger(i+1)); - break; - case 2: /* < */ - real_x = REAL(x); - for(i=int_start; i= */ - real_x = REAL(x); - for(i=int_start; i= real_th) - return(ScalarInteger(i+1)); - break; - case 5: /* <= */ - real_x = REAL(x); - for(i=int_start; i Author: bodanker Date: 2013-11-17 15:13:54 +0100 (Sun, 17 Nov 2013) New Revision: 1573 Modified: pkg/blotter/R/calcPosAvgCost.R pkg/blotter/src/calcPosAvgCost.c Log: - Fix PosAvgCost bug when prices are negative. Thanks to Shang Gao for spotting the issue. Previous bugfix probably addressed something fixed in r1007 or r1051. Modified: pkg/blotter/R/calcPosAvgCost.R =================================================================== --- pkg/blotter/R/calcPosAvgCost.R 2013-11-13 20:58:15 UTC (rev 1572) +++ pkg/blotter/R/calcPosAvgCost.R 2013-11-17 14:13:54 UTC (rev 1573) @@ -16,8 +16,6 @@ # position is decreasing, pos avg cost for the open position remains the same PosAvgCost = PrevPosAvgCost } else { - if(PrevPosAvgCost<0) TxnValue= -1*TxnValue #fix bug with negative average cost - # PosAvgCost = abs((PrevPosQty * PrevPosAvgCost * ConMult + TxnValue)/(PosQty*ConMult)) PosAvgCost = (PrevPosQty * PrevPosAvgCost * ConMult + TxnValue)/(PosQty*ConMult) } return(PosAvgCost) Modified: pkg/blotter/src/calcPosAvgCost.c =================================================================== --- pkg/blotter/src/calcPosAvgCost.c 2013-11-13 20:58:15 UTC (rev 1572) +++ pkg/blotter/src/calcPosAvgCost.c 2013-11-17 14:13:54 UTC (rev 1573) @@ -32,8 +32,6 @@ /* position is decreasing, pos avg cost for the open position remains the same */ d_PosAvgCost[i] = d_PrevPosAvgCost; } else { - if(d_PrevPosAvgCost<0) - d_TxnValue[i]= -1.0 * d_TxnValue[i]; /* fix bug with negative average cost */ d_PosAvgCost[i] = (d_PrevPosQty * d_PrevPosAvgCost * d_ConMult + d_TxnValue[i])/(d_PosQty[i]*d_ConMult); } d_PrevPosQty = d_PosQty[i]; From noreply at r-forge.r-project.org Wed Nov 20 15:10:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 20 Nov 2013 15:10:01 +0100 (CET) Subject: [Blotter-commits] r1574 - pkg/quantstrat/R Message-ID: <20131120141001.BA7AB1859AC@r-forge.r-project.org> Author: bodanker Date: 2013-11-20 15:10:01 +0100 (Wed, 20 Nov 2013) New Revision: 1574 Modified: pkg/quantstrat/R/paramsets.R Log: - remove phantom function Modified: pkg/quantstrat/R/paramsets.R =================================================================== --- pkg/quantstrat/R/paramsets.R 2013-11-17 14:13:54 UTC (rev 1573) +++ pkg/quantstrat/R/paramsets.R 2013-11-20 14:10:01 UTC (rev 1574) @@ -388,7 +388,6 @@ { param.combos <- expand.distributions(distributions) param.combos <- apply.constraints(constraints, distributions, param.combos) - param.combos <- expand.constrained.distributions(constraints, distributions) rownames(param.combos) <- NULL # reset rownames if(nsamples > 0) param.combos <- select.samples(nsamples, param.combos)