fv = order$fv,
volume = t.vol,
id.offer = order.best$id,
id.accept = order$id
)
# Adds timing of trade to orders
orders$time.traded[orders$id == order.best$id] <- order$time.index
orders$time.traded[orders$id == order$id] <- order$time.index
# Deletes fully transacted orders from the book
if (order.best$volume.remaining == 0) {
t.ob <- t.ob[t.ob$id != order.best$id, ]
}
# Finsh handling this order, if it was fully transacted
if (order$volume.remaining == 0) {
break
}
} else {
# If order was not fully transacted, write it to the order book
if (order$volume.remaining > 0) {
t.ob[nrow(t.ob) + 1, ] <- order
}
# Then exit
break
}
}
}
}
}
cleanup() # Deletes temporary variables
# Plot --------------------------------------------------------------------
plot(x = orders$time.index, y = orders$price, lty = 1, lwd = 1, ylab = "price", xlab = "period", col = orders$direction + 3, main = par.main)
# lines(x=orders$time.index,y=orders$fv,type="l",lty=1,lwd=2,col="black")
lines(x = trades$time.index, y = trades$price, type = "l", lty = 1, lwd = 1, col = "red")
legend(x = "topleft", col = c(4, 2), legend = c("bids", "asks"), pch = 1)
# Plot<- ggplot(data=orders, aes(x=time.index)) +
#     geom_point(data = orders,
#                mapping = aes(x = time.index, y = price, shape = factor(direction),color=factor(direction)))+
#     geom_line(aes(y=fv),color="black",size=1.5)+
#     coord_cartesian(xlim = c(min(par.Periods),max(par.Periods)),ylim=c(0,200))
# Plot
setwd("D:/Institut/#CurrentWork/DE/Software")
cleanup(c("^t[.]","^order.best$","^order$")) # Deletes temporary variables
cleanup<-function(pattern="^t[.]"){
for(p in pattern){
objs <- ls(pos = ".GlobalEnv")
rm(list = objs[grep(p, objs)], pos = ".GlobalEnv")
}
}
cleanup(c("^t[.]","^order.best$","^order$")) # Deletes temporary variables
# Preamble ----------------------------------------------------------------
rm(list = ls()) # Clears memory
graphics.off() # Clears plots
# Package installation ----------------------------------------------------
if (!require("devtools")) install.packages("devtools") # Installs package for github installation
library("devtools") # Loads necessary package
install_github("stpalan/SPTools") # Installs necessary package
library("SPTools") # Loads necessary package
SPLoadPackages(c(
"tidyverse"
))
# Parameter definition ----------------------------------------------------
par.Periods <- seq(from = -2, to = 30, by = 1) # Number of trading periods (negative-numbered periods are non-trading simulation periods)
par.PeriodLength <- 60 # Length in seconds of an experimental trading period
par.PriceStart <- 100 # Asset starting price (e$)
par.Returns <- c(0.06, -0.05) # Returns in case of upwards/downwards price movement
par.p <- 0.5 # Probability of an upwards price movement
par.lambda <- .3 # Arrival rate (Poisson distribution lambda) of orders
par.ProbBuy <- 0.5 # Probability of any given order being a buy order
par.ProbMarket <- 0.4 # Probability ofany given order being a market order
par.offer.sd <- 0.025 # Offer price standard deviation as a fraction of fundamental value
par.offset <- c(0.02, -0.02) # Average distance to the midpoint of (asks,bids) in % of midpoint price
par.times.todraw <- 100000 # Number of time steps to draw initially
par.ttl.meanlog <- 0 # Meanlog of lognormal distribution to determine time to live of orders
par.ttl.sdlog <- 1 # Meanlog of lognormal distribution to determine time to live of orders
par.ttl.multiplier <- .5 # Meanlog of lognormal distribution to determine time to live of orders
par.main <- "par.ProbBuy = " %_% round(par.ProbBuy, 2) %_% ", par.ProbMarket = " %_% round(par.ProbMarket, 2) %_% ", par.lambda = " %_% par.lambda %_% ", par.offer.sd = " %_% par.offer.sd %_% ",par.offset = +/-" %_% par.offset[1] %_% ",\nttl: par.ttl.meanlog=" %_% par.ttl.meanlog %_% ", par.ttl.sdlog=" %_% par.ttl.sdlog %_% ", par.ttl.multiplier=" %_% par.ttl.multiplier %_% "" # Title of the diagram
# Simulation --------------------------------------------------------------
set.seed(0) # Randomizes
# Defines fundamental value dataframe and fills in returns and values
fv <- data.frame(
period = par.Periods,
ret = sample(par.Returns, size = length(par.Periods), replace = T, prob = c(par.p, 1 - par.p))
)
fv <- fv %>%
mutate(
ret.cum = cumprod(1 + ret) - 1,
value = par.PriceStart * (1 + ret.cum), # Value at the end of the period
value.start = c(par.PriceStart, lag(value)[2:length(value)]) # Value at the start of the period
)
fv <- fv %>%
add_row(period = min(par.Periods) - 1, ret = NA, ret.cum = NA, value = 100, value.start = NA, .before = 1)
# Generate times at which an order is submitted
repeat{
t.o <- data.frame(time = rexp(par.times.todraw, par.lambda)) %>%
mutate(
time.index = cumsum(time / par.PeriodLength) + min(par.Periods) - 1,
time.withinperiod = ifelse(time.index < 0, time.index - (trunc(time.index) - 1), time.index - trunc(time.index)) * par.PeriodLength
)
if (max(t.o$time.index) > max(par.Periods)) {
orders <- t.o %>%
filter(time.index < max(par.Periods))
break
}
}
# Add variables to orders dataframe
orders <- orders %>%
mutate(
period = trunc(time.index + length(par.Periods)) - length(par.Periods) + 1,
market = rbinom(n = n(), size = 1, prob = par.ProbMarket),
direction = rbinom(n = n(), size = 1, prob = par.ProbBuy) * 2 - 1,
id = seq.int(n()),
volume.original = 1,
volume.remaining = volume.original,
time.expiry = time.index + rlnorm(n = n(), meanlog = par.ttl.meanlog, sdlog = par.ttl.sdlog) * par.ttl.multiplier
)
# Add fundamental value and price to orders
for (fR in orders$id) {
# Adds the fundamental value at time time.withinperiod, arrived at by linearly interpolating between fv at start and end of the period
orders$fv[fR] <- approx(c(0, par.PeriodLength), fv[fv$period == orders$period[fR], c("value.start", "value")], orders$time.withinperiod[fR])[[2]]
# Adds the randomly drawn price if this is a limit order, otherwise NA
orders$price[fR] <- ifelse(orders$market[fR] == 1, NA, round(orders$fv[fR] * (1 + rnorm(n = 1, mean = par.offset[orders$direction[fR] / 2 + 1.5], sd = par.offer.sd)), 2))
}
# Order variables
orders <- orders %>%
mutate(time.traded = NA) %>%
relocate(id, period, time.index, time.expiry, time.withinperiod, time, market, direction, fv, price, volume.original, volume.remaining)
# Prepares dataframe to hold trades
trades <- data.frame(
id = integer(),
period = integer(),
time.index = numeric(),
price = numeric(),
fv = numeric(),
volume = integer(),
id.offer = integer(),
id.accept = integer()
)
# Prepares dataframe to hold orderbook (by copying empty orders)
t.ob <- orders[0, ]
for (fR in 1:nrow(orders)) {
# Extracts offer that is currently to be processed
order <- orders[fR, ]
# Updates order book
t.ob <- t.ob[t.ob$time.expiry > order$time.index, ]
# Offer is a bid
if (order$direction == 1) {
# Loop to handle multi-unit cases
repeat{
# Calculates summary information about current order book state
t.ob.num.asks <- as.numeric(t.ob %>% filter(direction == -1) %>% tally())
# There is no ask in the order book
if (t.ob.num.asks == 0) {
# If current order is a limit order, add it to the order book and exit, otherwise just exit
if (!order$market) {
t.ob[nrow(t.ob) + 1, ] <- order
}
break
# There is at least one ask in the order book
} else {
# #Loop to handle multi-unit cases
# repeat{
# Extract best order on the opposite side of the book
order.best <- t.ob %>%
filter(direction == -1) %>%
arrange(price, time.index) %>%
head(1)
# Processes trade, if trade is possible
if (order.best$price <= order$price | is.na(order$price)) {
# Updates orders
t.vol <- min(order$volume.remaining, order.best$volume.remaining) # Calculate transactable volume
order$volume.remaining <- order$volume.remaining - t.vol # Reduce volume remaining of the current order
order.best$volume.remaining <- order.best$volume.remaining - t.vol # Reduce volume remaining of the best opposite-side order in the book
# Writes trade
trades[nrow(trades) + 1, ] <- data.frame(
id = ifelse(nrow(trades) == 0, 1, max(trades$id + 1)),
period = order$period,
time.index = order$time.index,
price = order.best$price,
fv = order$fv,
volume = t.vol,
id.offer = order.best$id,
id.accept = order$id
)
# Adds timing of trade to orders
orders$time.traded[orders$id == order.best$id] <- order$time.index
orders$time.traded[orders$id == order$id] <- order$time.index
# Deletes fully transacted orders from the book
if (order.best$volume.remaining == 0) {
t.ob <- t.ob[t.ob$id != order.best$id, ]
}
# Finsh handling this order, if it was fully transacted
if (order$volume.remaining == 0) {
break
}
} else {
# If order was not fully transacted, write it to the order book
if (order$volume.remaining > 0) {
t.ob[nrow(t.ob) + 1, ] <- order
}
# Then exit
break
}
}
}
# Offer is an ask
} else {
# Loop to handle multi-unit cases
repeat{
# Calculates summary information about current order book state
t.ob.num.bids <- as.numeric(t.ob %>% filter(direction == 1) %>% tally())
# There is no ask in the order book
if (t.ob.num.bids == 0) {
# If current order is a limit order, add it to the order book and exit, otherwise just exit
if (!order$market) {
t.ob[nrow(t.ob) + 1, ] <- order
}
break
# There is at least one ask in the order book
} else {
# #Loop to handle multi-unit cases
# repeat{
# Extract best order on the opposite side of the book
order.best <- t.ob %>%
filter(direction == 1) %>%
arrange(-price, time.index) %>%
head(1)
# Processes trade, if trade is possible
if (order.best$price >= order$price | is.na(order$price)) {
# Updates orders
t.vol <- min(order$volume.remaining, order.best$volume.remaining) # Calculate transactable volume
order$volume.remaining <- order$volume.remaining - t.vol # Reduce volume remaining of the current order
order.best$volume.remaining <- order.best$volume.remaining - t.vol # Reduce volume remaining of the best opposite-side order in the book
# Writes trade
trades[nrow(trades) + 1, ] <- data.frame(
id = ifelse(nrow(trades) == 0, 1, max(trades$id + 1)),
period = order$period,
time.index = order$time.index,
price = order.best$price,
fv = order$fv,
volume = t.vol,
id.offer = order.best$id,
id.accept = order$id
)
# Adds timing of trade to orders
orders$time.traded[orders$id == order.best$id] <- order$time.index
orders$time.traded[orders$id == order$id] <- order$time.index
# Deletes fully transacted orders from the book
if (order.best$volume.remaining == 0) {
t.ob <- t.ob[t.ob$id != order.best$id, ]
}
# Finsh handling this order, if it was fully transacted
if (order$volume.remaining == 0) {
break
}
} else {
# If order was not fully transacted, write it to the order book
if (order$volume.remaining > 0) {
t.ob[nrow(t.ob) + 1, ] <- order
}
# Then exit
break
}
}
}
}
}
cleanup(c("^t[.]","^order.best$","^order$","^fR$")) # Deletes temporary variables
# Plot --------------------------------------------------------------------
plot(x = orders$time.index, y = orders$price, lty = 1, lwd = 1, ylab = "price", xlab = "period", col = orders$direction + 3, main = par.main)
# lines(x=orders$time.index,y=orders$fv,type="l",lty=1,lwd=2,col="black")
lines(x = trades$time.index, y = trades$price, type = "l", lty = 1, lwd = 1, col = "red")
legend(x = "topleft", col = c(4, 2), legend = c("bids", "asks"), pch = 1)
# Plot<- ggplot(data=orders, aes(x=time.index)) +
#     geom_point(data = orders,
#                mapping = aes(x = time.index, y = price, shape = factor(direction),color=factor(direction)))+
#     geom_line(aes(y=fv),color="black",size=1.5)+
#     coord_cartesian(xlim = c(min(par.Periods),max(par.Periods)),ylim=c(0,200))
# Plot
cleanup
setwd("D:/Dokumente/R")
#create("SPTools")
setwd("./SPTools")
document()
# Preamble ----------------------------------------------------------------
rm(list = ls()) # Clears memory
graphics.off() # Clears plots
# Package installation ----------------------------------------------------
if (!require("devtools")) install.packages("devtools") # Installs package for github installation
library("devtools") # Loads necessary package
install_github("stpalan/SPTools") # Installs necessary package
library("SPTools") # Loads necessary package
SPLoadPackages(c(
"tidyverse"
))
# Parameter definition ----------------------------------------------------
par.Periods <- seq(from = -2, to = 30, by = 1) # Number of trading periods (negative-numbered periods are non-trading simulation periods)
par.PeriodLength <- 60 # Length in seconds of an experimental trading period
par.PriceStart <- 100 # Asset starting price (e$)
par.Returns <- c(0.06, -0.05) # Returns in case of upwards/downwards price movement
par.p <- 0.5 # Probability of an upwards price movement
par.lambda <- .3 # Arrival rate (Poisson distribution lambda) of orders
par.ProbBuy <- 0.5 # Probability of any given order being a buy order
par.ProbMarket <- 0.4 # Probability ofany given order being a market order
par.offer.sd <- 0.025 # Offer price standard deviation as a fraction of fundamental value
par.offset <- c(0.02, -0.02) # Average distance to the midpoint of (asks,bids) in % of midpoint price
par.times.todraw <- 100000 # Number of time steps to draw initially
par.ttl.meanlog <- 0 # Meanlog of lognormal distribution to determine time to live of orders
par.ttl.sdlog <- 1 # Meanlog of lognormal distribution to determine time to live of orders
par.ttl.multiplier <- .5 # Meanlog of lognormal distribution to determine time to live of orders
par.main <- "par.ProbBuy = " %_% round(par.ProbBuy, 2) %_% ", par.ProbMarket = " %_% round(par.ProbMarket, 2) %_% ", par.lambda = " %_% par.lambda %_% ", par.offer.sd = " %_% par.offer.sd %_% ",par.offset = +/-" %_% par.offset[1] %_% ",\nttl: par.ttl.meanlog=" %_% par.ttl.meanlog %_% ", par.ttl.sdlog=" %_% par.ttl.sdlog %_% ", par.ttl.multiplier=" %_% par.ttl.multiplier %_% "" # Title of the diagram
# Simulation --------------------------------------------------------------
set.seed(0) # Randomizes
# Defines fundamental value dataframe and fills in returns and values
fv <- data.frame(
period = par.Periods,
ret = sample(par.Returns, size = length(par.Periods), replace = T, prob = c(par.p, 1 - par.p))
)
fv <- fv %>%
mutate(
ret.cum = cumprod(1 + ret) - 1,
value = par.PriceStart * (1 + ret.cum), # Value at the end of the period
value.start = c(par.PriceStart, lag(value)[2:length(value)]) # Value at the start of the period
)
fv <- fv %>%
add_row(period = min(par.Periods) - 1, ret = NA, ret.cum = NA, value = 100, value.start = NA, .before = 1)
# Generate times at which an order is submitted
repeat{
t.o <- data.frame(time = rexp(par.times.todraw, par.lambda)) %>%
mutate(
time.index = cumsum(time / par.PeriodLength) + min(par.Periods) - 1,
time.withinperiod = ifelse(time.index < 0, time.index - (trunc(time.index) - 1), time.index - trunc(time.index)) * par.PeriodLength
)
if (max(t.o$time.index) > max(par.Periods)) {
orders <- t.o %>%
filter(time.index < max(par.Periods))
break
}
}
# Add variables to orders dataframe
orders <- orders %>%
mutate(
period = trunc(time.index + length(par.Periods)) - length(par.Periods) + 1,
market = rbinom(n = n(), size = 1, prob = par.ProbMarket),
direction = rbinom(n = n(), size = 1, prob = par.ProbBuy) * 2 - 1,
id = seq.int(n()),
volume.original = 1,
volume.remaining = volume.original,
time.expiry = time.index + rlnorm(n = n(), meanlog = par.ttl.meanlog, sdlog = par.ttl.sdlog) * par.ttl.multiplier
)
# Add fundamental value and price to orders
for (fR in orders$id) {
# Adds the fundamental value at time time.withinperiod, arrived at by linearly interpolating between fv at start and end of the period
orders$fv[fR] <- approx(c(0, par.PeriodLength), fv[fv$period == orders$period[fR], c("value.start", "value")], orders$time.withinperiod[fR])[[2]]
# Adds the randomly drawn price if this is a limit order, otherwise NA
orders$price[fR] <- ifelse(orders$market[fR] == 1, NA, round(orders$fv[fR] * (1 + rnorm(n = 1, mean = par.offset[orders$direction[fR] / 2 + 1.5], sd = par.offer.sd)), 2))
}
# Order variables
orders <- orders %>%
mutate(time.traded = NA) %>%
relocate(id, period, time.index, time.expiry, time.withinperiod, time, market, direction, fv, price, volume.original, volume.remaining)
# Prepares dataframe to hold trades
trades <- data.frame(
id = integer(),
period = integer(),
time.index = numeric(),
price = numeric(),
fv = numeric(),
volume = integer(),
id.offer = integer(),
id.accept = integer()
)
# Prepares dataframe to hold orderbook (by copying empty orders)
t.ob <- orders[0, ]
for (fR in 1:nrow(orders)) {
# Extracts offer that is currently to be processed
order <- orders[fR, ]
# Updates order book
t.ob <- t.ob[t.ob$time.expiry > order$time.index, ]
# Offer is a bid
if (order$direction == 1) {
# Loop to handle multi-unit cases
repeat{
# Calculates summary information about current order book state
t.ob.num.asks <- as.numeric(t.ob %>% filter(direction == -1) %>% tally())
# There is no ask in the order book
if (t.ob.num.asks == 0) {
# If current order is a limit order, add it to the order book and exit, otherwise just exit
if (!order$market) {
t.ob[nrow(t.ob) + 1, ] <- order
}
break
# There is at least one ask in the order book
} else {
# #Loop to handle multi-unit cases
# repeat{
# Extract best order on the opposite side of the book
order.best <- t.ob %>%
filter(direction == -1) %>%
arrange(price, time.index) %>%
head(1)
# Processes trade, if trade is possible
if (order.best$price <= order$price | is.na(order$price)) {
# Updates orders
t.vol <- min(order$volume.remaining, order.best$volume.remaining) # Calculate transactable volume
order$volume.remaining <- order$volume.remaining - t.vol # Reduce volume remaining of the current order
order.best$volume.remaining <- order.best$volume.remaining - t.vol # Reduce volume remaining of the best opposite-side order in the book
# Writes trade
trades[nrow(trades) + 1, ] <- data.frame(
id = ifelse(nrow(trades) == 0, 1, max(trades$id + 1)),
period = order$period,
time.index = order$time.index,
price = order.best$price,
fv = order$fv,
volume = t.vol,
id.offer = order.best$id,
id.accept = order$id
)
# Adds timing of trade to orders
orders$time.traded[orders$id == order.best$id] <- order$time.index
orders$time.traded[orders$id == order$id] <- order$time.index
# Deletes fully transacted orders from the book
if (order.best$volume.remaining == 0) {
t.ob <- t.ob[t.ob$id != order.best$id, ]
}
# Finsh handling this order, if it was fully transacted
if (order$volume.remaining == 0) {
break
}
} else {
# If order was not fully transacted, write it to the order book
if (order$volume.remaining > 0) {
t.ob[nrow(t.ob) + 1, ] <- order
}
# Then exit
break
}
}
}
# Offer is an ask
} else {
# Loop to handle multi-unit cases
repeat{
# Calculates summary information about current order book state
t.ob.num.bids <- as.numeric(t.ob %>% filter(direction == 1) %>% tally())
# There is no ask in the order book
if (t.ob.num.bids == 0) {
# If current order is a limit order, add it to the order book and exit, otherwise just exit
if (!order$market) {
t.ob[nrow(t.ob) + 1, ] <- order
}
break
# There is at least one ask in the order book
} else {
# #Loop to handle multi-unit cases
# repeat{
# Extract best order on the opposite side of the book
order.best <- t.ob %>%
filter(direction == 1) %>%
arrange(-price, time.index) %>%
head(1)
# Processes trade, if trade is possible
if (order.best$price >= order$price | is.na(order$price)) {
# Updates orders
t.vol <- min(order$volume.remaining, order.best$volume.remaining) # Calculate transactable volume
order$volume.remaining <- order$volume.remaining - t.vol # Reduce volume remaining of the current order
order.best$volume.remaining <- order.best$volume.remaining - t.vol # Reduce volume remaining of the best opposite-side order in the book
# Writes trade
trades[nrow(trades) + 1, ] <- data.frame(
id = ifelse(nrow(trades) == 0, 1, max(trades$id + 1)),
period = order$period,
time.index = order$time.index,
price = order.best$price,
fv = order$fv,
volume = t.vol,
id.offer = order.best$id,
id.accept = order$id
)
# Adds timing of trade to orders
orders$time.traded[orders$id == order.best$id] <- order$time.index
orders$time.traded[orders$id == order$id] <- order$time.index
# Deletes fully transacted orders from the book
if (order.best$volume.remaining == 0) {
t.ob <- t.ob[t.ob$id != order.best$id, ]
}
# Finsh handling this order, if it was fully transacted
if (order$volume.remaining == 0) {
break
}
} else {
# If order was not fully transacted, write it to the order book
if (order$volume.remaining > 0) {
t.ob[nrow(t.ob) + 1, ] <- order
}
# Then exit
break
}
}
}
}
}
cleanup(c("^t[.]","^order.best$","^order$","^fR$")) # Deletes temporary variables
# Plot --------------------------------------------------------------------
plot(x = orders$time.index, y = orders$price, lty = 1, lwd = 1, ylab = "price", xlab = "period", col = orders$direction + 3, main = par.main)
# lines(x=orders$time.index,y=orders$fv,type="l",lty=1,lwd=2,col="black")
lines(x = trades$time.index, y = trades$price, type = "l", lty = 1, lwd = 1, col = "red")
legend(x = "topleft", col = c(4, 2), legend = c("bids", "asks"), pch = 1)
# Plot<- ggplot(data=orders, aes(x=time.index)) +
#     geom_point(data = orders,
#                mapping = aes(x = time.index, y = price, shape = factor(direction),color=factor(direction)))+
#     geom_line(aes(y=fv),color="black",size=1.5)+
#     coord_cartesian(xlim = c(min(par.Periods),max(par.Periods)),ylim=c(0,200))
# Plot
