Unbelievable and Amazing R Shiny–Web Parameter Test in 1.5 Hours
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Life keeps getting better and better. Yesterday, I discovered the absolutely unbelievable and amazing work RStudio has done with Shiny employing one of my favorite R packages websockets. As proof of the ease and quality, within a couple of minutes, I was able to get it up and running. This morning basically starting from scratch in less than 1.5 hours I was able to achieve a web-based interactive parameter test for a moving average system as my first example.
Below is a screencast of this very basic parameter testing web app. I can only hope that this simple application can illustrate just how powerful Shiny is. Just imagine pairing this with d3 or knitr.
R code for server.R and ui.R from GIST:
#almost entirely based on the 02_text and 03_mpg examples provided by RStudio Shiny | |
#all credit belongs to them | |
if (!require(PerformanceAnalytics)) { | |
stop("This app requires the PerformanceAnalytics package. To install it, run 'install.packages(\"PerformanceAnalytics\")'.\n") | |
} | |
if (!require(quantmod)) { | |
stop("This app requires the quantmod package. To install it, run 'install.packages(\"quantmod\")'.\n") | |
} | |
# Download data for a stock, if needed | |
require_symbol <- function(symbol) { | |
if (!exists(symbol)) | |
getSymbols(symbol, src="FRED") | |
#getSymbols(symbol, from = "1900-01-01") | |
} | |
library(shiny) | |
# Define server logic required to summarize and view the selected dataset | |
shinyServer(function(input, output) { | |
make_chart <- function(symbol="SP500") { | |
# get price data if does not exist | |
require_symbol(symbol) | |
#would hope not to recalculate each time but for now will leave messy | |
price.monthly <- to.monthly(get(symbol))[,4] | |
ret.monthly <- ROC(price.monthly, type="discrete", n=1) | |
#calculate system returns | |
systemRet <- merge( | |
ifelse(lag(price.monthly > runMean(price.monthly, n=input$nmonths), k=1), 1, 0) * ret.monthly, | |
ret.monthly) | |
colnames(systemRet) <- c(paste(input$nmonths,"MASys",sep=""), symbol) | |
charts.PerformanceSummary(systemRet, ylog=TRUE) | |
} | |
make_table <- function(symbol="SP500") { | |
# get price data if does not exist | |
require_symbol(symbol) | |
#would hope not to recalculate each time but for now will leave messy | |
price.monthly <- to.monthly(get(symbol))[,4] | |
ret.monthly <- ROC(price.monthly, type="discrete", n=1) | |
#calculate system returns | |
systemRet <- merge( | |
ifelse(lag(price.monthly > runMean(price.monthly, n=input$nmonths), k=1), 1, 0) * ret.monthly, | |
ret.monthly) | |
colnames(systemRet) <- c(paste(input$nmonths,"MASys",sep=""), symbol) | |
table.Stats(systemRet) | |
} | |
# Generate a plot of the system and buy/hold benchmark given nmonths parameter | |
# include outliers if requested | |
output$systemPlot <- reactivePlot(function() { | |
make_chart() | |
}) | |
# Generate a summary stats table of the dataset | |
output$view <- reactiveTable(function() { | |
make_table() | |
}) | |
}) |
#almost entirely based on the 02_text and 03_mpg examples provided by RStudio Shiny | |
#all credit belongs to them | |
library(shiny) | |
# Define UI for dataset viewer application | |
shinyUI(pageWithSidebar( | |
# Application title | |
headerPanel("Shiny Moving Average Parameter Test"), | |
# Sidebar with controls to select a dataset and specify the number | |
# of observations to view | |
sidebarPanel( | |
numericInput("nmonths", "Number of months for moving average:", 10) | |
), | |
# Show a summary of the dataset and an HTML table with the requested | |
# number of observations | |
mainPanel( | |
plotOutput("systemPlot"), | |
tableOutput("view") | |
) | |
)) |
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.