View difference between Paste ID: FYp3dwCX and nztFegdL
SHOW: | | - or go back to the newest paste.
1-
#difference to the other is timer which waits 10s and 
1+
2
library(IBrokers)
3
#tws <- twsConnect()
4
5
eWrapper.data.Last <- function(n) {
6
  eW <- eWrapper(NULL)  # use basic template
7
  eW$assign.Data("data", rep(list(structure(.xts(matrix(rep(NA_real_,2),nc=2),0),
8
                                      .Dimnames=list(NULL,c("LastSize","Last")))),n))
9
10
  eW$tickPrice <- function(curMsg, msg, timestamp, file, ...) 
11
  {
12
    tickType = msg[3]
13
    msg <- as.numeric(msg)
14
    id <- msg[2] #as.numeric(msg[2])
15
    data <- eW$get.Data("data") #[[1]]  # list position of symbol (by id == msg[2])
16
    attr(data[[id]],"index") <- as.numeric(Sys.time())
17
    nr.data <- NROW(data[[id]])
18
    if(tickType == .twsTickType$LAST) {
19
      data[[id]][nr.data,2] <- msg[4]
20
    }
21
    eW$assign.Data("data", data)
22
    c(curMsg, msg)
23
  }
24
  eW$tickSize  <- function(curMsg, msg, timestamp, file, ...) 
25
  { 
26
    data <- eW$get.Data("data")
27
    tickType = msg[3]
28
    msg <- as.numeric(msg)
29
    id <- as.numeric(msg[2])
30
    attr(data[[id]],"index") <- as.numeric(Sys.time())
31
    nr.data <- NROW(data[[id]])
32
    if(tickType == .twsTickType$LAST_SIZE) {
33
      data[[id]][nr.data,1] <- msg[4]
34
    } 
35
    eW$assign.Data("data", data)
36
    c(curMsg, msg)
37
  }
38
  return(eW)
39
}
40
41
snapShot <- function (twsCon, eWrapper, timestamp, file, playback = 1, ...)
42
{
43
   if (missing(eWrapper))
44
       eWrapper <- eWrapper()
45
   names(eWrapper$.Data$data) <- eWrapper$.Data$symbols
46
   con <- twsCon[[1]]
47
   starttime <- Sys.time()
48
   if (inherits(twsCon, "twsPlayback")) {
49
       sys.time <- NULL
50
       
51
       while (TRUE) {
52
           if (!is.null(timestamp)) {
53
               last.time <- sys.time
54
               sys.time <- as.POSIXct(strptime(paste(readBin(con,
55
                 character(), 2), collapse = " "), timestamp))
56
               if (!is.null(last.time)) {
57
                 Sys.sleep((sys.time - last.time) * playback)
58
               }
59
               curMsg <- .Internal(readBin(con, "character",
60
                 1L, NA_integer_, TRUE, FALSE))
61
               if (length(curMsg) < 1)
62
                 next
63
               processMsg(curMsg, con, eWrapper, format(sys.time,
64
                 timestamp), file, ...)
65
           }
66
           else {
67
               curMsg <- readBin(con, character(), 1)
68
               if (length(curMsg) < 1)
69
                 next
70
               processMsg(curMsg, con, eWrapper, timestamp,
71
                 file, ...)
72
               if (curMsg == .twsIncomingMSG$REAL_TIME_BARS)
73
                 Sys.sleep(5 * playback)
74
           }
75
       }
76
   }
77
   else {
78
       evalWithTimeout(
79
       while (TRUE) {
80
  
81
         socketSelect(list(con), FALSE, NULL)
82
         curMsg <- .Internal(readBin(con, "character", 1L,
83
                                     NA_integer_, TRUE, FALSE))
84
         if (!is.null(timestamp)) {
85
           processMsg(curMsg, con, eWrapper, format(Sys.time(),
86
                                                    timestamp), file, ...)
87
         }
88
         else {
89
           processMsg(curMsg, con, eWrapper, timestamp,
90
                      file, ...)
91
         }
92
         if (!any(sapply(eWrapper$.Data$data, is.na)) | Sys.time()-starttime > 10  ) {
93
           cat(Sys.time()-starttime )
94
           return(do.call(rbind, lapply(eWrapper$.Data$data, as.data.frame)))
95
     
96
         }
97
       },  timeout=20, onTimeout="warning" )
98
       cat(Sys.time()-starttime )
99
  
100
   }
101
}