In asset management, it's critically important to understand whether a portfolio is performing well or not at a glance. Building an interactive Shiny application is a great way to integrate this information into a decision maker's workflow.

In this post, which is part two of a three-part series, I'll be showing you how to visualize changes in the Sortino ratio, a metric that encompasses the return you are likely to get from a given level of risk. In the first installment, I demonstrated how to construct a portfolio and calculate the Sortino ratio. By the end of this series, you should be able to build a Shiny web application that will make it easy for anyone to check how a portfolio is likely to perform.

As a reminder, we are using the following portfolio and Minimum Acceptable Rate (MAR), which can be thought of as excess returns:

Assets and Weights

+ SPY (S&P500 fund) weighted 25%
+ EFA (a non-US equities fund) weighted 25%
+ IJS (a small-cap value fund) weighted 20%
+ EEM (an emerging-mkts fund) weighted 20%
+ AGG (a bond fund) weighted 10%

Minimum Acceptable Rate

+ MAR = .008 or .8%

Let's load up our packages and get to it.

# first install the packages if they are not already installed in your environment.
# install.packages("tidyverse")
# install.packages("tidyquant")
# install.packages("timetk")
knitr::opts_chunk$set(message=FALSE, warning=FALSE) library(tidyverse) library(tidyquant) library(timetk) library(highcharter) To import prices, transform to portfolio returns, and calculate the Sortino ratio for our chosen MAR of 0.8%, you will use the code below, which is from the first post of this series:  # The symbols vector holds our tickers. symbols <- c("SPY","EFA", "IJS", "EEM","AGG") # The prices object will hold our raw price data prices <- getSymbols (symbols, src = 'yahoo', from = "2005-01-01", auto.assign = TRUE, warnings = FALSE) %>% map(~Ad(get(.))) %>% reduce(merge) %>% colnames<-(symbols) w <- c(0.25, 0.25, 0.20, 0.20, 0.10) MAR <- .008 # XTS world prices_monthly <- to.monthly(prices, indexAt = "last", OHLC = FALSE) asset_returns_xts <- na.omit(Return.calculate(prices_monthly, method = "log"))portfolio_returns_xts <- Return.portfolio(asset_returns_xts, weights = w) # XTS object sortino_xts <- SortinoRatio(portfolio_returns_xts, MAR = MAR) %>% colnames <- ("ratio") # Tidyverse method, to long, tidy format 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)))) portfolio_returns_tidy <- asset_returns_long %>% tq_portfolio(assets_col = asset, returns_col = returns, weights = w, col_rename = "returns")  When I originally calculated Sortino by hand in the tidy world, I used summarise to create one new cell for our end result. Here's how that looked: summarise(ratio = mean(returns - MAR)/sqrt(sum(pmin(returns - MAR, 0)^2)/nrow(.)))  In this post, I will make two additions to improve our data visualization. Let's add a column for returns that fall below MAR: mutate(returns_below_MAR = ifelse(returns < MAR, returns, NA))  And add a column for returns above MAR: mutate(returns_above_MAR = ifelse(returns > MAR, returns, NA)) This is not necessary for calculating the Sortino, but it makes ggplotting a bit easier and illustrates a benefit of doing things by hand with dplyrIf you want to extract or create specific data transformations, you can add them to the piped code flow. # Tibble object sortino_byhand <- portfolio_returns_tidy %>% slice(-1) %>% mutate(ratio = mean(returns - MAR)/sqrt(sum(pmin(returns - MAR, 0)^2)/nrow(.))) %>% # Add two new columns to help with ggplot. mutate(returns_below_MAR = ifelse(returns < MAR, returns, NA)) %>% mutate(returns_above_MAR = ifelse(returns > MAR, returns, NA)) We now have two objects in our global environment, sortino_xts and sortino_byhand. ### Scatter Plot Let's work with sortino_byhand and start with a scatter plot of returns using ggplot. The goal is to quickly grasp how many of our returns are above and below the target MAR. Remember that when we calculated the Sortino above, we created new columns for returns_above_MAR and returns_below_MAR. This makes the visualization a straightforward construct. Illustrate returns above MAR in green: geom_point(aes(y = returns_above_MAR), color = "green") and create points for returns below MAR in red: geom_point(aes(y = returns_below_MAR), color = "red") I'm always curious how portfolios have performed since the election. I'll add a blue vertical line at November 2016 to make it easier to distinguish. I will also include a horizontal purple dotted line at the MAR. sortino_byhand %>% ggplot(aes(x = date)) + geom_point(aes(y = returns_below_MAR), color = "red") + geom_point(aes(y = returns_above_MAR), color = "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 = -.15, label = "Election", fontface = "plain", angle = 90, alpha = .5, vjust = 1.5) + ylab("percent monthly returns") It appears that about half of our returns fall below the MAR. Do we consider that to be a successful portfolio? This is not a rigorous test what strikes you about the number of red dots and where they fall? Do you notice a trend? A period with points clustered consistently below or above MAR returns? Since the election in 2016, there has been only one monthly return below the MAR. That will lead to a large Sortino after November. ### Histogram Next, we will build a histogram of the distribution of returns with: geom_histogram(alpha = 0.25, binwidth = .01, fill = "cornflowerblue") Again, add a line for the MAR:  sortino_byhand %>% 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 = 22, label = "MAR", fontface = "plain", angle = 90, alpha = .5, vjust = 1) sortino_byhand %>% 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 = 22, label = "MAR", fontface = "plain", angle = 90, alpha = .5, vjust = 1) I notice a slight negative skew and a mode that is above MAR a good indication that we should take note. Calculating the mean monthly return can provide more context: r round(mean(sortino_byhand$returns), 3)

Unsurprisingly, it is below our MAR of r MAR. We already had a sense of this since the Sortino ratio is negative.

### Density Plot

The Sortino ratio and portfolio returns in general are usually accompanied by a density plot. Let's build one now. I'll start with something simple:

stat_density(geom = "line", size = 1, color = "cornflowerblue")

This creates a ggplot object called sortino_density_plot.


sortino_density_plot <- sortino_byhand %>%
ggplot(aes(x = returns)) +
stat_density(geom = "line", size = 1, color = "cornflowerblue")

sortino_density_plot 

The slight negative skew is more evident here than in the histogram. It would be nice to shade the area that falls below the MAR. To do that, let's create an object called shaded_area:

 ggplot_build(p)$data[[1]] %>% filter(x < MAR) That snippet will take our original ggplot object and create a new object filtered for x values less than MAR. Then I'll use geom_area to add the shaded area to sortino_density_plot. # use ggplot_build to get the p object; it returns a list of 1 data frame, # not a dataframe. # To access the dataframe we need to call [[1]] shaded_area_data <- ggplot_build(sortino_density_plot)$data[[1]] %>%
filter(x < MAR)
geom_area(data = shaded_area_data, aes(x = x, y = y), fill="pink", alpha = 0.5)
sortino_density_plot_shaded

Let's add a vertical line label at the exact MAR and an arrow to tell people where downside volatility resides. Note that you can keep adding layers to the sortino_density_plot_shaded object from above, which is one of the great features of ggplot. It allows you to experiment with aesthetics without changing the core plot in each iteration.

sortino_density_plot_shaded +
geom_segment(aes(x = 0, y = 1, xend = -.05, yend = 1),
arrow = arrow(length = unit(0.5, "cm"))) +
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 = "MAR = 0.8%",
fontface = "plain", angle = 90, alpha = .8, vjust =  -1) +
annotate(geom = "text", x = -.02, y = .1, label = "Downside",
fontface = "plain", alpha = .8, vjust =  -1)

As with the scatter plot, I have not been shy about aesthetic layering. (Another goal of this post is to explore ggplot tools, so I'm giving myself license to be over inclusive.)

We have done some good work visualizing the portfolio's returns and how they are distributed relative to the MAR, and how the MAR separates part of the returns to downside risk. All this work has given us some insight into the Sortino ratio, which we haven't explored
yet. Let's do so now.

### Rolling Sortino Ratio

The ratio itself is one number: r round(sortino_xts[1], 3). This doesn't allow for very interesting dynamic visualizations, so I will instead calculate the rolling ratio to illustrate how it changes over time. There is a slight wrinkle though  remember that we exclude above-MAR returns from the denominator. If your rolling window is too small, you might end up with a denominator that includes 1, 2, or 0 downside deviations. That would accurately reflect that the portfolio has done well in the small window, but it might report a misleadingly huge number in the rolling window.

First, you need to calculate the rolling 6-month Sortino:

rollapply(portfolio_returns_xts, 6, function(x) SortinoRatio(x)) 

Then you can visualize with highcharter:

# calculate 6-month rolling Sortino
sortino_roll_6
rollapply(portfolio_returns_xts, 6,function(x) SortinoRatio(x, MAR = MAR)) %>%
colnames ("6-rolling")

sortino_roll_6[20:24]
# Pass to highcharter
highchart(type = "stock") %>%
hc_title(text = "Rolling Sortino") %>%
hc_add_series(sortino_roll_6, name = "Sortino", color = "blue") %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE)

When you calculate Sortino over short time periods, you can end up with strange results. The rolling 6 month has so many bizarre spikes, e.g., a reading of 176 on January 31, 2007, and a reading of 9 on September 30, 2009, before breaching 100 in 2016!

This nicely emphasizes why you need to be careful with the Sortino ratio, short time periods, and rolling applications. Let's see how the rolling 24 month compares:

sortino_roll_24 <- rollapply(portfolio_returns_xts, 24,
function(x) SortinoRatio(x, MAR = MAR))

highchart(type = "stock") %>%
hc_title(text = "Rolling Sortino") %>%
hc_add_series(sortino_roll_24, name = "Sortino 24", color = "green") %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE)

Ah, much better. You can see how the Sortino has changed through the life of this portfolio within a reasonable range of 0.6 to -0.4. The spikes and plunges are reliable markers for things that require further investigation. The trough in 2009 is reflective of the credit crunch. What about the free fall in February 2016? And the roller coaster from May 2013 to May 2014?

Rolling Sortinos need to be handled with care, but there are a few nice payoffs. First, these charts force us and our application end users to reflect on how time periods can affect Sortino in extreme ways. Be skeptical if someone reports a fantastic 6-month Sortino. Second, as an exploratory device, rolling ratios can highlight time periods that deserve more investigation. Finally, rolling ratios can help reframe the analysis of a portfolio to examine how it has behaved in different economic and market contexts. Without rolling ratios, it is often tempting for decision makers to judge a portfolio as good or bad based solely on the final number that's presented.

In the next installment, you will learn how to synthesize this information in an interactive Shiny app that makes it easy for stakeholders to get the information they need to inform daily decisions.