orders <- function(account = "",
instrument = "",
localSymbol,
secType,
exchange,
currency,
conId,
amount,
action,
type,
lmtPrice,
uuid = TRUE) {
res <- data.frame(account,
instrument,
localSymbol,
secType,
exchange,
currency,
amount = abs(amount),
action,
type,
lmtPrice,
uuid = NA_character_,
stringsAsFactors = FALSE)
if (isTRUE(uuid))
res$uuid <- uuid::UUIDgenerate(n = nrow(res))
else if (all(!is.na(uuid)) && (is.character(uuid) || is.numeric(uuid)))
res$uuid <- uuid
class(res) <- c("ib_orders", "data.frame")
res
}
write_orders <- function(orders, dir, ...) {
## takes a data.frame of orders
## and writes to single files
for (i in seq_len(nrow(orders)))
write.table(orders[i, ], sep = ",",
row.names = FALSE,
col.names = TRUE,
file = file.path(dir, orders[i, "uuid"]))
}
read_orders <- function(dir, pattern = NULL, ...) {
## read single files into data.frame
fs <- list.files(dir, full.names = TRUE)
res <- vector("list", length(fs))
for (f in fs)
res[[f]] <- read.table(f, header = TRUE, sep = ",")
res <- do.call(rbind, res)
class(res) <- c("ib_orders", "data.frame")
res
}
send_orders <- function(dir, sent.dir, ...,
port = 7496, clientId = 1) {
fs <- list.files(dir, full.names = TRUE,
pattern = "[^~]$")
wrap <- .wrap$new()
ic <- rib::IBClient$new()
ic$connect(port=port, clientId=clientId)
ic$checkMsg(wrap)
on.exit({
ic$disconnect()
wrap$Settings$storeMessages <- FALSE
})
wrap$Settings$storeMessages <- TRUE
for (f in fs) {
ic$reqIds()
ic$checkMsg(wrap)
orderId <- wrap$Data$nextValidId
if (is.null(wrap$Data$nextValidId)) {
stop("no id")
}
wrap$Data$recentMessages <- list()
o <- read.table(f, header = TRUE, sep = ",")
contract <- rib::Contract
contract$localSymbol <- o$localSymbol
contract$exchange <- o$exchange
contract$currency <- o$currency
contract$secType <- o$secType
order <- rib::Order
order$action <- o$action
order$totalQuantity <- o$amount
order$orderRef <- o$uuid
order$account <- o$account
if (o$type == "LMT") {
order$orderType <- "LMT"
order$lmtPrice <- o$lmtPrice
} else {
order$orderType <- "MKT"
}
ic$placeOrder(orderId, contract, order)
res <- ic$checkMsg(wrap)
if (length(wrap$Data$recentMessages)) {
e <- sapply(wrap$Data$recentMessages, `[[`, 2)
if (any(no.send <- (e %in% 110))) {
m <- sapply(wrap$Data$recentMessages, `[[`, 3)
message("file ", f)
message("==> [ERROR] ", m[no.send])
next
}
}
ic$reqAllOpenOrders()
done <- FALSE
while (!done) {
count <- ic$checkMsg(wrap)
if (count == 0L)
done <- TRUE
Sys.sleep(0.1)
}
known.orders <- sapply(lapply(wrap$Data$orders, `[[`, 3), `[[`, "orderRef")
if (!o$uuid %in% known.orders) {
message("file ", f)
message("==> [WARNING] order ", o$uuid, " not found in current orders")
}
copied <- file.copy(f, sent.dir)
if (copied)
file.remove(f)
else
stop("could not move file ", f)
}
invisible(NULL)
## for (i in seq_len(nrow(orders))) {
## write.table(orders[i, ], sep = ",",
## file = file.path(dir, orders$uuid[i]),
## row.names = FALSE, quote = TRUE)
## }
}
update_orders <- function(dir, ...) {
## fetch order status, move files to executed etc-.
}
## confirmed -- executions
## open -- created
## sent
## executed
## expired
## canceled
## simulated
####################################
## TODO use specific wraps for every function
IBWrap.IButils <-
R6::R6Class("IBWrap.IButils",
class= FALSE,
cloneable= FALSE,
lock_class= TRUE,
inherit= rib::IBWrap,
public = list(
context = NULL,
Data = NULL,
initialize = function() {
self$context <- new.env()
self$context$orders <- list()
self$context$order_status <- list()
self$context$completed_orders <- list()
self$Data <- new.env()
self$Data$executions <- list()
self$Data$positions <- list()
},
error = function(id, errorCode, errorString, advancedOrderRejectJson) {
if (errorCode == 2104)
cat(errorString, "\n")
else
cat(id, errorCode, errorString, "\n")
},
nextValidId = function(orderId) {
self$Data$nextId <- orderId
},
managedAccounts = function(accountsList) {
## cat("Managed Accounts:", accountsList, "\n")
},
orderStatus = function(orderId, status, filled, remaining,
avgFillPrice, permId, parentId, lastFillPrice,
clientId, whyHeld, mktCapPrice) {
self$Data$order_status[[as.character(permId)]] <-
as.list(match.call())[-1L]
},
openOrder= function(orderId, contract, order, orderstate) {
self$Data$orders[[as.character(order$permId)]] <- list(orderId = orderId,
contract = contract,
order = order,
orderstate = orderstate)
## self$Data$order <- list(id=orderId, contract=contract, order=order, orderstate=orderstate)
## cat("OpenOrder:", orderId, "\n")
},
openOrderEnd= function() {
## cat(length(self$Data$orders), " orders found\n")
},
commissionReport= function(commissionReport)
cat("CommissionReport:", unlist(commissionReport), "\n"),
completedOrder= function(contract, order, orderState) {
## self$context$completed <- list(contract=contract, order=order, orderstate=orderState)
self$context$completed_orders[[as.character(order$permId)]] <- list(contract=contract, order=order, orderstate=orderState)
## cat("completedOrder.\n")
},
completedOrdersEnd= function() {
cat(length(self$context$completed_orders), " open orders found\n")
},
execDetails= function(reqId, contract, execution) {
self$Data$executions_contracts[[execution$execId]] <- contract
self$Data$executions[[execution$execId]] <- execution
## cat("ExecDetails:", reqId, contract$symbol, execution$side, execution$shares, execution$price, "\n")
},
execDetailsEnd = function(reqId) {
## cat("ExecDetailsEnd:", reqId, "\n")
},
position = function(account, contract, position, avgCost) {
L <- list(account = account, contract = contract,
position = position, avgCost = avgCost)
self$Data$positions <- c(self$Data$positions, list(L))
## cat("Position:", account, contract$symbol, position, avgCost, "\n")
},
positionEnd= function() {
## cat("PositionEnd.\n")
}
)
)
positions <- function(port = 7496, clientId = 1) {
if (!requireNamespace("rib"))
stop("package ", sQuote("rib"), " is not available")
wrap <- .wrap$new()
ic <- rib::IBClient$new()
capture.output(ic$connect(port = port, clientId = clientId))
on.exit(ic$disconnect())
capture.output(ic$checkMsg(wrap))
ic$reqPositions()
done <- FALSE
while (!done) {
count <- ic$checkMsg(wrap)
if (count == 0L)
done <- TRUE
}
ic$cancelPositions()
ic$checkMsg(wrap)
## account summary (cash)
ic$reqAccountSummary(1, groupName = "All", tags = "$LEDGER")
done <- FALSE
while (!done) {
count <- ic$checkMsg(wrap)
if (count == 0L)
done <- TRUE
}
ic$cancelAccountSummary(1)
ic$checkMsg(wrap)
accountSummary <- do.call(rbind, wrap$Data$accountSummary)
account <- unlist(lapply(wrap$Data$positions, `[[`, "account"))
contract <- lapply(wrap$Data$positions, `[[`, "contract")
contract <- do.call(rbind, contract)
pos <- unlist(lapply(wrap$Data$positions, `[[`, "position"))
cost <- unlist(lapply(wrap$Data$positions, `[[`, "avgCost"))
ans <- cbind(account,
contract,
position = pos,
avg.cost = cost)
ans <- as.data.frame(ans)
attr(ans, "accountSummary") <- accountSummary
ans
}
order_status <- function(port = 7496, clientId = 1) {
if (!requireNamespace("rib"))
stop("package ", sQuote("rib"), " is not available")
wrap <- .wrap$new()
ic <- rib::IBClient$new()
capture.output(ic$connect(port = port, clientId = clientId))
on.exit(ic$disconnect())
capture.output(ic$checkMsg(wrap))
## --------------
ic$reqAllOpenOrders()
done <- FALSE
while (!done) {
count <- ic$checkMsg(wrap)
if (count == 0L)
done <- TRUE
}
if (length(wrap$Data$orders)) {
ans1 <- cbind(
do.call(rbind, wrap$Data$orderStatus)
)
ans2 <- cbind(
do.call(rbind, lapply(wrap$Data$orders, `[[`, "orderId")),
do.call(rbind, lapply(wrap$Data$orders, `[[`, "contract")),
do.call(rbind, lapply(wrap$Data$orders, `[[`, "order")),
do.call(rbind, lapply(wrap$Data$orders, `[[`, "orderstate"))
)
ans <- merge(x = ans1, ans2, by = 0,
suffixes = c(".order_status", ".open_orders"))
row.names(ans) <- ans[["Row.names"]]
ans <- ans[, -1]
class(ans) <- c("order_status", "data.frame")
ans
} else
invisible(NULL)
}
print.order_status <- function(x, all = FALSE, ...) {
if (!all)
print.data.frame(x[, c("account", "orderId.order_status",
"status.order_status",
"conId", "localSymbol", "action",
"totalQuantity", "orderType",
"lmtPrice", "tif")], ...)
else
print.data.frame(x, ...)
invisible(x)
}
executions <- function(port = 7496, clientId = 1) {
if (!requireNamespace("rib"))
stop("package ", sQuote("rib"), " is not available")
wrap <- .wrap$new()
ic <- rib::IBClient$new()
capture.output(ic$connect(port = port, clientId = clientId))
on.exit(ic$disconnect())
capture.output(ic$checkMsg(wrap))
## --------------
ic$reqExecutions(1, filter = rib::ExecutionFilter)
ic$checkMsg(wrap)
ex <- cbind(do.call(rbind, wrap$Data$executions))
ex <- as.data.frame(ex, stringsAsFactors = FALSE)
for (cc in seq_len(length(ex)))
ex[cc] <- unlist(ex[[cc]])
if (!is.null(ex$time))
ex$time <- as.POSIXct(ex$time, format = "%Y%m%d %H:%M:%S")
if (!nrow(ex))
invisible(NULL)
else {
attr(ex, "commissionReport") <- wrap$Data$commissionReport
ex
}
}
## send_orders <- function(orders, port = 7496, clientId = 1) {
## if (!requireNamespace("rib"))
## stop("package ", sQuote("rib"), " is not available")
## wrap <- IBWrap.IButils$new()
## ic <- rib::IBClient$new(wrap)
## capture.output(ic$connect(port = port, clientId = clientId))
## on.exit(ic$disconnect())
## capture.output(ic$checkMsg(wrap))
## ## --------------
## contract <- rib::Contract
## contract$localSymbol <- "FGBL JUN 20"
## contract$exchange <- "DTB"
## contract$currency <- "EUR"
## contract$secType <- "FUT"
## order <- rib::Order
## order$action <- "BUY"
## order$totalQuantity <- 1
## order$lmtPrice <- 169
## order$orderType <- "LMT"
## order$orderRef <- "Test1"
## ic$placeOrder(id = wrap$Data$nextId, contract = contract, order)
## capture.output(ic$checkMsg(wrap))
## }
contract_details <- function(localSymbol,
secType,
exchange,
currency,
port = 7496, clientId = 1) {
if (!requireNamespace("rib"))
stop("package ", sQuote("rib"), " is not available")
wrap <- wrap0$new()
ic <- rib::IBClient$new()
msg1 <- capture.output(ic$connect(port = port, clientId = clientId))
on.exit(ic$disconnect())
msg2 <- (n <- ic$checkMsg(wrap))
if (is.list(localSymbol)) {
contract <- rib::Contract
contract[names(localSymbol)] <- localSymbol
} else
contract <- rib::IBContract(localSymbol = localSymbol,
secType = secType,
exchange = exchange,
currency = currency)
contract$includeExpired <- grepl("OPT|FUT|FOP", contract$secType)
ic$reqContractDetails(1, contract = contract)
msg3 <- (n <- ic$checkMsg(wrap))
ans <- wrap$Data$contract[[1]]
attr(ans, "messages") <- c(msg1, msg2, msg3)
ans
}
ib_hist_data2 <- function(contract,
durationString = "3 D",
barSizeSetting = "1 min",
whatToShow = "MIDPOINT",
start,
end = Sys.time(),
port = 7496,
wait = 1) {
H <- NULL
wrap <- rib::IBWrapSimple$new()
ic <- rib::IBClient$new(wrap)
ic$connect(port=port, clientId=sample(1e8, size = 1))
on.exit(ic$disconnect())
ic$checkMsg(timeout = wait)
tickerId <- 0
while (start < end) {
## end <- as.POSIXct("2020-02-20 16:00:00", tz = "UTC")
end <- format(end, "%Y%m%d %H:%M:%S")
## tickerId <- tickerId + 1
ic$reqHistoricalData(tickerId,
contract,
endDateTime = end,
durationStr = durationString,
barSizeSetting = barSizeSetting,
whatToShow = whatToShow,
useRTH = TRUE,
formatDate = "2",
keepUpToDate = FALSE)
while (!ic$checkMsg(timeout = wait)) {
## nrow(wrap$context$historical)
Sys.sleep(0.1)
}
h0 <- wrap$context$historical
if (!is.null(H$time))
h0 <- h0[h0$time < min(H$time), ]
H <- rbind(h0, H)
end <- .POSIXct(min(H[, "time"]))
}
H$time <- .POSIXct(as.numeric(H$time))
H
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.