source("R/report.R")
source("R/chart.R")
source("R/dbInterface.R")
mMergeBacktest <- memoise(mergeBacktest, ~timeout(600))
timeFrameChoices <- c("1W", "1D", "1H", "30M", "15M", "10M", "5M")
ui <- shinyUI(navbarPage("TraderBot",
tabPanel("Wallet",
sidebarPanel(
headerPanel("Options"),
selectInput(inputId = "walletTimeFrame",
label = "Time frame",
choices = timeFrameChoices,
selected = "1D"),
dateRangeInput(inputId = "walletDateRange", label = "Date range",
start = (Sys.Date() - 730), end = NULL)
),
mainPanel(
uiOutput("wallet")
)
),
tabPanel("Operations",
sidebarPanel(
titlePanel("Insert operation"),
div(
id = "form",
selectizeInput('opSymbol', 'Symbols', choices = NULL, selected = NULL, multiple = FALSE),
dateInput("opDate", "Date"),
selectInput("opType", "Operation type", c("", "buy", "sell")),
textInput("opSize", "Size", value = "100"),
textInput("opPrice", "Price", ""),
textInput("opCost", "Cost", ""),
actionButton("opSubmit", "Submit", class = "btn-primary")
)),
mainPanel(
uiOutput("operations")
)
),
tabPanel("Charts",
sidebarPanel(
headerPanel("Options"),
selectizeInput(
'symbolNames', 'Symbols', choices = NULL, multiple = TRUE
),
selectInput(inputId = "chartsTimeFrame",
label = "Time frame",
choices = timeFrameChoices,
selected = "1D"),
dateRangeInput(inputId = "chartsDateRange", label = "Date range",
start = (Sys.Date() - 730), end = NULL)
),
mainPanel(
uiOutput("charts")
)
),
tabPanel("Alerts",
sidebarPanel(
headerPanel("Options"),
selectizeInput(
'symbolAlerts', 'Symbols', choices = NULL, multiple = TRUE
),
numericInput("numAlerts", "Alerts:", 5, min = 0, max = 30),
selectizeInput('typeAlerts', 'Type', choices = c("buy", "sell"), selected = c("buy", "sell"), multiple = TRUE),
selectizeInput("numIntervals", "Period:", choices = c(30, 90, 180, 360, 720, 3600), selected = 720)
),
mainPanel(
uiOutput("alerts")
)
),
tabPanel("Backtest",
sidebarPanel(
headerPanel("Filters"),
checkboxInput('open', 'Open', TRUE),
checkboxInput('closed', 'Closed', TRUE),
checkboxInput('long', 'Long', TRUE),
checkboxInput('short', 'Short', TRUE),
selectInput("group", "Group by:", choices = c("State"="state", "Type"="type", "Time Frame"="timeframe", "State and Time Frame"="state_timeframe", "None" = "none")),
selectizeInput("filterSymbol", "Symbols", choices = NULL, multiple = TRUE),
selectizeInput("timeFrames", "Time Frames", choices = timeFrameChoices, selected = timeFrameChoices, multiple = TRUE),
sliderInput("smaPeriod", "Sma Period:", min =100, max = 800, value = c(0,800), step = 5),
sliderInput("upperBand", "Upper Band:", min = 1, max = 2.5, value = c(1,2.5), step= 0.1),
sliderInput("lowerBand", "Lower Band:", min = -2.5, max =-1, value = c(-2.5,-1), step= 0.01),
sliderInput("stopGainLong", "Stop Gain Long:", min = 1, max = 2, value = c(1,2), step= 0.01),
sliderInput("stopGainShort", "Stop Gain Short:", min = 1, max = 1.5, value = c(1,1.5), step= 0.01),
sliderInput("stopLoss", "Stop Loss:", min = 0, max = 1, value = c(0,1), step= 0.01),
sliderInput("grade", "Grade:", min = -10, max = 10, value = c(-10,10), step= 0.01)
),
mainPanel(
tableOutput("values"),
plotOutput("parameters", height = "1200px"),
DT::dataTableOutput("dataTable"))
)
))
server <- shinyServer(function(input, output, session)
{
values <- reactiveValues(operations = getOperations(decreasing = TRUE))
make_chart <- function(symbol, intervals = 730, startDate = NULL, endDate = Sys.time(), timeFrame, mode = "operation")
{
if(timeFrame == "1D" || timeFrame == "1W")
symbol <- getSymbolsDaily(symbol, adjust = c("split", "dividend"))
else
symbol <- getSymbolsIntraday(symbol, timeFrame, adjust = c("split", "dividend"))
if(!is.null(symbol))
chartSymbols(symbol, period = intervals, startDate = startDate, endDate = endDate, timeFrame = timeFrame, mode = mode)
}
observeEvent(input$opSubmit, {
size <- as.integer(input$opSize)
price <- as.numeric(input$opPrice)
cost <- as.numeric(input$opCost)
if(is.character(input$opSymbol) && !is.na(size) && !is.na(price) && !is.na(cost) && nchar(input$opType) > 0)
insertOperations(input$opSymbol, as.Date(input$opDate), input$opType, as.integer(input$opSize), as.numeric(input$opPrice), as.numeric(input$opCost))
else
print("invalid input")
values$operations <- getOperations(decreasing = TRUE)
})
observe({
invalidateLater(300000, session)
updateSelectizeInput(session, "symbolAlerts",
label = "Symbols",
choices = getSymbolNames(),
selected = input$symbolAlerts
)
single = c("symbol")
alerts.table <- getAlertsResults(getAlerts(input$numAlerts, input$symbolAlerts, input$typeAlerts, single))
alerts.table <- data.table(alerts.table, key=c("symbol", "timeframe"))
if(nrow(alerts.table) > 0)
{
alerts <- data.table(alerts.table[!duplicated(alerts.table[, single, with=FALSE])], key=c("symbol", "timeframe"))[order(-datetime)]
for(i in 1:nrow(alerts))
{
local({
my_i <- i
drops <- c("symbol", "timeframe")
alerts.table[, !drops, with=FALSE]
output[[paste0("alertsResults", my_i)]] <- DT::renderDataTable({alerts.table[alerts[my_i, c("symbol", "timeframe")], !drops, with=FALSE]}, options = list(lengthMenu = c(5, 10, 20), pageLength = 5))
output[[paste0("alerts", my_i)]] <- renderPlot({ make_chart(unique(alerts[my_i]$symbol), intervals = as.integer(input$numIntervals), timeFrame = unique(alerts[my_i]$timeframe), mode = "none") })
})
}
}
})
observe({
invalidateLater(300000, session)
wallet <- getWallet()
numWallet <- length(wallet)
balance <- getBalance()
balance$open <- as.character.Date(balance$open)
if(numWallet > 0)
{
for(i in 1:numWallet)
{
local({
my_i <- i
startDate <- input$walletDateRange[1]
endDate <- input$walletDateRange[2]
output[[paste0("balance", my_i)]] <- renderTable({balance[balance$symbol == wallet[my_i], ]})
output[[paste0("wallet", my_i)]] <- renderPlot({ make_chart(wallet[[my_i]], startDate = startDate, endDate = endDate, timeFrame = input$walletTimeFrame) })
})
}
}
})
observe({
updateSelectizeInput(session, "filterSymbol",
label = "Symbols",
choices = as.vector(unique(mMergeBacktest()$symbol)),
selected = input$filterSymbol
)
})
observe({
updateSelectizeInput(session, "opSymbol",
label = "Symbols",
choices = getSymbolNames(),
selected = NULL,
options = list(
placeholder = 'Please select an option below',
onInitialize = I('function() { this.setValue(""); }')
)
)
})
observe({
invalidateLater(300000, session)
updateSelectizeInput(session, "symbolNames",
label = "Symbols",
choices = getSymbolNames(),
selected = input$symbolNames
)
numCharts <- length(input$symbolNames)
if(numCharts > 0)
{
for(i in 1:numCharts)
{
local({
my_i <- i
my_symbol <- input$symbolNames[[my_i]]
startDate <- input$chartsDateRange[1]
endDate <- input$chartsDateRange[2]
plotname <- paste("charts", my_i, sep="")
output[[plotname]] <- renderPlot({ make_chart(my_symbol, startDate = startDate, endDate = endDate, timeFrame = input$chartsTimeFrame) })
})
}
}
})
output$alerts <- renderUI({
outputList <- lapply(1:input$numAlerts, function(i) {
list(
DT::dataTableOutput(paste0("alertsResults", i)),
plotOutput(paste0("alerts", i))
)
})
do.call(tagList, outputList)
})
output$charts <- renderUI({
if(length(input$symbolNames) > 0)
{
outputList <- lapply(1:length(input$symbolNames), function(i) {
list(
plotOutput(paste("charts", i, sep=""))
)
})
do.call(tagList, outputList)
}
})
output$wallet <- renderUI({
wallet <- getWallet()
if(length(wallet) > 0)
{
outputList <- lapply(1:length(wallet), function(i) {
tagList(tags$hr(), tableOutput(paste0("balance", i)), plotOutput(paste0("wallet", i)))
})
do.call(tagList, outputList)
}
})
output$operations <- renderTable({
values$operations
})
tableValues <- reactive({
dataTable <- mMergeBacktest(path = "result/")
if(is.null(dataTable) || nrow(dataTable) == 0)
return(NULL)
if(xor(input$open, input$closed))
{
if(input$open)
dataTable <- dataTable[dataTable$state == "open"]
if(input$closed)
dataTable <- dataTable[dataTable$state == "closed"]
}
if(xor(input$long, input$short))
{
if(input$long)
dataTable <- dataTable[dataTable$type == "long"]
if(input$short)
dataTable <- dataTable[dataTable$type == "short"]
}
if(!is.null(input$timeFrames) && !is.na(input$timeFrames))
dataTable <- dataTable[(dataTable$timeframe %in% input$timeFrames)]
dataTable <- dataTable[(dataTable$smaPeriod >= input$smaPeriod[1] & dataTable$smaPeriod <= input$smaPeriod[2]) | is.na(dataTable$smaPeriod)]
dataTable <- dataTable[(dataTable$upperBand >= input$upperBand[1] & dataTable$upperBand <= input$upperBand[2]) | is.na(dataTable$upperBand)]
dataTable <- dataTable[(dataTable$lowerBand >= input$lowerBand[1] & dataTable$lowerBand <= input$lowerBand[2]) | is.na(dataTable$lowerBand)]
dataTable <- dataTable[(dataTable$stopGainLong >= input$stopGainLong[1] & dataTable$stopGainLong <= input$stopGainLong[2]) | is.na(dataTable$stopGainLong)]
dataTable <- dataTable[(dataTable$stopGainShort >= input$stopGainShort[1] & dataTable$stopGainShort <= input$stopGainShort[2]) | is.na(dataTable$stopGainShort)]
dataTable <- dataTable[(dataTable$stopLoss >= input$stopLoss[1] & dataTable$stopLoss <= input$stopLoss[2]) | is.na(dataTable$stopLoss)]
dataTable <- dataTable[(dataTable$profit_pp >= input$grade[1] & dataTable$profit_pp <= input$grade[2]) | is.na(dataTable$profit_pp)]
if(!is.null(input$filterSymbol) && !is.null(intersect(input$filterSymbol, unique(dataTable$symbol))))
dataTable <- dataTable[dataTable$symbol %in% input$filterSymbol]
dataTable
})
output$values <- renderTable({
nrow(tableValues())
})
output$parameters <- renderPlot({
tv <- tableValues()
if(!is.null(tv) && nrow(tv) > 0)
{
grid.arrange(
showPlot(tv, c("smaPeriod", "grade"), input$group),
showPlot(tv, c("lowerBand", "grade"), input$group),
showPlot(tv, c("upperBand", "grade"), input$group),
showPlot(tv, c("stopGainLong", "grade"), input$group),
showPlot(tv, c("stopGainShort", "grade"), input$group),
showPlot(tv, c("stopLoss", "grade"), input$group),
ncol = 2
)
}
})
output$dataTable <- DT::renderDataTable({
tv <- tableValues()
if(!is.null(tv) && nrow(tv) > 0)
showReport(tv)
},
options = list(paging = FALSE))
})
#' @export
runShinyApp <- function(options = list(host="127.0.0.1", port=8000))
{
shinyApp(ui = ui, server = server, options = options)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.