tests/testthat/test_Simulation.R
In strand-tech/strand: A Framework for Investment Strategy Simulation
context("Simulation")
library(arrow)
library(dplyr)
# Run the test simulation. Results will be used in several test blocks.
sim <- Simulation$new("data/test_Simulation.yaml")
sim$run()
test_that("simulation produces expected results", {
test_summary <- filter(sim$getSimSummary())
test_exposures <- filter(sim$getExposures())
# truth_summary <- test_summary
# truth_exposures <- test_exposures
# save(truth_summary, truth_exposures, file = "data/test_Simulation.RData")
load("data/test_Simulation.RData")
expect_equal(as.data.frame(test_summary),
as.data.frame(truth_summary))
expect_equal(as.data.frame(test_exposures),
as.data.frame(truth_exposures))
})
# For easier testing, load up the feather file data into objects.
test_input_data <- strand:::load_data_files("data/test_input/inputs")
test_pricing_data <- strand:::load_data_files("data/test_input/pricing")
test_secref_data <- read_feather("data/test_input/secref.feather")
test_that("simulation produces same result when data supplied as objects", {
# Same test but with data coming from objects instead of files.
sim_config <- yaml::yaml.load_file("data/test_Simulation.yaml")
sim_config$simulator$input_data$type <- "object"
sim_config$simulator$pricing_data$type <- "object"
sim_config$simulator$secref_data$type <- "object"
sim <- Simulation$new(sim_config,
raw_input_data = test_input_data,
raw_pricing_data = test_pricing_data,
security_reference_data = test_secref_data)
sim$run()
test_summary <- sim$getSimSummary()
load("data/test_Simulation.RData")
expect_equal(as.data.frame(test_summary),
as.data.frame(truth_summary))
})
# Normalization tests
test_that("in_vars and factor_vars are normalized properly", {
sim_config <- yaml::yaml.load_file("data/test_Simulation.yaml")
sim_config$simulator$input_data$type <- "object"
sim_config$simulator$pricing_data$type <- "object"
sim_config$simulator$secref_data$type <- "object"
# Set universe to stocks with rc_vol > 50000.
sim_config$simulator$universe <- "rc_vol > 50000"
sim_config$simulator$add_detail_columns <- c("alpha_1", "factor_1")
sim_config$simulator$normalize_in_vars <- "alpha_1"
sim_config$simulator$normalize_factor_vars <- "factor_1"
# Starting on day 2 (1/3), set the rc_vol value to 50000 for stocks with id < 150.
test_input_data <- test_input_data %>%
mutate(rc_vol = replace(rc_vol, as.numeric(id) < 150 & date >= as.Date("2019-01-03"), 50000))
sim <- Simulation$new(sim_config,
raw_input_data = test_input_data,
raw_pricing_data = test_pricing_data,
security_reference_data = test_secref_data)
sim$run()
det_data <- sim$getSimDetail(strategy_name = "joint") %>%
filter(id %in% 101) %>%
select(sim_date, id, investable, start_nmv, alpha_1, factor_1)
# > det_data
# # A tibble: 5 x 6
# sim_date id investable start_nmv alpha_1 factor_1
# <date> <chr> <lgl> <dbl> <dbl> <dbl>
# 1 2019-01-02 101 TRUE 0 1.59 -0.217
# 2 2019-01-03 101 FALSE 5020. 0 -0.230
# 3 2019-01-04 101 FALSE 2505. 0 -0.257
# 4 2019-01-07 101 FALSE 0 0 0
# 5 2019-01-08 101 FALSE 0 0 0
# By construction, stock 101 falls out of the universe after the 1st day
expect_equal(det_data$investable, c(TRUE, rep(FALSE, 4)))
# alpha_1 is normalized as an in_var, therefore its value goes to zero on day
# 2
expect_equal(!det_data$alpha_1 %in% 0, c(TRUE, rep(FALSE, 4)))
# factor_1 is normalized as a factor_var, so its values are preserved until
# the position in 101 has been exited.
expect_equal(!det_data$factor_1 %in% 0, c(TRUE, TRUE, TRUE, FALSE, FALSE))
})
# Simple simulation tests
# Setup: two securities, 101 and 102. One strategy, alpha_1. 3 days:
# 2019-01-02 to 2019-01-04. Target equity is 500.
#
# Max position size is 100% of portfolio. 101 has more positive alpha_1 on day
# 1. On days 2 and 3, 102 has more positive alpha_1.
test_ids <- c("101", "102")
simple_input_data <- filter(test_input_data, .data$id %in% !!test_ids)
simple_pricing_data <- filter(test_pricing_data, .data$id %in% !!test_ids)
simple_secref_data <- filter(test_secref_data, .data$id %in% !!test_ids)
# Set higher alpha values for 102.
simple_input_data$alpha_1[simple_input_data$id %in% "102" &
simple_input_data$date >= as.Date("2019-01-03")] <- 3
# To keep things simple set static prices at 5 for 101 and 10 for 102. So a
# full position for 101 is 100 shares and a full position for 102 is 50.
simple_pricing_data[c("price_unadj", "prior_close_unadj")][simple_pricing_data$id %in% "101",] <- 5
simple_pricing_data[c("price_unadj", "prior_close_unadj")][simple_pricing_data$id %in% "102",] <- 10
test_that("simple long-only simulation with two assets trades properly", {
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
sim$run()
id_101 <- sim$getSimDetail(strategy_name = "joint", security_id = "101")
id_102 <- sim$getSimDetail(strategy_name = "joint", security_id = "102")
# 101 trades into a full position for day 1, but then on day 2 we swap a full
# position in 102 for the full position in 101 (due to the alpha change).
expect_equal(id_101$end_shares, c(100, 0, 0))
expect_equal(id_102$end_shares, c(0, 50, 50))
})
test_that("alphas are carried forward when missing in simple long-only sim", {
# Remove data for day 2 (1/3) causing the trading out of 101 and into 102 to
# be performed on day 3 instead of day 2.
simple_input_data <- filter(simple_input_data, !(date %in% as.Date("2019-01-03") & id %in% "102"))
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
sim$run()
id_101 <- sim$getSimDetail(strategy_name = "joint", security_id = "101")
id_102 <- sim$getSimDetail(strategy_name = "joint", security_id = "102")
# 101 trades into a full position for day 1, but then on day 2 we swap a full
# position in 102 for the full position in 101 (due to the alpha change).
expect_equal(id_101$end_shares, c(100, 100, 0))
expect_equal(id_102$end_shares, c(0, 0, 50))
})
test_that("NAs are not allowed in input data", {
# Remove data for day 2 (1/3) causing the trading out of 101 and into 102 to
# be performed on day 3 instead of day 2.
simple_input_data$alpha_1[simple_input_data$date %in% as.Date("2019-01-03") & simple_input_data$id %in% "101"] <- NA
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
expect_error(sim$run(), regexp = "\\!any\\(is.na\\(input_data\\)\\) is not TRUE")
})
test_that("fill_rate_pct limits order filling", {
# Test one day of trading for a portfolio that should have one position long,
# one position short.
#
# There should be a full long position in 101 and full short position in 102,
# according to the sign of alpha_1 for 2019-01-02.
#
# Set volume for 101 such that only half of the order is filled (250 shares of
# volume * 20% fill rate = 50 shares filled out of 100).
#
# Set volume for 102 such that 80% of the order is filled (200 shares of
# volume * 20% fill rate = 40 shares filled out of 50).
simple_pricing_data$volume[simple_pricing_data$date %in% as.Date("2019-01-02") &
simple_pricing_data$id %in% "101"] <- 250
simple_pricing_data$volume[simple_pricing_data$date %in% as.Date("2019-01-02") &
simple_pricing_data$id %in% "102"] <- 200
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-02"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
sim$run()
id_101 <- sim$getSimDetail(strategy_name = "joint", security_id = "101")
id_102 <- sim$getSimDetail(strategy_name = "joint", security_id = "102")
expect_equal(id_101$end_shares, c(50))
expect_equal(id_102$end_shares, c(-40))
# Fill rate, percentange of filled GMV, is 250 + 400 / 1000 = 65%
summary_df <- sim$getSimSummary() %>% filter(strategy %in% "joint")
expect_equal(summary_df$fill_rate_pct, 65)
})
# Slightly more complicated setup with 6 securities.
#
# Default setup is that 101, 102, 105 have positive alpha, 103, 104, and 106 have
# negative alpha.
test_ids <- as.character(101:106)
simple_input_data_2 <- filter(test_input_data, .data$id %in% !!test_ids) %>%
mutate(alpha_1 = case_when(id %in% "101" ~ 3,
id %in% "102" ~ 2.5,
id %in% "105" ~ 2,
id %in% "106" ~ -2,
id %in% "103" ~ -2.5,
id %in% "104" ~ -3))
# Prices are 1 for 101, 2, for 102, ..., etc.
simple_pricing_data_2 <- filter(test_pricing_data, .data$id %in% !!test_ids) %>%
mutate(price_unadj = as.numeric(id) %% 100,
prior_close_unadj = price_unadj)
simple_secref_data_2 <- filter(test_secref_data, .data$id %in% !!test_ids)
test_that("force_trim_factor triggers trimming of large positions", {
# Price of stock 101 goes from 1 to 1.5 on 1/2:
simple_pricing_data_2 <-
simple_pricing_data_2 %>%
mutate(price_unadj = replace(price_unadj, id %in% 101 & date >= as.Date("2019-01-02"), 1.5),
prior_close_unadj = replace(prior_close_unadj, id %in% 101 & date >= as.Date("2019-01-03"), 1.5))
# Setup: long-short balanced. Max position 50%.
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-04"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim_config$strategies$strategy_1$position_limit_pct_lmv <- 50
sim_config$strategies$strategy_1$position_limit_pct_smv <- 50
sim_config$simulator$add_detail_columns <- "alpha_1"
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
# Investigate:
#
# sim$getSimDetail(strategy_name = "joint") %>%
# select(sim_date, id, strategy, shares, start_price, end_price, end_nmv, end_shares, max_pos_lmv, max_pos_smv, alpha_1)
# Without force_trim_factor set, position in 101 remains at
# gmv of 375 despite max position of 250.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date %in% as.Date("2019-01-03")) %>%
pull(end_gmv),
375)
# Now run with force_trim_factor set to 1.2.
sim_config$simulator$force_trim_factor <- 1.2
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
# With the force_trim_factor setting of 1.2, a trade is generated to trim
# the position in 101 to 120% * 250 = 300.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date %in% as.Date("2019-01-03")) %>%
pull(end_gmv),
300)
# On 2019-01-03, set alpha_1 of 101 from 3 to 2, and alpha_1 of 105 to from 2
# to 3. The optimization will want to close 101 and enter 105, so the
# force-trim order is not necessary.
simple_input_data_2 <- simple_input_data_2 %>%
mutate(
alpha_1 = replace(alpha_1, id %in% "101" & date >= as.Date("2019-01-03"), 2),
alpha_1 = replace(alpha_1, id %in% "105" & date >= as.Date("2019-01-03"), 3))
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date <= as.Date("2019-01-03")) %>%
pull(end_gmv),
c(375, 0)
)
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "105") %>%
filter(sim_date <= as.Date("2019-01-03")) %>%
pull(end_gmv),
c(0, 250)
)
# Restore the alpha_1 values of 101 and 105. Re-run but set average volume of
# 101 to 45 for 2019-01-03. With trading_limit_pct_adv set to 100, that means
# trimming will be limited to 45 on 2019-01-03. The remaining 30 is trimmed on
# 2019-01-04.
simple_input_data_2 <- simple_input_data_2 %>%
mutate(
alpha_1 = replace(alpha_1, id %in% "101" & date >= as.Date("2019-01-03"), 3),
alpha_1 = replace(alpha_1, id %in% "105" & date >= as.Date("2019-01-03"), 2),
rc_vol = replace(rc_vol, id %in% "101" & date %in% as.Date("2019-01-03"), 45))
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date %in% as.Date(c("2019-01-03", "2019-01-04"))) %>%
pull(end_gmv),
c(330, 300))
})
test_that("force_exit_non_investable triggers exiting positions in non-investable stocks", {
# Here we go back to a 100% max position size so that at the end of 1/2 we
# have a portfolio that has one position long and one position short. 104 has
# the most negative alpha score, so we will have a short position in it at the
# end of 1/2.
#
# We define the universe to be stocks with an rc_vol measure greater
# than 5000.
#
# We then set the rc_vol to 4,000 for stock 104 for 2019-01-03
# onwards; for all other stocks we set rc_vol to 10,000.
simple_pricing_data_2 <- simple_pricing_data_2 %>%
mutate(price_unadj = replace(price_unadj, id %in% 101 & date >= as.Date("2019-01-02"), 1.5),
prior_close_unadj = replace(prior_close_unadj, id %in% 101 & date >= as.Date("2019-01-03"), 1.5))
simple_input_data_2 <- simple_input_data_2 %>%
mutate(rc_vol = if_else(id %in% 104 & date >= as.Date("2019-01-03"), 4000, 10000))
# Setup: long-short balanced. Max position 50%.
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-07"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim_config$strategies$strategy_1$position_limit_pct_lmv <- 100
sim_config$strategies$strategy_1$position_limit_pct_smv <- 100
sim_config$strategies$strategy_1$trading_limit_pct_adv <- 10
sim_config$simulator$force_exit_non_investable <- TRUE
sim_config$simulator$universe <- "rc_vol >= 5000"
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
# Investigate:
#
# sim$getSimDetail(strategy_name = "joint") %>%
# select(sim_date, id, strategy, shares, start_price, end_price, end_nmv, end_shares, max_pos_lmv, max_pos_smv)
# On 2019-01-03, stock 104 falls outside of the universe due to its low
# rc_vol measure. Since force_exit_non_investable is set, trades to
# exit 104 are added on 2019-01-03 and 2019-01-04. 10% ADV = 400 can be traded
# each day for 104. So at the end of the day on 2019-01-03 the position in 104
# has nmv of -100. At the end of 2019-01-04 the position in 104 is flat, while
# the position in 103 has taken its place and is up to size of 400. By the end
# of 2019-01-07, the position in 104 has been fully replaced by the position
# in 103.
# Check that 104 is exited at rate of max 400 / day.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(end_gmv),
c(500, 100, 0, 0))
# Check the setting of the investable column for 104.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(investable),
c(TRUE, FALSE, FALSE, FALSE))
# Check that 104 is replaced by 103 (which has a price of 3). One day lag is
# because force exit is applied outside of the optimization.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "103") %>%
pull(end_gmv),
c(0, 0, 399, 501))
})
# Use the simple_*_2 datasets to test the handling of delistings.
#
# Construct simple_delisting_data_2 where stock 104 is delisted on day 2 of the
# simulation (2019-01-03) with a return of -0.5.
simple_delisting_data_2 <- data.frame(
id = "104",
delisting_date = as.Date("2019-01-03"),
delisting_return = -0.5,
stringsAsFactors = FALSE
)
test_that("delistings are handled properly", {
# Setup: long-short balanced. Max position 50%.
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-03"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim_config$strategies$strategy_1$position_limit_pct_lmv <- 100
sim_config$strategies$strategy_1$position_limit_pct_smv <- 100
sim_config$simulator$delisting_data <- list(type = "object")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2,
delisting_data = simple_delisting_data_2)
sim$run()
# Check that 104 is removed by the end of the day on the delisting date.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(end_nmv),
c(-500, 0)
)
# Check P&L series for 104.
# * On 1/2, net P&L is -0.5 (10 bps of cost for a trade gmv of 500).
# * On 1/3, net P&L is 250 (-50% delisting return applied to nmv of -500).
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(net_pnl),
c(-0.5, 250)
)
# Check delisting column for 104.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(delisting),
c(FALSE, TRUE)
)
# Check that position in 104 is replaced by position in 103 on 1/3, the
# delisting date, because the position to be removed does not appear in the
# optimization.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "103") %>%
pull(end_nmv),
c(0, -501))
})
# Tests of summary functions
test_that("overallStatsDf returns the correct values", {
test_overall_stats_df <- sim$overallStatsDf()
# truth_overall_stats_df <- test_overall_stats_df
# save(truth_overall_stats_df, file = "data/test_Simulation_overallStatsDf.RData")
load("data/test_Simulation_overallStatsDf.RData")
expect_equal(test_overall_stats_df, truth_overall_stats_df)
})
test_that("overallReturnsByMonthDf returns the correct values", {
# Would be nice to extend this test to include multiple years of results.
test_overall_returns_by_month_df <- sim$overallReturnsByMonthDf()
# truth_overall_returns_by_month_df <- test_overall_returns_by_month_df
# save(truth_overall_returns_by_month_df, file = "data/test_Simulation_overallReturnsByMonthDf.RData")
load("data/test_Simulation_overallReturnsByMonthDf.RData")
expect_equal(test_overall_returns_by_month_df, truth_overall_returns_by_month_df)
})
strand-tech/strand documentation built on Nov. 21, 2020, 5:37 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("Simulation")
library(arrow)
library(dplyr)
# Run the test simulation. Results will be used in several test blocks.
sim <- Simulation$new("data/test_Simulation.yaml")
sim$run()
test_that("simulation produces expected results", {
test_summary <- filter(sim$getSimSummary())
test_exposures <- filter(sim$getExposures())
# truth_summary <- test_summary
# truth_exposures <- test_exposures
# save(truth_summary, truth_exposures, file = "data/test_Simulation.RData")
load("data/test_Simulation.RData")
expect_equal(as.data.frame(test_summary),
as.data.frame(truth_summary))
expect_equal(as.data.frame(test_exposures),
as.data.frame(truth_exposures))
})
# For easier testing, load up the feather file data into objects.
test_input_data <- strand:::load_data_files("data/test_input/inputs")
test_pricing_data <- strand:::load_data_files("data/test_input/pricing")
test_secref_data <- read_feather("data/test_input/secref.feather")
test_that("simulation produces same result when data supplied as objects", {
# Same test but with data coming from objects instead of files.
sim_config <- yaml::yaml.load_file("data/test_Simulation.yaml")
sim_config$simulator$input_data$type <- "object"
sim_config$simulator$pricing_data$type <- "object"
sim_config$simulator$secref_data$type <- "object"
sim <- Simulation$new(sim_config,
raw_input_data = test_input_data,
raw_pricing_data = test_pricing_data,
security_reference_data = test_secref_data)
sim$run()
test_summary <- sim$getSimSummary()
load("data/test_Simulation.RData")
expect_equal(as.data.frame(test_summary),
as.data.frame(truth_summary))
})
# Normalization tests
test_that("in_vars and factor_vars are normalized properly", {
sim_config <- yaml::yaml.load_file("data/test_Simulation.yaml")
sim_config$simulator$input_data$type <- "object"
sim_config$simulator$pricing_data$type <- "object"
sim_config$simulator$secref_data$type <- "object"
# Set universe to stocks with rc_vol > 50000.
sim_config$simulator$universe <- "rc_vol > 50000"
sim_config$simulator$add_detail_columns <- c("alpha_1", "factor_1")
sim_config$simulator$normalize_in_vars <- "alpha_1"
sim_config$simulator$normalize_factor_vars <- "factor_1"
# Starting on day 2 (1/3), set the rc_vol value to 50000 for stocks with id < 150.
test_input_data <- test_input_data %>%
mutate(rc_vol = replace(rc_vol, as.numeric(id) < 150 & date >= as.Date("2019-01-03"), 50000))
sim <- Simulation$new(sim_config,
raw_input_data = test_input_data,
raw_pricing_data = test_pricing_data,
security_reference_data = test_secref_data)
sim$run()
det_data <- sim$getSimDetail(strategy_name = "joint") %>%
filter(id %in% 101) %>%
select(sim_date, id, investable, start_nmv, alpha_1, factor_1)
# > det_data
# # A tibble: 5 x 6
# sim_date id investable start_nmv alpha_1 factor_1
# <date> <chr> <lgl> <dbl> <dbl> <dbl>
# 1 2019-01-02 101 TRUE 0 1.59 -0.217
# 2 2019-01-03 101 FALSE 5020. 0 -0.230
# 3 2019-01-04 101 FALSE 2505. 0 -0.257
# 4 2019-01-07 101 FALSE 0 0 0
# 5 2019-01-08 101 FALSE 0 0 0
# By construction, stock 101 falls out of the universe after the 1st day
expect_equal(det_data$investable, c(TRUE, rep(FALSE, 4)))
# alpha_1 is normalized as an in_var, therefore its value goes to zero on day
# 2
expect_equal(!det_data$alpha_1 %in% 0, c(TRUE, rep(FALSE, 4)))
# factor_1 is normalized as a factor_var, so its values are preserved until
# the position in 101 has been exited.
expect_equal(!det_data$factor_1 %in% 0, c(TRUE, TRUE, TRUE, FALSE, FALSE))
})
# Simple simulation tests
# Setup: two securities, 101 and 102. One strategy, alpha_1. 3 days:
# 2019-01-02 to 2019-01-04. Target equity is 500.
#
# Max position size is 100% of portfolio. 101 has more positive alpha_1 on day
# 1. On days 2 and 3, 102 has more positive alpha_1.
test_ids <- c("101", "102")
simple_input_data <- filter(test_input_data, .data$id %in% !!test_ids)
simple_pricing_data <- filter(test_pricing_data, .data$id %in% !!test_ids)
simple_secref_data <- filter(test_secref_data, .data$id %in% !!test_ids)
# Set higher alpha values for 102.
simple_input_data$alpha_1[simple_input_data$id %in% "102" &
simple_input_data$date >= as.Date("2019-01-03")] <- 3
# To keep things simple set static prices at 5 for 101 and 10 for 102. So a
# full position for 101 is 100 shares and a full position for 102 is 50.
simple_pricing_data[c("price_unadj", "prior_close_unadj")][simple_pricing_data$id %in% "101",] <- 5
simple_pricing_data[c("price_unadj", "prior_close_unadj")][simple_pricing_data$id %in% "102",] <- 10
test_that("simple long-only simulation with two assets trades properly", {
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
sim$run()
id_101 <- sim$getSimDetail(strategy_name = "joint", security_id = "101")
id_102 <- sim$getSimDetail(strategy_name = "joint", security_id = "102")
# 101 trades into a full position for day 1, but then on day 2 we swap a full
# position in 102 for the full position in 101 (due to the alpha change).
expect_equal(id_101$end_shares, c(100, 0, 0))
expect_equal(id_102$end_shares, c(0, 50, 50))
})
test_that("alphas are carried forward when missing in simple long-only sim", {
# Remove data for day 2 (1/3) causing the trading out of 101 and into 102 to
# be performed on day 3 instead of day 2.
simple_input_data <- filter(simple_input_data, !(date %in% as.Date("2019-01-03") & id %in% "102"))
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
sim$run()
id_101 <- sim$getSimDetail(strategy_name = "joint", security_id = "101")
id_102 <- sim$getSimDetail(strategy_name = "joint", security_id = "102")
# 101 trades into a full position for day 1, but then on day 2 we swap a full
# position in 102 for the full position in 101 (due to the alpha change).
expect_equal(id_101$end_shares, c(100, 100, 0))
expect_equal(id_102$end_shares, c(0, 0, 50))
})
test_that("NAs are not allowed in input data", {
# Remove data for day 2 (1/3) causing the trading out of 101 and into 102 to
# be performed on day 3 instead of day 2.
simple_input_data$alpha_1[simple_input_data$date %in% as.Date("2019-01-03") & simple_input_data$id %in% "101"] <- NA
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
expect_error(sim$run(), regexp = "\\!any\\(is.na\\(input_data\\)\\) is not TRUE")
})
test_that("fill_rate_pct limits order filling", {
# Test one day of trading for a portfolio that should have one position long,
# one position short.
#
# There should be a full long position in 101 and full short position in 102,
# according to the sign of alpha_1 for 2019-01-02.
#
# Set volume for 101 such that only half of the order is filled (250 shares of
# volume * 20% fill rate = 50 shares filled out of 100).
#
# Set volume for 102 such that 80% of the order is filled (200 shares of
# volume * 20% fill rate = 40 shares filled out of 50).
simple_pricing_data$volume[simple_pricing_data$date %in% as.Date("2019-01-02") &
simple_pricing_data$id %in% "101"] <- 250
simple_pricing_data$volume[simple_pricing_data$date %in% as.Date("2019-01-02") &
simple_pricing_data$id %in% "102"] <- 200
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-02"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data,
raw_pricing_data = simple_pricing_data,
security_reference_data = simple_secref_data)
# sim$setVerbose(TRUE)
sim$run()
id_101 <- sim$getSimDetail(strategy_name = "joint", security_id = "101")
id_102 <- sim$getSimDetail(strategy_name = "joint", security_id = "102")
expect_equal(id_101$end_shares, c(50))
expect_equal(id_102$end_shares, c(-40))
# Fill rate, percentange of filled GMV, is 250 + 400 / 1000 = 65%
summary_df <- sim$getSimSummary() %>% filter(strategy %in% "joint")
expect_equal(summary_df$fill_rate_pct, 65)
})
# Slightly more complicated setup with 6 securities.
#
# Default setup is that 101, 102, 105 have positive alpha, 103, 104, and 106 have
# negative alpha.
test_ids <- as.character(101:106)
simple_input_data_2 <- filter(test_input_data, .data$id %in% !!test_ids) %>%
mutate(alpha_1 = case_when(id %in% "101" ~ 3,
id %in% "102" ~ 2.5,
id %in% "105" ~ 2,
id %in% "106" ~ -2,
id %in% "103" ~ -2.5,
id %in% "104" ~ -3))
# Prices are 1 for 101, 2, for 102, ..., etc.
simple_pricing_data_2 <- filter(test_pricing_data, .data$id %in% !!test_ids) %>%
mutate(price_unadj = as.numeric(id) %% 100,
prior_close_unadj = price_unadj)
simple_secref_data_2 <- filter(test_secref_data, .data$id %in% !!test_ids)
test_that("force_trim_factor triggers trimming of large positions", {
# Price of stock 101 goes from 1 to 1.5 on 1/2:
simple_pricing_data_2 <-
simple_pricing_data_2 %>%
mutate(price_unadj = replace(price_unadj, id %in% 101 & date >= as.Date("2019-01-02"), 1.5),
prior_close_unadj = replace(prior_close_unadj, id %in% 101 & date >= as.Date("2019-01-03"), 1.5))
# Setup: long-short balanced. Max position 50%.
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-04"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim_config$strategies$strategy_1$position_limit_pct_lmv <- 50
sim_config$strategies$strategy_1$position_limit_pct_smv <- 50
sim_config$simulator$add_detail_columns <- "alpha_1"
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
# Investigate:
#
# sim$getSimDetail(strategy_name = "joint") %>%
# select(sim_date, id, strategy, shares, start_price, end_price, end_nmv, end_shares, max_pos_lmv, max_pos_smv, alpha_1)
# Without force_trim_factor set, position in 101 remains at
# gmv of 375 despite max position of 250.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date %in% as.Date("2019-01-03")) %>%
pull(end_gmv),
375)
# Now run with force_trim_factor set to 1.2.
sim_config$simulator$force_trim_factor <- 1.2
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
# With the force_trim_factor setting of 1.2, a trade is generated to trim
# the position in 101 to 120% * 250 = 300.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date %in% as.Date("2019-01-03")) %>%
pull(end_gmv),
300)
# On 2019-01-03, set alpha_1 of 101 from 3 to 2, and alpha_1 of 105 to from 2
# to 3. The optimization will want to close 101 and enter 105, so the
# force-trim order is not necessary.
simple_input_data_2 <- simple_input_data_2 %>%
mutate(
alpha_1 = replace(alpha_1, id %in% "101" & date >= as.Date("2019-01-03"), 2),
alpha_1 = replace(alpha_1, id %in% "105" & date >= as.Date("2019-01-03"), 3))
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date <= as.Date("2019-01-03")) %>%
pull(end_gmv),
c(375, 0)
)
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "105") %>%
filter(sim_date <= as.Date("2019-01-03")) %>%
pull(end_gmv),
c(0, 250)
)
# Restore the alpha_1 values of 101 and 105. Re-run but set average volume of
# 101 to 45 for 2019-01-03. With trading_limit_pct_adv set to 100, that means
# trimming will be limited to 45 on 2019-01-03. The remaining 30 is trimmed on
# 2019-01-04.
simple_input_data_2 <- simple_input_data_2 %>%
mutate(
alpha_1 = replace(alpha_1, id %in% "101" & date >= as.Date("2019-01-03"), 3),
alpha_1 = replace(alpha_1, id %in% "105" & date >= as.Date("2019-01-03"), 2),
rc_vol = replace(rc_vol, id %in% "101" & date %in% as.Date("2019-01-03"), 45))
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "101") %>%
filter(sim_date %in% as.Date(c("2019-01-03", "2019-01-04"))) %>%
pull(end_gmv),
c(330, 300))
})
test_that("force_exit_non_investable triggers exiting positions in non-investable stocks", {
# Here we go back to a 100% max position size so that at the end of 1/2 we
# have a portfolio that has one position long and one position short. 104 has
# the most negative alpha score, so we will have a short position in it at the
# end of 1/2.
#
# We define the universe to be stocks with an rc_vol measure greater
# than 5000.
#
# We then set the rc_vol to 4,000 for stock 104 for 2019-01-03
# onwards; for all other stocks we set rc_vol to 10,000.
simple_pricing_data_2 <- simple_pricing_data_2 %>%
mutate(price_unadj = replace(price_unadj, id %in% 101 & date >= as.Date("2019-01-02"), 1.5),
prior_close_unadj = replace(prior_close_unadj, id %in% 101 & date >= as.Date("2019-01-03"), 1.5))
simple_input_data_2 <- simple_input_data_2 %>%
mutate(rc_vol = if_else(id %in% 104 & date >= as.Date("2019-01-03"), 4000, 10000))
# Setup: long-short balanced. Max position 50%.
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-07"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim_config$strategies$strategy_1$position_limit_pct_lmv <- 100
sim_config$strategies$strategy_1$position_limit_pct_smv <- 100
sim_config$strategies$strategy_1$trading_limit_pct_adv <- 10
sim_config$simulator$force_exit_non_investable <- TRUE
sim_config$simulator$universe <- "rc_vol >= 5000"
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2)
sim$run()
# Investigate:
#
# sim$getSimDetail(strategy_name = "joint") %>%
# select(sim_date, id, strategy, shares, start_price, end_price, end_nmv, end_shares, max_pos_lmv, max_pos_smv)
# On 2019-01-03, stock 104 falls outside of the universe due to its low
# rc_vol measure. Since force_exit_non_investable is set, trades to
# exit 104 are added on 2019-01-03 and 2019-01-04. 10% ADV = 400 can be traded
# each day for 104. So at the end of the day on 2019-01-03 the position in 104
# has nmv of -100. At the end of 2019-01-04 the position in 104 is flat, while
# the position in 103 has taken its place and is up to size of 400. By the end
# of 2019-01-07, the position in 104 has been fully replaced by the position
# in 103.
# Check that 104 is exited at rate of max 400 / day.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(end_gmv),
c(500, 100, 0, 0))
# Check the setting of the investable column for 104.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(investable),
c(TRUE, FALSE, FALSE, FALSE))
# Check that 104 is replaced by 103 (which has a price of 3). One day lag is
# because force exit is applied outside of the optimization.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "103") %>%
pull(end_gmv),
c(0, 0, 399, 501))
})
# Use the simple_*_2 datasets to test the handling of delistings.
#
# Construct simple_delisting_data_2 where stock 104 is delisted on day 2 of the
# simulation (2019-01-03) with a return of -0.5.
simple_delisting_data_2 <- data.frame(
id = "104",
delisting_date = as.Date("2019-01-03"),
delisting_return = -0.5,
stringsAsFactors = FALSE
)
test_that("delistings are handled properly", {
# Setup: long-short balanced. Max position 50%.
sim_config <- yaml::yaml.load_file("data/test_Simulation_simple.yaml")
sim_config$to <- "2019-01-03"
sim_config$strategies$strategy_1$ideal_short_weight <- 1
sim_config$strategies$strategy_1$position_limit_pct_lmv <- 100
sim_config$strategies$strategy_1$position_limit_pct_smv <- 100
sim_config$simulator$delisting_data <- list(type = "object")
sim <- Simulation$new(sim_config,
raw_input_data = simple_input_data_2,
raw_pricing_data = simple_pricing_data_2,
security_reference_data = simple_secref_data_2,
delisting_data = simple_delisting_data_2)
sim$run()
# Check that 104 is removed by the end of the day on the delisting date.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(end_nmv),
c(-500, 0)
)
# Check P&L series for 104.
# * On 1/2, net P&L is -0.5 (10 bps of cost for a trade gmv of 500).
# * On 1/3, net P&L is 250 (-50% delisting return applied to nmv of -500).
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(net_pnl),
c(-0.5, 250)
)
# Check delisting column for 104.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "104") %>%
pull(delisting),
c(FALSE, TRUE)
)
# Check that position in 104 is replaced by position in 103 on 1/3, the
# delisting date, because the position to be removed does not appear in the
# optimization.
expect_equal(
sim$getSimDetail(strategy_name = "joint", security_id = "103") %>%
pull(end_nmv),
c(0, -501))
})
# Tests of summary functions
test_that("overallStatsDf returns the correct values", {
test_overall_stats_df <- sim$overallStatsDf()
# truth_overall_stats_df <- test_overall_stats_df
# save(truth_overall_stats_df, file = "data/test_Simulation_overallStatsDf.RData")
load("data/test_Simulation_overallStatsDf.RData")
expect_equal(test_overall_stats_df, truth_overall_stats_df)
})
test_that("overallReturnsByMonthDf returns the correct values", {
# Would be nice to extend this test to include multiple years of results.
test_overall_returns_by_month_df <- sim$overallReturnsByMonthDf()
# truth_overall_returns_by_month_df <- test_overall_returns_by_month_df
# save(truth_overall_returns_by_month_df, file = "data/test_Simulation_overallReturnsByMonthDf.RData")
load("data/test_Simulation_overallReturnsByMonthDf.RData")
expect_equal(test_overall_returns_by_month_df, truth_overall_returns_by_month_df)
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.