Skip to content
Browse files

ok

Signed-off-by: systematicinvestor <thesystematicinvestor@gmail.com>
  • Loading branch information...
1 parent bacc9fc commit 5ed05afe4a72b87cb9cd0dbe5334f938341e8e32 @systematicinvestor committed Feb 15, 2013
Showing with 285 additions and 0 deletions.
  1. +23 −0 Shiny/market.filter/global.R
  2. +193 −0 Shiny/market.filter/server.R
  3. +69 −0 Shiny/market.filter/ui.R
View
23 Shiny/market.filter/global.R
@@ -0,0 +1,23 @@
+library(shiny)
+library(xtable)
+
+
+###############################################################################
+# Load Systematic Investor Toolbox (SIT)
+# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
+###############################################################################
+if(!file.exists('../sit'))
+ shiny:::download('https://github.com/systematicinvestor/SIT/raw/master/sit.lite.gz', '../sit', mode = 'wb', quiet = TRUE)
+con = gzcon(file('../sit', 'rb'))
+ source(con)
+close(con)
+
+
+
+
+
+
+load.packages('quantmod')
+if (!require(quantmod)) {
+ stop("This app requires the quantmod package. To install it, run 'install.packages(\"quantmod\")'.\n")
+}
View
193 Shiny/market.filter/server.R
@@ -0,0 +1,193 @@
+
+# Define server
+shinyServer(function(input, output) {
+
+ # Create an environment for storing data
+ symbol_env <- new.env()
+
+ #*****************************************************************
+ # Shared Reactive functions
+ # http://rstudio.github.com/shiny/tutorial/#inputs-and-outputs
+ #******************************************************************
+ # Get stock data
+ getData <- reactive(function() {
+ cat('getData was called\n')
+
+ data <- new.env()
+ for(symbol in c(getStock(),getCash()) ) {
+ if (is.null(symbol_env[[symbol]]))
+ tryCatch({
+ symbol_env[[symbol]] = getSymbols(symbol, from='1970-01-01', src='yahoo', auto.assign = FALSE)
+ }, error = function(e) { stop(paste('Problem getting prices for',symbol)) })
+ data[[symbol]] = symbol_env[[symbol]]
+ }
+
+ bt.prep(data, align='remove.na')
+ data
+ })
+
+ # Helper fns
+ getStock <- reactive(function() { toupper(input$symbol) })
+ getCash <- reactive(function() { toupper(input$cash) })
+
+ getBackTest <- reactive(function() {
+ #*****************************************************************
+ # Load historical data
+ #******************************************************************
+ data = getData()
+
+ tryCatch({
+ #*****************************************************************
+ # Code Strategies
+ #******************************************************************
+ prices = data$prices
+ nperiods = nrow(prices)
+
+ # find period ends
+ period.ends = endpoints(prices, 'months')
+ period.ends = period.ends[period.ends > 0]
+
+ models = list()
+
+ stock = getStock()
+ cash = getCash()
+
+ #*****************************************************************
+ # Buy & Hold
+ #******************************************************************
+ data$weight[] = NA
+ data$weight[,stock] = 1
+ models$buy.hold = bt.run.share(data, clean.signal=T)
+
+ #*****************************************************************
+ # MA cross-over strategy
+ #******************************************************************
+ sma = SMA(prices[, stock], as.double(input$smaLen))
+ signal = (prices[, stock] > sma)[period.ends]
+
+ data$weight[] = NA
+ data$weight[period.ends, stock ] = iif(signal, 1, 0)
+ data$weight[period.ends, cash] = iif(signal, 0, 1)
+ models$market.filter = bt.run.share(data, clean.signal=T, trade.summary = T)
+
+ temp = rep(NA, nperiods)
+ temp[period.ends] = signal
+ models$market.filter$highlight = ifna.prev(temp)
+
+ rev(models)
+ }, error = function(e) { stop(paste('Problem running Back Test:', e)) })
+ })
+
+
+ # Make table
+ makeSidebysideTable <- reactive(function() {
+ models = getBackTest()
+ plotbt.strategy.sidebyside(models, return.table=T, make.plot=F)
+ })
+
+ # Make table
+ makeAnnualTable <- reactive(function() {
+ models = getBackTest()
+ plotbt.monthly.table(models[[1]]$equity, make.plot = F)
+ })
+
+ # Make table
+ makeTradesTable <- reactive(function() {
+ models = getBackTest()
+ model = models[[1]]
+
+ if (!is.null(model$trade.summary)) {
+ ntrades = min(20, nrow(model$trade.summary$trades))
+ last(model$trade.summary$trades, ntrades)
+ }
+ })
+
+ #*****************************************************************
+ # Not Reactive helper functions
+ #*****************************************************************
+
+
+ #*****************************************************************
+ # Update plot(s) and table(s)
+ #******************************************************************
+ # Generate a plot
+ output$strategyPlot <- reactivePlot(function() {
+ models = getBackTest()
+
+ plota.control$col.x.highlight = col.add.alpha('green',50)
+ plotbt.custom.report.part1(models, x.highlight = models$market.filter$highlight)
+ }, height = 400, width = 600)
+
+ # Generate a table
+ output$sidebysideTable <- reactive(function() {
+ temp = makeSidebysideTable()
+ tableColor(as.matrix(temp))
+ })
+
+ # Generate a table
+ output$annualTable <- reactive(function() {
+ temp = makeAnnualTable()
+ tableColor(as.matrix(temp))
+ })
+
+ # Generate a plot
+ output$transitionPlot <- reactivePlot(function() {
+ models = getBackTest()
+ plotbt.transition.map(models[[1]]$weight)
+ }, height = 400, width = 600)
+
+ # Generate a table
+ output$tradesTable <- reactive(function() {
+ temp = makeTradesTable()
+ tableColor(as.matrix(temp))
+ })
+
+
+
+ #*****************************************************************
+ # Download
+ #******************************************************************
+ # Download pdf report
+ output$downloadReport <- downloadHandler(
+ filename = 'report.pdf',
+ content = function(file) {
+ pdf(file = file, width=8.5, height=11)
+
+ models = getBackTest()
+
+ plota.control$col.x.highlight = col.add.alpha('green',50)
+ plotbt.custom.report(models, trade.summary = T, x.highlight = models$market.filter$highlight)
+ plota.add.copyright()
+
+ dev.off()
+ }
+ )
+
+ # Download csv data
+ output$downloadData <- downloadHandler(
+ filename = 'data.csv',
+ content = function(file) {
+ cat('Summary Performance:\n', file=file, append=F)
+ write.table(makeSidebysideTable(), sep=',', col.names=NA, quote=F, file=file, append=T)
+
+ cat('\n\nAnnual Perfromance:\n', file=file, append=T)
+ write.table(makeAnnualTable(), sep=',', col.names=NA, quote=F, file=file, append=T)
+
+ cat('\n\nLast 20 Trades:\n', file=file, append=T)
+ write.table(makeTradesTable(), sep=',', col.names=NA, quote=F, file=file, append=T)
+ }
+ )
+
+ #*****************************************************************
+ # Update status message
+ #******************************************************************
+ output$status <- reactiveUI(function() {
+ out = tryCatch( getData(), error=function( err ) paste(err))
+ if( is.character( out ) )
+ HTML(paste("<b>Status</b>: <b><font color='red'>Error:</font></b>",out))
+ else
+ HTML("<b>Status</b>: <b><font color='green'>Ok</font></b>")
+ })
+
+
+})
View
69 Shiny/market.filter/ui.R
@@ -0,0 +1,69 @@
+
+# Define UI for application that plots random distributions
+shinyUI(pageWithSidebar(
+
+ headerPanel(""),
+
+ # Sidebar with a slider input for number of observations
+ sidebarPanel(
+ textInput("symbol", "Stock - Yahoo Ticker:", value = "SPY"),
+ textInput("cash", "Cash - Yahoo Ticker:", value = "TLT"),
+ br(),
+ selectInput("smaLen", strong("Moving Average:"), choices = seq(20,200,by=10),selected=100),
+ br(),
+ submitButton("Run"),
+ htmlOutput("status")
+ ),
+
+
+ # Show a plot of the generated distribution
+ mainPanel(
+ tabsetPanel(
+ tabPanel("Main",
+ plotOutput("strategyPlot", height="100%"),
+ br(),
+ tableOutput("sidebysideTable"),
+ h4("Annual Perfromance"),
+ tableOutput("annualTable"),
+ h4("Transition Map"),
+ plotOutput("transitionPlot", height="100%"),
+ h4("Last 20 Trades"),
+ tableOutput("tradesTable"),
+ downloadButton("downloadReport", "Download Report"),
+ downloadButton("downloadData", "Download Data"),
+ br(),
+ br()
+ ),
+
+ tabPanel("About",
+ p('This application demonstrates how to back-test a Market Filter strategy using ',
+ a("Shiny", href="http://www.rstudio.com/shiny/", target="_blank"), 'framework and',
+ a("Systematic Investor Toolbox", href="http://systematicinvestor.wordpress.com/systematic-investor-toolbox/", target="_blank"),
+ '.
+ The Market Filter strategy invests in stock while the stock price is above the
+ moving average and goes in cash otherwise. The periods where Market Filter strategy is
+ invested are highlighted with green.'
+ ),
+
+ br(),
+
+ strong('Author'), p('Michael Kapler', a('Systematic Investor Blog', href="http://systematicinvestor.wordpress.com", target="_blank")),
+
+ br(),
+
+ strong('Code'), p('Original source code for this application at',
+ a('GitHub', href='https://github.com/systematicinvestor/SIT/Shiny/market.filter')),
+
+ br(),
+
+ strong('References'),
+ p(HTML('<ul>'),
+ HTML('<li>'),'The web application is built with the amazing', a("Shiny.", href="http://www.rstudio.com/shiny/", target="_blank"),HTML('</li>'),
+ HTML('<li>'),a('SIR application by Samuel M. Jenness', href="http://glimmer.rstudio.com/smjenness/SIR/", target="_blank"),HTML('</li>'),
+ HTML('<li>'),a('SIR application code by Samuel M. Jenness', href="https://github.com/smjenness/Shiny/tree/master/SIR", target="_blank"),HTML('</li>'),
+ HTML('</ul>'))
+ )
+ )
+ )
+))
+

0 comments on commit 5ed05af

Please sign in to comment.
Something went wrong with that request. Please try again.