Hello R and finance experts,

I am trying to figure out how (if possible) I would be able to download
quotes from IB of several thousands instruments (I need OHLCV as often as
possible during the day but especially as close to the market close as
possible). For now it seems to that something like that is impossible using
R, IBrokers and my limited knowledge.

My code below is simply to slow. And I do not know where the problem is. I
have followed what Jeff has written here
https://stat.ethz.ch/pipermail/r-sig-finance/2010q3/006539.html. I used the
snapShot xample from Jeff as CALLBACK and created a new wrapper that enables
OHLC.

I guess my approach is not correct. How do you download quotes/OHLCV (at
least just before the close) of several thosand (or at least
hundreds) instruments as often as possible? What is the best
approach/technology/architecture?

snapShot<-function (twsCon, eWrapper, timestamp, file, playback = 1, ...)
{
 if (missing(eWrapper))
  eWrapper <- eWrapper()
 names(eWrapper$.Data$data) <- eWrapper$.Data$symbols
 con <- twsCon[[1]]
 if (inherits(twsCon, "twsPlayback")) {
  sys.time <- NULL
  while (TRUE) {
   if (!is.null(timestamp)) {
    last.time <- sys.time
    sys.time <- as.POSIXct(strptime(paste(readBin(con,
            character(), 2), collapse = " "), timestamp))
    if (!is.null(last.time)) {
     Sys.sleep((sys.time - last.time) * playback)
    }
    curMsg <- .Internal(readBin(con, "character",
        1L, NA_integer_, TRUE, FALSE))
    if (length(curMsg) < 1)
     next
    processMsg(curMsg, con, eWrapper, format(sys.time,
        timestamp), file, ...)
   }
   else {
    curMsg <- readBin(con, character(), 1)
    if (length(curMsg) < 1)
     next
    processMsg(curMsg, con, eWrapper, timestamp,
      file, ...)
    if (curMsg == .twsIncomingMSG$REAL_TIME_BARS)
     Sys.sleep(5 * playback)
   }
  }
 }
 else {
  while (TRUE) {
   socketSelect(list(con), FALSE, NULL)
   curMsg <- .Internal(readBin(con, "character", 1L,
       NA_integer_, TRUE, FALSE))
   if (!is.null(timestamp)) {
    processMsg(curMsg, con, eWrapper, format(Sys.time(),
        timestamp), file, ...)
   }
   else {
    processMsg(curMsg, con, eWrapper, timestamp,
      file, ...)
   }
   if (!any(sapply(eWrapper$.Data$data, is.na)))
    return(do.call(rbind, lapply(eWrapper$.Data$data,
          as.data.frame)))
  }
 }
}

eWrapper.data.BID_ASK_OHLCV <- function(n) {
 # internally updated data
 eW <- eWrapper(NULL)  # use basic template
 eW$assign.Data("data",
rep(list(structure(.xts(matrix(rep(NA_real_,11),nc=11),0),
         .Dimnames=list(NULL,
           c("BidSize","BidPrice",
             "AskPrice","AskSize",
             "Last",
             "Open","High","Low","Close",
             "LastSize","Volume")))),n))

 eW$tickPrice <- function(curMsg, msg, timestamp, file, ...)
 {
  tickType = msg[3]
  msg <- as.numeric(msg)
  id <- msg[2] #as.numeric(msg[2])
  data <- eW$get.Data("data") #[[1]]  # list position of symbol (by id ==
msg[2])
  attr(data[[id]],"index") <- as.numeric(Sys.time())
#    data[[1]] <- rbind(data[[1]],.xts(matrix(rep(NA_real_,7),nc=7),
Sys.time()))
  nr.data <- NROW(data[[id]])
  #data[[id]][1] <- as.numeric(Sys.time()) #timestamp
  if(tickType == .twsTickType$BID) {
   data[[id]][nr.data,1:2] <- msg[5:4]
  } else
  if(tickType == .twsTickType$ASK) {
   data[[id]][nr.data,3:4] <- msg[4:5]
  } else
  if(tickType == .twsTickType$LAST) {
   data[[id]][nr.data,5] <- msg[4]
  } else
  if(tickType == .twsTickType$OPEN) {
   data[[id]][nr.data,6] <- msg[4]
  } else
  if(tickType == .twsTickType$HIGH) {
   data[[id]][nr.data,7] <- msg[4]
  } else
  if(tickType == .twsTickType$LOW) {
   data[[id]][nr.data,8] <- msg[4]
  } else
  if(tickType == .twsTickType$CLOSE) {
   data[[id]][nr.data,9] <- msg[4]
  }
  eW$assign.Data("data", data)
  c(curMsg, msg)
 }
 eW$tickSize  <- function(curMsg, msg, timestamp, file, ...)
 {
  data <- eW$get.Data("data")
  tickType = msg[3]
  msg <- as.numeric(msg)
  id <- as.numeric(msg[2])
#    data[[1]] <- rbind(data[[1]],.xts(matrix(rep(NA_real_,7),nc=7),
Sys.time()))
  attr(data[[id]],"index") <- as.numeric(Sys.time())
  nr.data <- NROW(data[[id]])
  #data[[id]][1] <- as.numeric(Sys.time()) #timestamp
  if(tickType == .twsTickType$BID_SIZE) {
   data[[id]][nr.data,1] <- msg[4]
  } else
  if(tickType == .twsTickType$ASK_SIZE) {
   data[[id]][nr.data,4] <- msg[4]
  } else
  if(tickType == .twsTickType$LAST_SIZE) {
   data[[id]][nr.data,10] <- msg[4]
  } else
  if(tickType == .twsTickType$VOLUME) {
   data[[id]][nr.data,11] <- msg[4]
  }
  eW$assign.Data("data", data)
  c(curMsg, msg)
 }
 return(eW)
}

require(IBrokers)
tws <- twsConnect()
nms <- c("SPY", "QQQ", "DIA", "IWM", "XIV",
"AAPL","YHOO","AMZN","CSCO","BBY","A","AAR","AA","PCM","PEP","SAP","ZMH","MSFT")
reqMktData(tws, lapply(nms,twsSTK),
eventWrapper=eWrapper.data.BID_ASK_OHLCV(length(nms)),CALLBACK=snapShot)
system.time(reqMktData(tws, lapply(nms,twsSTK),
eventWrapper=eWrapper.data.BID_ASK_OHLCV(length(nms)),CALLBACK=snapShot))
twsDisconnect(tws)

Regards,
S.

	[[alternative HTML version deleted]]

