Let’s start building our Sortino ratio Shiny app! You can view the final version in a new window or check it out below:

The full source code can be accessed via the aptly labeled "source code" button at the top right of the app. Close readers will see that it was built in a R Markdown file (with output: flexdashboard::flexdashboard and runtime: shiny added to the YAML header).

---
title: "Sortino Ratio Shiny"
runtime: shiny
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    source_code: embed
---

This app could have been built using the classical app.r file format, but I prefer to use a flexdashboard because it keeps the entire workflow in the R Markdown world. In my previous posts, I used R Markdown and code chunks to enforce logic on my data import, calculations, and visualizations. This Shiny app follows the same code chunk structure, and I find that the logic and functions translate well.

I will review the substantive code in detail, but we won’t cover formatting features like how to create a new row or how to tab-set a row. If you'd like that information, the source code includes all of the formatting code.

On to the substance: Our first task is to build an input sidebar and enable users to choose five stocks and weights. We will use textInput("stock1",...)) to create a space where the user can type a stock symbol and the numericInput("w1",...) to create a space where the user can enter a numeric weight. Since we have five stocks and weights, we repeat this five times. Notice that the stock symbol field uses textInput() because the user needs to enter text and the weight field uses numericInput() because the user needs to enter a number.

library(tidyverse)
library(highcharter)
library(tidyquant)
library(timetk)

fluidRow(
  column(7,
  textInput("stock1", "Stock 1", "SPY")),
  column(5,
  numericInput("w1", "Portf. %", 25, min = 1, max = 100))
)  

fluidRow(
  column(7,
  textInput("stock2", "Stock 2", "EFA")),
  column(5,
  numericInput("w2", "Portf. %", 25, min = 1, max = 100))
)

fluidRow(
  column(7,
  textInput("stock3", "Stock 3", "IJS")),
  column(5,
  numericInput("w3", "Portf. %", 20, min = 1, max = 100))
)

fluidRow(
  column(7,
  textInput("stock4", "Stock 4", "EEM")),
  column(5,
  numericInput("w4", "Portf. %", 20, min = 1, max = 100))
)

fluidRow(
  column(7,
  textInput("stock5", "Stock 5", "AGG")),
  column(5,
  numericInput("w5", "Portf. %", 10, min = 1, max = 100))
)

Next, we give the end user the ability to choose a start date with dateInput("date",...).

fluidRow(
  column(7,
  dateInput("date", "Starting Date", "2010-01-01", format = "yyyy-mm-dd"))
)

And for the final inputs, let’s have a row where the user can choose a Minimum Acceptable Rate (MAR) and the length of the rolling window. These are both numbers, so I used numericInput("mar",...) and numericInput("window",...).

fluidRow(
  column(5,
  numericInput("mar", "MAR%", .8, min = 0, max = 3, step = .01)),
  column(5,
  numericInput("window", "Window", 6, min = 2, max = 24, step = 2))
)

Finally, let's include a submit button for our end user. This button is what takes all those inputs and passes them on to your reactive functions so the Shiny engine can start doing its work. The app won’t fire until the user clicks submit.

actionButton("go", "Submit")

This is a hugely important button because it enables the use of eventReactives() to control your computation. Let’s have a look at that first eventReaactive() wherein we take the user-chosen stocks and grab their daily prices.

prices <- eventReactive(input$go, {
  
  symbols <- c(input$stock1, input$stock2, input$stock3, input$stock4, input$stock5)
  
  getSymbols(symbols, src = 'yahoo', from = input$date, 
             auto.assign = TRUE, warnings = FALSE) %>% 
  map(~Ad(get(.))) %>% 
  reduce(merge) %>%
  `colnames<-`(symbols)
})

The first line is tied back to our submit() button. The function starts with prices <- eventReactive(input$go, {... which means the function won’t start firing until the submit button is clicked. The clicking of submit is the event that starts the reactivity. That’s important because you don’t want the reactive function to start firing whenever a user changes any of the inputs in your sidebar. If this were a normal reactive, it would read prices <- reactive({... and it would start firing anytime one of our inputs changed. That would frustrate the end user!

The substance of that function should look very familiar if you read the previous posts; it's similar to when I imported prices from Yahoo! finance. The only difference is that the ticker symbols are not hard coded; they are dependent on input$stock1 through to input$stock5 because the user is inputting the symbols.

Next, I will use a similar eventReactive() flow to assign the user-selected MAR.

mar <- eventReactive(input$go, {input$mar})

You now have your daily prices and your MAR. Let’s follow the workflow of our previous work on calculating Sortino to find the rolling Sortino ratio and save it as an xts.

rolling_sortino <- eventReactive(input$go, {
  
validate(need(input$w1 + input$w2 + input$w3 + input$w4 + input$w5 == 100, 
                "The portfolio weights must sum to 100%!"))
  
prices <- prices()
w <- c(input$w1/100, input$w2/100, input$w3/100, input$w4/100, input$w5/100)
MAR <- mar()
window <- input$window

prices_monthly <- to.monthly(prices, indexAt = "last", OHLC = FALSE)
asset_returns_xts <- na.omit(Return.calculate(prices_monthly, method = "log"))

portfolio_returns_xts_rebalanced_monthly <- Return.portfolio(asset_returns_xts, weights = w, rebalance_on = "months")

rolling_sortino <-
  rollapply(portfolio_returns_xts_rebalanced_monthly, window, 
            function(x) SortinoRatio(x, MAR = MAR)) %>% 
  `colnames<-`(paste(window, "-month rolling Sortino", sep=""))
})

Note the one crucial line in the above function:

validate(need(input$w1 + input$w2 + input$w3 + input$w4 + input$w5 == 100, "The portfolio weights must sum to 100%!"))

This is where you ensure that the weights sum to 100. Toggle over to the live app and see what happens when the weights don’t sum to 100. 

Finally, I will calculate portfolio returns in tidy format so I can use ggplot() for more visualizations. Again, you will take the user inputs and perform your calculations in an eventReactive(). Notice that we are using the same name — portfolio_returns_tq_rebalanced_monthly — for our returns object as we used in our previous work. That’s not necessary, of course, but it keeps things consistent.

portfolio_returns_tq_rebalanced_monthly <- eventReactive(input$go, {
  
validate(need(input$w1 + input$w2 + input$w3 + input$w4 + input$w5 == 100, 
                "The portfolio weights must sum to 100%!"))
  
prices <- prices()
w <- c(input$w1/100, input$w2/100, input$w3/100, input$w4/100, input$w5/100)
  
asset_returns_long <- 
      prices %>% 
      to.monthly(indexAt = "last", OHLC = FALSE) %>% 
      tk_tbl(preserve_index = TRUE, rename_index = "date") %>%
      gather(asset, returns, -date) %>% 
      group_by(asset) %>%  
      mutate(returns = (log(returns) - log(lag(returns))))
  
MAR <- mar()

portfolio_returns_tq_rebalanced_monthly <- 
  asset_returns_long %>% 
  tq_portfolio(assets_col = asset, 
               returns_col = returns, 
               weights = w,
               col_rename = "returns",
               rebalance_on = "months") %>% 
  mutate(returns_below_MAR = ifelse(returns < MAR, returns, NA)) %>%
  mutate(returns_above_MAR = ifelse(returns > MAR, returns, NA))

})

Your substantive work has been completed. Now, you want to display the chart of the rolling Sortino ratio. Outside of Shiny, this would be a simple passing of the xts object to highcharter.

Shiny uses a custom function for building reactive highcharter charts called renderHighchart(). Once you invoke that renderHighchart(), your code will look very similar to your previous visualization work. Use the following code to add your rolling Sorino xts:

hc_add_series(rolling_sortino(), name = "Sortino", color = "cornflowerblue")

 

renderHighchart({
  highchart(type = "stock") %>%
  hc_title(text = names(rolling_sortino())) %>%
  hc_add_series(rolling_sortino(), name = names(rolling_sortino()), color = "cornflowerblue") %>%
  hc_navigator(enabled = FALSE) %>% 
  hc_scrollbar(enabled = FALSE) 
})

Next, let's use ggplot() to create a scatter plot, a histogram, and a density chart of monthly returns. These will be nested in different tabs so the user can toggle between them and choose which is most helpful.

The flow for these is going to be the same: call the reactive function renderPlot(), pass in mar() and portfolio_returns_tq_rebalanced_monthly(), call ggplot() with the right aes() argument, and then choose the appropriate geom. We will add plenty of aesthetics to make things more engaging later, but for now, I'm taking this directly from our previous visualization work.

Note that the renderPlot() function is playing the same role as renderHighchart() above: It is alerting the Shiny app that a reactive plot is forthcoming after user inputs, instead of a static plot that is unchanging.

Find the code used to render the scatter plot below:

renderPlot({
  
  validate(need(input$go != 0, 
          "Please choose your portfolio assets, weights, MAR, rolling window and start date and click submit."))
  
  MAR <- mar()
  portfolio_returns_tq_rebalanced_monthly <- portfolio_returns_tq_rebalanced_monthly()
  
  portfolio_returns_tq_rebalanced_monthly %>% 
  ggplot(aes(x = date)) +
  geom_point(aes(y = returns_below_MAR), colour = "red") +
  geom_point(aes(y = returns_above_MAR), colour = "green") + 
  geom_vline(xintercept = as.numeric(as.Date("2016-11-30")), color = "blue") +
  geom_hline(yintercept = MAR, color = "purple", linetype = "dotted") +
  annotate(geom="text", x=as.Date("2016-11-30"), 
           y = -.05, label = "Trump", fontface = "plain", 
           angle = 90, alpha = .5, vjust =  1.5) +
  ylab("percent monthly returns")
})

App after click with scatterplot.png

Here is the code to create the histogram:

renderPlot({
  validate(need(input$go != 0, "Please choose your portfolio assets, weights, MAR, rolling window and start date and click submit."))
  MAR <- mar()
  portfolio_returns_tq_rebalanced_monthly <- portfolio_returns_tq_rebalanced_monthly()
  
  portfolio_returns_tq_rebalanced_monthly %>% 
    ggplot(aes(x = returns)) +
    geom_histogram(alpha = 0.25, binwidth = .01, fill = "cornflowerblue") +
    geom_vline(xintercept = MAR, color = "green") +
    annotate(geom = "text", x = MAR, 
             y = 10, label = "MAR", fontface = "plain", 
             angle = 90, alpha = .5, vjust =  1)
})

App after click with histogram.png

And finally, the code for the density chart:

renderPlot({
  validate(need(input$go != 0, "Please choose your portfolio assets, weights, MAR, rolling window and start date and click submit."))
  MAR <- mar()
  portfolio_returns_tq_rebalanced_monthly <- portfolio_returns_tq_rebalanced_monthly()
  
  sortino_density_plot <- portfolio_returns_tq_rebalanced_monthly %>% 
    ggplot(aes(x = returns)) +
    stat_density(geom = "line", size = 1, color = "cornflowerblue") 
  
  shaded_area_data <- ggplot_build(sortino_density_plot)$data[[1]] %>% 
    filter(x < MAR)

  sortino_density_plot + 
  geom_area(data = shaded_area_data, aes(x = x, y = y), fill="pink", alpha = 0.5) +
  geom_segment(data = shaded_area_data, aes(x = MAR, y = 0, xend = MAR, yend = y), 
               color = "red", linetype = "dotted") +
  annotate(geom = "text", x = MAR, y = 5, label = paste("MAR =", MAR, sep = ""), 
           fontface = "plain", angle = 90, alpha = .8, vjust =  -1) +
  annotate(geom = "text", x = (MAR - .02), y = .1, label = "Downside", 
           fontface = "plain", alpha = .8, vjust =  -1)
           
})

App after click with density plot.png

Have a quick look at the three previous code blocks and look for the following:

validate(need(input$go != 0, "Please choose your portfolio assets, weights, MAR, rolling window and start date and click submit."))

This code ensures that when the user first opens the app and the submit button has not been activated, the user sees something besides white space.

And that completes our project on the Sortino ratio! I didn’t introduce any new functions or calculations into the Shiny app in this post, but I did show you how to give users a mechanism for building their own portfolios and time frames and passing them to the functions and visualizations that you already tested if you followed along in previous posts. That was by design. The previous posts were meant to be a sandbox or whatever kindergarten-themed analogy you prefer that signifies a place to experiment. The goal of the final Shiny app is to make that experimental work more accessible to a broad audience of end users.

Thanks for reading — and happy Shiny app’ing!

Jonathan Regenstein
Jonathan Regenstein

Jonathan works with RStudio's financial services customers. He studied International Relations as an undergraduate at Harvard, worked in finance at JP Morgan and then did graduate work in Political Economy at Emory University before joining RStudio.

Related Content