From noreply at r-forge.r-project.org Wed Sep 23 05:05:47 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 23 Sep 2015 05:05:47 +0200 (CEST) Subject: [Blotter-commits] r1699 - in pkg/quantstrat: R src Message-ID: <20150923030547.4F3AC187B56@r-forge.r-project.org> Author: bodanker Date: 2015-09-23 05:05:45 +0200 (Wed, 23 Sep 2015) New Revision: 1699 Modified: pkg/quantstrat/R/signals.R pkg/quantstrat/src/firstCross.c Log: Special case integer Data/threshold; support "!=" Instead of coercing all inputs to numeric, operate directly on integers if both Data and threshold are integers (otherwise coerce to numeric). Add support for "!=" (and "ne", "neq"), and add aliases "==", "<=", and ">=". Also add PACKAGE argument to .Call, to avoid repeated native symbol lookups. Modified: pkg/quantstrat/R/signals.R =================================================================== --- pkg/quantstrat/R/signals.R 2015-08-23 23:00:31 UTC (rev 1698) +++ pkg/quantstrat/R/signals.R 2015-09-23 03:05:45 UTC (rev 1699) @@ -290,14 +290,20 @@ 'gt' = 1, '<' = , 'lt' = 2, - 'eq' = 3, #FIXME any way to specify '='? + '==' = , + 'eq' = 3, + '>=' = , 'gte' = , 'gteq' = , - 'ge' = 4, #FIXME these fail with an 'unexpected =' error if you use '>=' + 'ge' = 4, + '<=' = , 'lte' = , 'lteq' = , - 'le' = 5) - .Call('firstCross', Data, threshold, rel, start) + 'le' = 5, + '!=' = , + 'ne' = , + 'neq' = 6) + .Call('firstCross', Data, threshold, rel, start, PACKAGE="quantstrat") } #' generate a signal from a formula Modified: pkg/quantstrat/src/firstCross.c =================================================================== --- pkg/quantstrat/src/firstCross.c 2015-08-23 23:00:31 UTC (rev 1698) +++ pkg/quantstrat/src/firstCross.c 2015-09-23 03:05:45 UTC (rev 1699) @@ -9,59 +9,118 @@ 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 */ - PROTECT(x = coerceVector(x, REALSXP)); P++; - real_th = asReal(th); - int_rel = asInteger(rel); - int_start = asInteger(start)-1; - /* return number of observations if relationship is never TRUE */ SEXP result = ScalarInteger(nrows(x)); - switch(int_rel) { - case 1: /* > */ - real_x = REAL(x); - for(i=int_start; i real_th) { - result = ScalarInteger(i+1); - break; - } - break; - case 2: /* < */ - real_x = REAL(x); - for(i=int_start; i= */ - real_x = REAL(x); - for(i=int_start; i= real_th) { - result = ScalarInteger(i+1); - break; - } - break; - case 5: /* <= */ - real_x = REAL(x); - for(i=int_start; i */ + for(i=int_start; i int_th) { + result = ScalarInteger(i+1); + break; + } + break; + case 2: /* < */ + for(i=int_start; i= */ + for(i=int_start; i= int_th) { + result = ScalarInteger(i+1); + break; + } + break; + case 5: /* <= */ + for(i=int_start; i */ + for(i=int_start; i real_th) { + result = ScalarInteger(i+1); + break; + } + break; + case 2: /* < */ + for(i=int_start; i= */ + for(i=int_start; i= real_th) { + result = ScalarInteger(i+1); + break; + } + break; + case 5: /* <= */ + for(i=int_start; i Author: bodanker Date: 2015-09-27 04:57:22 +0200 (Sun, 27 Sep 2015) New Revision: 1700 Modified: pkg/quantstrat/R/orders.R Log: Improve performance of finding orders Only perform logical comparisons for non-NULL arguments. Also, the logical comparisons we need to do can be done on the ordersubset coredata, since we do not need any of the functionality in Ops.xts to find indices. Add "rejected" as possible order status. Also use match.arg to test whether arguments are one of the valid choices, which allows for partial matching. Modified: pkg/quantstrat/R/orders.R =================================================================== --- pkg/quantstrat/R/orders.R 2015-09-23 03:05:45 UTC (rev 1699) +++ pkg/quantstrat/R/orders.R 2015-09-27 02:57:22 UTC (rev 1700) @@ -122,21 +122,38 @@ if(is.null(ordersubset)) return(NULL) - #data quality checks - if(!is.null(status) & !length(grep(status,c("open", "closed", "canceled", "revoked","replaced")))==1) stop(paste("order status:",status,' must be one of "open", "closed", "canceled", "revoked", or "replaced"')) + # Only do logical comparisons for non-NULL arguments. Use coredata to avoid + # Ops.xts, since we don't need any xts functionality to find indices + indices <- NULL + ordercoredata <- coredata(ordersubset) + if(!is.null(status)) { + status <- match.arg(status, c("open", "closed", "canceled", "revoked", "replaced", "rejected")) + ind <- ordercoredata[,"Order.Status"] == status + indices <- if(is.null(indices)) ind else ind & indices + } if(!is.null(ordertype)) { - if(is.na(charmatch(ordertype,c("market","limit","stoplimit","stoptrailing","iceberg")))){ - stop(paste("ordertype:",ordertype,' must be one of "market","limit","stoplimit", "stoptrailing" or "iceberg"')) - } + ordertype <- match.arg(ordertype, c("market", "limit", "stoplimit", "stoptrailing", "iceberg")) + ind <- ordercoredata[,"Order.Type"] == ordertype + indices <- if(is.null(indices)) ind else ind & indices } + if(!is.null(side)) { + side <- match.arg(side, c("long", "short")) + ind <- ordercoredata[,"Order.Side"] == side + indices <- if(is.null(indices)) ind else ind & indices + } + if(!is.null(orderset)) { + ind <- ordercoredata[,"Order.Set"] == orderset + indices <- if(is.null(indices)) ind else ind & indices + } + if(!is.null(qtysign)) { + ind <- sign(as.numeric(ordercoredata[,"Order.Qty"])) == qtysign + indices <- if(is.null(indices)) ind else ind & indices + } - indices <- which(#if(!is.null(timespan)) ordersubset[timespan,which.i=TRUE] else TRUE & - (if(!is.null(status)) ordersubset[,"Order.Status"]==status else TRUE) & - (if(!is.null(ordertype)) ordersubset[,"Order.Type"]==ordertype else TRUE) & - (if(!is.null(side)) ordersubset[,"Order.Side"]==side else TRUE) & - (if(!is.null(orderset)) ordersubset[,"Order.Set"]==orderset else TRUE) & - (if(!is.null(qtysign)) sign(as.numeric(ordersubset[,"Order.Qty"]))==qtysign else TRUE) - ) + if(is.null(indices)) + indices <- 1L:nrow(ordersubset) + else + indices <- which(indices) if(isTRUE(which.i)){ return(indices)