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 | } |