2013-02-26 12 views
5

Używam zmodyfikowanej funkcji snapShot z wielkiego pakietu IBrokers, aby uzyskać "ostatnie" ceny od IB i działa świetnie na płynnych zapasach. Połączenie, które wykonuję, to np.IBrokers reqMktData, jak dodać limit czasu do funkcji zwrotnej?

reqMktData(tws, twsSTK("AAPL"), eventWrapper=eWrapper.data.Last(1),CALLBACK=snapShot) 

Problem pojawia się podczas próby odzyskania bardzo niepłynnych zapasów lub opcji. W związku z tym muszę dodać limit czasu do funkcji snapShot. Jak i gdzie można dodać limit czasu?

Kod z funkcją Snapshot:

library(IBrokers) 
tws <- twsConnect() 

eWrapper.data.Last <- function(n) { 
    eW <- eWrapper(NULL) # use basic template 
    eW$assign.Data("data", rep(list(structure(.xts(matrix(rep(NA_real_,2),nc=2),0), 
             .Dimnames=list(NULL,c("LastSize","Last")))),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()) 
    nr.data <- NROW(data[[id]]) 
    if(tickType == .twsTickType$LAST) { 
     data[[id]][nr.data,2] <- 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]) 
    attr(data[[id]],"index") <- as.numeric(Sys.time()) 
    nr.data <- NROW(data[[id]]) 
    if(tickType == .twsTickType$LAST_SIZE) { 
     data[[id]][nr.data,1] <- msg[4] 
    } 
    eW$assign.Data("data", data) 
    c(curMsg, msg) 
    } 
    return(eW) 
} 

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))) 
     } 
    } 
} 
+0

Czy to funkcja Snapshot z tym poście [] (http://www.mail-archive.com/[email protected]/msg00927.html)? – GSee

+0

tak! Ale poprawiono nazwy kolumn: – nikke

+0

sry, faktycznie był to wariant, z którego pochodzi tylko "Last": http://marc.info/?l=r-sig-finance&m=131662968112461 , ale z nazwami kolumn zmienionymi – nikke

Odpowiedz

4

Można użyć evalWithTimeout z R.utils. Nie testowałem tego, ale jestem pewien, że owinięcie wokół pętli while osiągnie to, o co prosisz.

library(R.utils) 

evalWithTimeout(
    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))) 
    }, timeout=5, onTimeout="warning") 
+0

Cześć! Dzięki! Nie myślałem o tym prostym i eleganckim rozwiązaniu. Zapewne zauważyłeś, że oryginalna część opublikowanego przeze mnie kodu pochodziła z listy mailingowej, również przez ciebie :) – nikke

+0

Właściwie, stanowisko, do którego się przyłączyłem, było napisane przez Jeffa. – GSee

+0

To był faktycznie wariant z tego miejsca, który pobiera tylko "Ostatni": marc.info/?l=r-sig-finance&m=131662968112461, ale z nazwami kolumn zmienionymi – nikke