Quantstrat Rebalancing - Irrationally Long Running Time

Question

After getting help from the kind members here, I finally built my own sample strategy in quantstrat. The code works well and fast (~1 min) in a universe of <100 stocks, but the running time increases dramatically to (> 5hrs) when the universe is expanded to , for example, 500 stocks. After some testings, I find the key for increasing running time is the applyStrategy.rebalancing . Everything goes fast when I eliminate the word rebalancing.

However, I want to keep the rebalancing option to maintainig a certain equity-to-cash ratio. Any ideas of the highly increased running time and possible solution will be appreciated.

To explain more, my strategy is rather a simple one. Every month, the portfolio will sell all the stocks in the portfolio and buy back stocks with a rank (predetermined) of top 20s. Money are equally distributed to the 20 stocks.

Datafiles with a larger universe: (Please edit the paths in the code)

http://www.filedropper.com/data7
http://www.filedropper.com/data72

My Code: (It runs well under small samples)

library(lattice)
library(quantstrat)


quotes.file <- "Data7.csv"   #Need Editing

quotes.file2 <- "Data72.csv"   #Need Editing

#
# 1. Instrument: read csv file into xts object
#
code  <- read.csv(quotes.file2,head=TRUE)
data2 <- read.csv(quotes.file, head=TRUE)
code=apply(code,1,"toString")
matsplitter<-function(M, r, c) {
    rg <- (row(M)-1)%/%r+1
    cg <- (col(M)-1)%/%c+1
    rci <- (rg-1)*max(cg) + cg
    N <- prod(dim(M))/r/c
    cv <- unlist(lapply(1:N, function(x) M[rci==x]))
    dim(cv)<-c(r,c,N)
    cv
} 

data=matsplitter(data2[,-1],nrow(data2),4)
colnames(data)=c("close","pe","pe_avg","pe_sd")
dates <- as.Date(data2$Date,"%d/%m/%Y")
C=list()
i=1
for (i in 1:(dim(data)[3])){
    C[[i]] <- xts(x=data[,,i], order.by=dates)
}


#
# 2. Support Functions
#

osFixedDollar <- function(timestamp,orderqty, portfolio, symbol, ruletype, ...)
{
  updatePortf(qs.portfolio, Symbols=code, Dates=paste('::',as.Date(Sys.time()),sep=''))
  cumPL=0
  for (o in (1: length(code))){
      cumPL <- cumPL+sum(getPortfolio(portfolio)$symbols[[code[o]]]$posPL$Net.Trading.PL)
  }
  ClosePrice <- as.numeric((mktdata[timestamp,"close"]))
  orderqty <- round(((initEq+cumPL)/topchoice)/ClosePrice,-2)
  return(orderqty)
}

pause <- function() {
  cat ("Press [enter] to continue")
  line <- readline()
}

Zscore <- function(x0,y0,z0) {
  x <- as.numeric(x0)
  y <- as.numeric(y0)
  z <- as.numeric(z0)
  res <- (x-y)/z
  res
}



for (i in 1:(dim(data)[3])){
    C[[i]]$Zscore <-Zscore(C[[i]]$pe,C[[i]]$pe_avg,C[[i]]$pe_sd)
}


for (j in  1:(nrow(data))){
    temp=0
    for (i in 1:(dim(data)[3])){    
        temp=c(temp,C[[i]][j,"Zscore"])
    }
    temp=temp[-1]
    temp=as.numeric(-temp)
    temp2=rank(temp)
    for (i in 1:(dim(data)[3])){
        C[[i]]$ranking[j]=temp2[i]
    }   
}

for (i in 1:(dim(data)[3])){
    assign(code[i],C[[i]])
}

#
# 3. Initializations
#

# Currency:
currency("HKD")

# Instrument:
big.point.value <- 1
for (i in 1:(dim(data)[3])){
    stock(code[i], currency="HKD", multiplier=big.point.value)
}

# Strategy, portfolio and account names:
qs.strategy <- "PE.on.HKex"
qs.portfolio <- "Equities"
qs.account <- "My.account"

# Remove previous strategy, portfolio and account:
suppressWarnings(rm(list = c(paste("account", qs.account, sep='.'), paste("portfolio", qs.portfolio, sep='.')), pos=.blotter))
suppressWarnings(rm(list = c(qs.strategy, paste("order_book", qs.portfolio, sep='.')), pos=.strategy))
rm.strat(qs.strategy) # remove strategy etc. if this is a re-run

# Portfolio:
initDate <- '2013-12-15'
initPortf(qs.portfolio, code, initDate=initDate, currency='HKD')

# Account:
initEq <- 100000
initAcct(qs.account, portfolios=qs.portfolio, initDate=initDate, currency='HKD', initEq=initEq)

# Orders:
initOrders(portfolio=qs.portfolio, initDate=initDate)

# Strategy:
strategy(qs.strategy, store=TRUE)

#
# 4. Functions indicating buy, sell short, sell and buy to cover
#

nb.bars.with.no.trade <- 0
topchoice=20

buy.function <- function(x) {
  N <- nrow(x) 
  buy.signals <- numeric(N)
  # buy.signals[1:nb.bars.with.no.trade]<- 0
  for (i in (nb.bars.with.no.trade+1):N) {
    if ( (x[i]<=topchoice)
         && (index(x)[i] < index(get(code[1]))[nrow(data)]) && (index(x)[i] > index(get(code[1]))[1]) # trick to avoid an open trade at the end
         ) {
      buy.signals[i] <- 1
    } else {
      buy.signals[i] <- 0
    }
  }

  xts(x=buy.signals, order.by=index(x))
}

sell.function <- function(x) {
  N <- nrow(x)
  sell.signals <- numeric(N)
  #sell.signals[1:nb.bars.with.no.trade]<- 0
  for (i in (nb.bars.with.no.trade+1):N) {

    if (x[i]>topchoice){
        sell.signals[i] <- 1
    }
  }

  xts(x=sell.signals, order.by=index(x))
}



#
# 5. Indicators for buy, sell short, sell and buy to cover
#

add.indicator(strategy = qs.strategy,
              name = "buy.function",
              arguments = list(x = quote(mktdata[,"ranking"])),
              label="Buy")

add.indicator(strategy = qs.strategy,
              name = "sell.function",
              arguments = list(x = quote(mktdata[,"ranking"])),
              label="Sell")

#
# 6. Signals for buy, sell short, sell and buy to cover
#

add.signal(qs.strategy,
           name="sigFormula",
           arguments = list(formula="X1.Buy == 1"),
           label="Buy",
           cross=FALSE)

add.signal(qs.strategy,
           name="sigFormula",
           arguments = list(formula="X1.Sell == 1"),
           label="Sell",
           cross=FALSE)

# 
# 7. Rules for buy, sell short, sell and buy to cover
# 

nb.contracts <- 2
round.trip.commission.for.one.contract <- 6
round.trip.commission.for.total.contracts <- round.trip.commission.for.one.contract * nb.contracts

add.rule(qs.strategy,
         name='ruleSignal',
         arguments = list(sigcol="Sell", 
                          sigval=TRUE,
                          orderqty='all',
                          ordertype='market',
                          orderside='long',
                          pricemethod='market',
                          replace=FALSE,TxnFees=-0),
         type='exit',
         label="LongExit")

add.rule(qs.strategy,
         name='ruleSignal',
         arguments = list(sigcol="Buy",
                          sigval=TRUE,
                          orderqty=100000000,
                          ordertype='market',
                          orderside='long',osFUN='osMaxPos',
                          replace=FALSE),     
         type='enter',
         label="LongEntry")

add.rule(qs.strategy, 'rulePctEquity',
        arguments=list(rebalance_on='years',
                       trade.percent=(1/topchoice)*0.9,
                       refprice=quote(last(getPrice(mktdata)[paste('::',curIndex,sep='')])),
                       digits=0
        ),
        type='rebalance',
        label='rebalance'
)





posval<-initEq/topchoice
for(symbol in code){
    pos<-round((posval/first(get(symbol)[,1])[,1]),0)
    addPosLimit(qs.portfolio,symbol,initDate, maxpos=pos,minpos=-pos)
}



#
# 8. Apply Strategy to Porfolio
#
tradeSize <- initEq/topchoice




applyStrategy.rebalancing(strategy = qs.strategy,
              portfolios = qs.portfolio)

updatePortf(qs.portfolio, Symbols=code, Dates=paste('::',as.Date(Sys.time()),sep=''))
updateAcct(qs.account)
updateEndEq(qs.account)