---
title: "Semiconductor Analysis"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, eval = TRUE, warning=FALSE, message=FALSE)
library(flexdashboard)
options(digits = 4, scipen = 999999)
library(psych)
library(ggplot2)
library(GGally)
library(dplyr)
library(quantreg)
library(forecast)
library(tidyquant)
library(quantmod)
library(matrixStats)
library(plotly)
library(quadprog)
#
symbols <- c("USD", "PSI", "SMH")
getSymbols(symbols) # using quantmod
data <- USD
data <- data[ , 6] # only adjusted close  
colnames(data) <- "USD"
r_USD <- diff(log(data))[-1] 
# convert xts object to a tibble or data frame
p_USD <- data %>% as_tibble() %>% mutate(date = index(data), month = month.abb[month(index(data))])
# repeat
data <- PSI
data <- data[ , 6]  
colnames(data) <- "PSI"
r_PSI <- diff(log(data))[-1]
p_PSI <- data %>% as_tibble() %>% mutate(date = index(data), month = month.abb[month(index(data))])
# and again
data <- SMH
data <- data[ , 6]  
colnames(data) <- "SMH"
r_SMH <- diff(log(data))[-1]
p_SMH <- data %>% as_tibble() %>% mutate(date = index(data), month = month.abb[month(index(data))])#rate_IYM <- data %>% mutate(diff(log(p_IYM))[-1])
# merge by date (as row name)
price <- merge(p_USD, p_PSI)
price <- merge(price, p_SMH)
return <- merge(USD = r_USD, PSI = r_PSI, SMH = r_SMH, all = FALSE)
# calculute within month correlations and choose lower triangle of correlation matrix
r_corr <- apply.monthly(return, FUN = cor)[, c(2, 3, 6)]
colnames(r_corr) <- c("USD_PSI", "USD_SMH", "PSI_SMH")
# calculate within month sUSDdard deviations using MatrixStats
r_vols <- apply.monthly(return, FUN = colSds)
# long format ("TIDY") price tibble for possible other work
price_tbl <- price %>% as_tibble() %>% gather(k = symbol, value = price, USD, PSI, SMH ) %>% select(symbol, date, price)
return_tbl <- price_tbl %>% group_by(symbol) %>% tq_transmute(mutate_fun = periodReturn, period = "daily", type = "log", col_rename = "daily_return") %>% mutate(abs_return = abs(daily_return))
# 
corr_tbl <- r_corr %>% as_tibble() %>% mutate(date = index(r_corr)) %>% gather(key = assets, value = corr, -date)
vols_tbl <- r_vols %>% as_tibble() %>% mutate(date = index(r_vols)) %>% gather(key = assets, value = vols, -date) 
#
corr_vols <- merge(r_corr, r_vols)
corr_vols_tbl <- corr_vols %>% as_tibble() %>% mutate(date = index(corr_vols))
#
# Tukey-Box-Hunter fence analysis of outliers
#
k <- 1:20 # days in a business month
col_names <- paste0("lag_", k)
#
# remove abs_return the fourth column
return_lags <- return_tbl[, -4] %>%
  tq_mutate(
  select     = daily_return,
  mutate_fun = lag.xts,
  k          = k,
  col_rename = col_names
  )
return_autocors <- return_lags %>%
  gather(key = "lag", value = "lag_value", -c(symbol, date, daily_return)) %>%
  mutate(lag = str_sub(lag, start = 5) %>% as.numeric) %>%
  group_by(symbol, lag) %>%
  summarize(
    cor = cor(x = daily_return, y = lag_value, use = "pairwise.complete.obs"),
    upper_95 = 2/(n())^0.5,
    lower_95 = -2/(n())^0.5
  )
return_absautocors <- return_autocors %>%
  ungroup() %>%
  mutate(
    lag = as_factor(as.character(lag)),
    cor_abs = abs(cor)
  ) %>%
  select(lag, cor_abs) %>%
  group_by(lag)
#
# loss analysis
#
price_last <- price[length(price$USD), 3:5] #(USD, PSI, SMH)
value <- 1000000 # portfolio value
w_0 <- c(0.45, -0.07, 0.62) # wwights -- e.g., min variance or max sharpe
shares <- value * (w_0/price_last)
w <- as.numeric(shares * price_last)
return_hist <- apply(log(price[, 3:5]), 2, diff)
# Fan these across the length and breadth of the risk factor series
weights_rf <- matrix(w, nrow=nrow(return_hist), ncol=ncol(return_hist), byrow=TRUE)
## We need to compute exp(x) - 1 for very small x: expm1 accomplishes this
loss_rf <- -rowSums(expm1(return_hist) * weights_rf)
loss_df <- data_frame(loss = loss_rf, distribution = rep("historical", each = length(loss_rf)))
#
ES_calc <- function(data, prob){
  threshold <- quantile(data, prob)
  result <- mean(data[data > threshold])
}
#
n_sim <- 1000
n_sample <- 100
prob <- 0.95
ES_sim <- replicate(n_sim, ES_calc(sample(loss_rf, n_sample, replace = TRUE), prob))
#
#summary(ES_sim)
#
# mean excess plot to determine thresholds for extreme event management
data <- as.vector(loss_rf) # data is purely numeric
umin <-  min(data)         # threshold u min
umax <-  max(data) - 0.1   # threshold u max
nint <- 100                # grid length to generate mean excess plot
grid_0 <- numeric(nint)    # grid store
e <- grid_0                # store mean exceedances e
upper <- grid_0            # store upper confidence interval
lower <- grid_0            # store lower confidence interval
u <- seq(umin, umax, length = nint) # threshold u grid
alpha <- 0.95                  # confidence level
for (i in 1:nint) {
    data <- data[data > u[i]]  # subset data above thresholds
    e[i] <- mean(data - u[i])  # calculate mean excess of threshold
    sdev <- sqrt(var(data))    # sUSDdard deviation
    n <- length(data)          # sample size of subsetted data above thresholds
    upper[i] <- e[i] + (qnorm((1 + alpha)/2) * sdev)/sqrt(n) # upper confidence interval
    lower[i] <- e[i] - (qnorm((1 + alpha)/2) * sdev)/sqrt(n) # lower confidence interval
  }
mep_df <- data.frame(threshold = u, threshold_exceedances = e, lower = lower, upper = upper)
# loss_excess <- loss_rf[loss_rf > u] - u
quantInv <- function(distr, value) ecdf(distr)(value)
u_prob <- quantInv(loss_rf, 200000)
ES_mep <- mean(loss_rf[loss_rf > u_prob])## data_moments function
## INPUTS: r vector
## OUTPUTS: list of scalars (mean, sd, median, skewness, kurtosis)
data_moments <- function(data){
  library(moments)
  library(matrixStats)
  mean <- colMeans(data)
  median <- colMedians(data)
  sd <- colSds(data)
  IQR <- colIQRs(data)
  skewness <- skewness(data)
  kurtosis <- kurtosis(data)
  result <- data.frame(mean = mean, median = median, std_dev = sd, IQR = IQR, skewness = skewness, kurtosis = kurtosis)
  return(result)
}
#
#
port_sample <- function(return, n_sample = 252, stat = "mean")
{
  R <-  return # daily returns
  n <- dim(R)[1]
  N <- dim(R)[2]
  R_boot <-  R[sample(1:n, n_sample),] # sample returns
  r_free <- 0.03 / 252 # daily
  mean_vect <-  apply(R_boot,2,mean)
  cov_mat <-  cov(R_boot)
  sd_vect <-  sqrt(diag(cov_mat))
  A_mat <-  cbind(rep(1,N),mean_vect) 
  mu_P <-  seq(-.01,.01,length=300)                              
  sigma_P <-  mu_P 
  weights <-  matrix(0,nrow=300,ncol=N) 
  for (i in 1:length(mu_P))  
  {
    b_vec <-  c(1,mu_P[i])  
    result <-  
      solve.QP(Dmat=2*cov_mat,dvec=rep(0,N),Amat=A_mat,bvec=b_vec,meq=2)
    sigma_P[i] <-  sqrt(result$value)
    weights[i,] <-  result$solution
  }
  sharpe <- (mu_P - r_free)/sigma_P ## compute Sharpe's ratios
  ind_max <-  (sharpe == max(sharpe)) ## Find maximum Sharpe's ratio
  ind_min <-  (sigma_P == min(sigma_P)) ## find the minimum variance portfolio
  ind_eff <-  (mu_P > mu_P[ind_min]) ## finally the efficient fr(aes(x = 0, y = r_free), colour = "red")ontier
  result <- switch(stat,
    "mean"  = mu_P[ind_max],
    "sd"    = sigma_P[ind_max]
    )
  return(result)
}
#


```

Context
==============================================

Column {.sidebar}
-----------------------------------------------------------------------

### Situation

Our company wants to invest in an industry to take advantage of the current technology bubble, driven by global economic expansion.  The Semiconductor industry presents this opportunity with several analyst seeing a potential for this industry to experience an average growth rate of a 13% annually.  Semiconductor stocks are largely driven by the end use applications, making ETFs a great option to consider.

### Complications

Even with the predicted high annual growth rate, the unique features of this industry can result in high volatility.  With the Trade War in China and the highly competitive, fast paced technology sector, many Semiconductor companies can experience steep declines in stock prices. 

### Individual Data
- Jay Cain - USD
- Angie Cooper - PSI
- Chad Sittig - SMH
- Arsenio Jones - SOXL

column{.tabset}
------------------------------------------------------

### Key questions

Your CFO has a few questions for us:

1. How do we characterize semiconductor variability and the impact of one market on another? 

2. What are the best combinations of semiconductor drivers?

3. How much capital is needed to support a semiconductor earnings stream?

4. How should the company plan to meet risk tolerances and thresholds for losses?

### Data

For the semiconductor sector we select [exchange traded funds (ETF)](https://www.investopedia.com/terms/e/etf.asp) from the [semiconductor sector](https://www.investopedia.com/features/industryhandbook/semiconductor.asp): 

- USD

- PSI 

- SMH

These funds act as indices to effectively summarize the inputs, process, management, decisions, and outputs of various aspects of the semiconductor sector.

We load historical data on three ETFs, tranform prices into returns, and then further transform the returns into within-month correlations and standard deviations.

### Work flow

Our process includes 

- Review the stylized facts of volatility and relationships among three repesentative markets.

- Develop market risk measures for each driver of earnings.

- Apply corporate risk tolerances and thresholds to determine optimal collateral positions for each driver of earnings.

- Determine optimal combinations of the drivers for maximum excess portfolio return relative to portfolio risk as well as the minimization of risk

- Given the optimal maximum excess return per risk portfolio, determine the probable range of collateral needed to satisfy corporate risk tolerance and thresholds.

Returns
=======================================================================

column {.sidebar}
----------------------------------------------------

### Situation

Our company wants to invest in an industry to take advantage of the current technology bubble, driven by global economic expansion.  The Semiconductor industry presents this opportunity with several analyst seeing a potential for this industry to experience an average growth rate of a 13% annually.  Semiconductor stocks are largely driven by the end use applications, making ETFs a great option to consider.

### Complications

Even with the predicted high annual growth rate, the unique features of this industry can result in high volatility.  With the Trade War in China and the highly competitive, fast paced technology sector, many Semiconductor companies can experience steep declines in stock prices. 

### Individual Data
- Jay Cain - USD
- Angie Cooper - PSI
- Chad Sittig - SMH
- Arsenio Jones - SOXL


column {.tabset}
----------------------------------------------------

### Correlation Between Semiconductors

```{r moments}
ggpairs(as.data.frame(return[, 1:3]))
```

### USD

```{r}
ggtsdisplay(return$USD, plot.type = "histogram", main = "USD daily returns")
```

### PSI

```{r}
ggtsdisplay(return$PSI, plot.type = "histogram", main = "PSI daily returns")
```

### SMH

```{r}
ggtsdisplay(return$SMH, plot.type = "histogram", main = "SMH daily returns")
```

### Returns

```{r plotreturnabscors, exercise = TRUE}
upper_bound <- 1.5*IQR(return_absautocors$cor_abs) %>% signif(3)
p <- return_absautocors %>%    
      ggplot(aes(x = fct_reorder(lag, cor_abs, .desc = TRUE) , y = cor_abs)) +
      
      geom_boxplot(color = palette_light()[[1]]) +
      
      geom_hline(yintercept = upper_bound, color = "red") +
      annotate("text", label = paste0("Outlier threshold = ", upper_bound), 
        x = 24.5, y = upper_bound + .03, color = "red") +
      
      expand_limits(y = c(0, 0.5)) +
      theme_tq() +
      labs(
        title = paste0("Absolute Autocorrelations: Lags ", rlang::expr_text(k)),
        x = "Lags"
        ) +
      theme(
        legend.position = "none",
        axis.text.x = element_text(angle = 45, hjust = 1)
        )
ggplotly(p)
```


Volatility
====================================================

column {.sidebar}
----------------------------------------------------

### Situation

Our company wants to invest in an industry to take advantage of the current technology bubble, driven by global economic expansion.  The Semiconductor industry presents this opportunity with several analyst seeing a potential for this industry to experience an average growth rate of a 13% annually.  Semiconductor stocks are largely driven by the end use applications, making ETFs a great option to consider.

### Complications

Even with the predicted high annual growth rate, the unique features of this industry can result in high volatility.  With the Trade War in China and the highly competitive, fast paced technology sector, many Semiconductor companies can experience steep declines in stock prices. 

### Individual Data
- Jay Cain - USD
- Angie Cooper - PSI
- Chad Sittig - SMH
- Arsenio Jones - SOXL


column {.tabset}
----------------------------------------------------

### USD

```{r}
ggtsdisplay(r_vols$USD, plot.type = "histogram", main = "USD monthly volatility")
```

### SMH
```{r}
ggtsdisplay(r_vols$PSI, plot.type = "histogram", main = "PSI monthly volatility")
```

### PSI

```{r}
ggtsdisplay(r_vols$SMH, plot.type = "histogram", main = "SMH monthly volatility")
```

column {.tabset}
----------------------------------------------------

### USD-PSI

```{r}
ggtsdisplay(r_corr$USD_PSI, plot.type = "histogram", main = "USD-PSI monthly correlation")
```

### USD-SMH

```{r}
ggtsdisplay(r_corr$USD_SMH, plot.type = "histogram", main = "USD-SMH monthly correlation")
```

### PSI-SMH

```{r}
ggtsdisplay(r_corr$PSI_SMH, plot.type = "histogram", main = "PSI-SMH monthly correlation")
```

### USD-PSI market spillover

```{r rqplot-USD-PSI}
p <- ggplot(corr_vols_tbl,  aes(x = PSI, y = USD_PSI)) +
    geom_point() + 
    ggtitle("USD-PSI Interaction") + 
    geom_quantile(quantiles = c(0.10, 0.90)) + 
    geom_quantile(quantiles = 0.5, linetype = "longdash") +
    geom_density_2d(colour = "green")  
ggplotly(p)
```

### USD-SMH market spillover

```{r rqplot-USD-SMH}
p <- ggplot(corr_vols_tbl,  aes(x = SMH, y = USD_SMH)) +
    geom_point() + 
    ggtitle("USD-SMH Interaction") + 
    geom_quantile(quantiles = c(0.10, 0.90)) + 
    geom_quantile(quantiles = 0.5, linetype = "longdash") +
    geom_density_2d(colour = "green")  
ggplotly(p)
```

### PSI-SMH market spillover

```{r rqplot-PSI-SMH}
p <- ggplot(corr_vols_tbl,  aes(x = SMH, y = PSI_SMH)) +
    geom_point() + 
    ggtitle("PSI-SMH Interaction") + 
    geom_quantile(quantiles = c(0.10, 0.90)) + 
    geom_quantile(quantiles = 0.5, linetype = "longdash") +
    geom_density_2d(colour = "green")  
ggplotly(p)
```


Loss
============================================

column {.sidebar}
----------------------------------------------------

### Situation

Our company wants to invest in an industry to take advantage of the current technology bubble, driven by global economic expansion.  The Semiconductor industry presents this opportunity with several analyst seeing a potential for this industry to experience an average growth rate of a 13% annually.  Semiconductor stocks are largely driven by the end use applications, making ETFs a great option to consider.

### Complications

Even with the predicted high annual growth rate, the unique features of this industry can result in high volatility.  With the Trade War in China and the highly competitive, fast paced technology sector, many Semiconductor companies can experience steep declines in stock prices. 

### Individual Data
- Jay Cain - USD
- Angie Cooper - PSI
- Chad Sittig - SMH
- Arsenio Jones - SOXL

column {.tabset}
--------------------------------------------

### USD 

```{r USDloss}
#
shares <- c(-215000, 0, 0)
price_last <- price[length(price$USD), 3:5] #(USD, PSI, SMH) %>% as.vector()
w <- as.numeric(shares * price_last)
return_hist <- apply(log(price[, 3:5]), 2, diff)
# Fan these across the length and breadth of the risk factor series
weights_rf <- matrix(w, nrow=nrow(return_hist), ncol=ncol(return_hist), byrow=TRUE)
## We need to compute exp(x) - 1 for very small x: expm1 accomplishes this
loss_rf <- -rowSums(expm1(return_hist) * weights_rf)
loss_df <- data_frame(loss = loss_rf, distribution = rep("historical", each = length(loss_rf)))
#
ES_calc <- function(data, prob){
  threshold <- quantile(data, prob)
  result <- mean(data[data > threshold])
}
#
n_sim <- 1000
n_sample <- 100
prob <- 0.95
ES_sim <- replicate(n_sim, ES_calc(sample(loss_rf, n_sample, replace = TRUE), prob))
#
sim <- ES_sim
low <- quantile(sim, 0.025)
high <- quantile(sim, 0.975)
sim_df <- data_frame(sim = sim)
title <- "USD: Expected Shortfall simulation"
p <- ggplot(data = sim_df, aes(x = sim))
p <- p + geom_histogram(binwidth = 1000, aes(y = 1000*(..density..)), alpha = 0.4)
p <- p + ggtitle(title)
p <- p + geom_vline(xintercept = low, color = "red", size = 1.5 ) + geom_vline(xintercept = high, color = "red", size = 1.5)
p <- p + annotate("text", x = low, y = 0.01, label = paste("L = ", round(low, 2))) + annotate("text", x = high, y = 0.01, label = paste("U = ", round(high, 2))) + ylab("density") + xlab("expected shortfall") + theme_bw()
ggplotly(p)
```

### PSI

```{r PSIloss}
#
shares <- c(0, 284000, 0)
price_last <- price[length(price$USD), 3:5] #(USD, PSI, SMH) %>% as.vector()
w <- as.numeric(shares * price_last)
return_hist <- apply(log(price[, 3:5]), 2, diff)
# Fan these across the length and breadth of the risk factor series
weights_rf <- matrix(w, nrow=nrow(return_hist), ncol=ncol(return_hist), byrow=TRUE)
## We need to compute exp(x) - 1 for very small x: expm1 accomplishes this
loss_rf <- -rowSums(expm1(return_hist) * weights_rf)
loss_df <- data_frame(loss = loss_rf, distribution = rep("historical", each = length(loss_rf)))
#
ES_calc <- function(data, prob){
  threshold <- quantile(data, prob)
  result <- mean(data[data > threshold])
}
#
n_sim <- 1000
n_sample <- 100
prob <- 0.95
ES_sim <- replicate(n_sim, ES_calc(sample(loss_rf, n_sample, replace = TRUE), prob))
#
sim <- ES_sim
low <- quantile(sim, 0.025)
high <- quantile(sim, 0.975)
sim_df <- data_frame(sim = sim)
title <- "PSI: Expected Shortfall simulation"
p <- ggplot(data = sim_df, aes(x = sim))
p <- p + geom_histogram(binwidth = 1000, aes(y = 1000*(..density..)), alpha = 0.4)
p <- p + ggtitle(title)
p <- p + geom_vline(xintercept = low, color = "red", size = 1.5 ) + geom_vline(xintercept = high, color = "red", size = 1.5)
p <- p + annotate("text", x = low, y = 0.01, label = paste("L = ", round(low, 2))) + annotate("text", x = high, y = 0.01, label = paste("U = ", round(high, 2))) + ylab("density") + xlab("expected shortfall") + theme_bw()
ggplotly(p)
```

### SMH

```{r SMHloss}
#
shares <- c(0, 0, 12500)
price_last <- price[length(price$USD), 3:5] #(USD, PSI, SMH) %>% as.vector()
w <- as.numeric(shares * price_last)
return_hist <- apply(log(price[, 3:5]), 2, diff)
# Fan these across the length and breadth of the risk factor series
weights_rf <- matrix(w, nrow=nrow(return_hist), ncol=ncol(return_hist), byrow=TRUE)
## We need to compute exp(x) - 1 for very small x: expm1 accomplishes this
loss_rf <- -rowSums(expm1(return_hist) * weights_rf)
loss_df <- data_frame(loss = loss_rf, distribution = rep("historical", each = length(loss_rf)))
#
ES_calc <- function(data, prob){
  threshold <- quantile(data, prob)
  result <- mean(data[data > threshold])
}
#
n_sim <- 1000
n_sample <- 100
prob <- 0.95
ES_sim <- replicate(n_sim, ES_calc(sample(loss_rf, n_sample, replace = TRUE), prob))
#
sim <- ES_sim
low <- quantile(sim, 0.025)
high <- quantile(sim, 0.975)
sim_df <- data_frame(sim = sim)
title <- "SMH: Expected Shortfall simulation"
p <- ggplot(data = sim_df, aes(x = sim))
p <- p + geom_histogram(binwidth = 1000, aes(y = 1000*(..density..)), alpha = 0.4)
p <- p + ggtitle(title)
p <- p + geom_vline(xintercept = low, color = "red", size = 1.5 ) + geom_vline(xintercept = high, color = "red", size = 1.5)
p <- p + annotate("text", x = low, y = 0.01, label = paste("L = ", round(low, 2))) + annotate("text", x = high, y = 0.01, label = paste("U = ", round(high, 2))) + ylab("density") + xlab("expected shortfall") + theme_bw()
ggplotly(p)
```

Allocation
============================================

column {.sidebar}
--------------------------------------------

```{r eff-frontier-calc}
R <-  return # daily returns
n <- dim(R)[1]
N <- dim(R)[2]
R_boot <-  R[sample(1:n, 252),] # sample returns
r_free <- 0.03 / 252 # daily
mean_vect <-  apply(R_boot,2,mean)
cov_mat <-  cov(R_boot)
sd_vect <-  sqrt(diag(cov_mat))
A_mat <-  cbind(rep(1,N),mean_vect) 
mu_P <-  seq(-.01,.01,length=300)                              
sigma_P <-  mu_P 
weights <-  matrix(0,nrow=300,ncol=N) 
for (i in 1:length(mu_P))  
  {
    b_vec <-  c(1,mu_P[i])  
    result <-  
      solve.QP(Dmat=2*cov_mat,dvec=rep(0,N),Amat=A_mat,bvec=b_vec,meq=2)
    sigma_P[i] <-  sqrt(result$value)
    weights[i,] <-  result$solution
} 
# make a data frame of the mean and standard deviation results
sigma_mu_df <- data_frame(sigma_P = sigma_P, mu_P = mu_P)
names_R <- c("USD", "PSI", "SMH")
# sharpe ratio and minimum variance portfolio analysis
sharpe <- (mu_P - r_free)/sigma_P ## compute Sharpe's ratios
ind_max <-  (sharpe == max(sharpe)) ## Find maximum Sharpe's ratio
ind_min <-  (sigma_P == min(sigma_P)) ## find the minimum variance portfolio
ind_eff <-  (mu_P > mu_P[ind_min]) ## finally the efficient fr(aes(x = 0, y = r_free), colour = "red")ontier
w_max <- weights[ind_max,]
w_min <- weights[ind_min,]
value <- 1000000
```

### Situation

Our company wants to invest in an industry to take advantage of the current technology bubble, driven by global economic expansion.  The Semiconductor industry presents this opportunity with several analyst seeing a potential for this industry to experience an average growth rate of a 13% annually.  Semiconductor stocks are largely driven by the end use applications, making ETFs a great option to consider.

### Complications

Even with the predicted high annual growth rate, the unique features of this industry can result in high volatility.  With the Trade War in China and the highly competitive, fast paced technology sector, many Semiconductor companies can experience steep declines in stock prices. 

### Individual Data
- Jay Cain - USD
- Angie Cooper - PSI
- Chad Sittig - SMH
- Arsenio Jones - SOXL

column {.tabset}
--------------------------------------------

### Efficient frontier

```{r eff-frontier}
col_P <- ifelse(mu_P > mu_P[ind_min], "blue", "grey") # discriminate efficient and inefficient portfolios
sigma_mu_df$col_P <- col_P
p <- ggplot(sigma_mu_df, aes(x = sigma_P, y = mu_P, group = 1))
p <- p + geom_line(aes(colour=col_P, group = col_P), size = 1.1) + scale_colour_identity() 
p <- p + geom_abline(intercept = r_free, slope = (mu_P[ind_max]-r_free)/sigma_P[ind_max], color = "red", size = 1.1)
p <- p + geom_point(aes(x = sigma_P[ind_max], y = mu_P[ind_max]), color = "green", size = 4) 
p <- p + geom_point(aes(x = sigma_P[ind_min], y = mu_P[ind_min]), color = "red", size = 4) ## show min var portfolio
p
ggplotly(p)
```

### Sharpe mean CI

```{r sampledmean-ex}
port_mean <- replicate(1000, port_sample(return, n_sample = 252, stat = "mean"))
sim <- port_mean * 252
low <- quantile(sim, 0.025)
high <- quantile(sim, 0.975)
sim_df <- data_frame(sim = sim)
title <- "Tangency portfolio sampled mean simulation"
p <- ggplot(data = sim_df, aes(x = sim))
p <- p + geom_histogram(alpha = 0.7)
p <- p + ggtitle(title)
p <- p + geom_vline(xintercept = low, color = "red", size = 1.5 ) + geom_vline(xintercept = high, color = "red", size = 1.5)
p <- p + annotate("text", x = low + 0.01, y = 200, label = paste("L = ", round(low, 2))) + annotate("text", x = high, y = 200, label = paste("U = ", round(high, 2))) + ylab("density") + xlab("daily mean: max Sharpe Ratio") + theme_bw()
ggplotly(p)
```

### Sharpe standard deviation CI

```{r sampledsd-ex}
port_mean <- replicate(1000, port_sample(return, n_sample = 252, stat = "sd"))
sim <- port_mean * 252
low <- quantile(sim, 0.025)
high <- quantile(sim, 0.975)
sim_df <- data_frame(sim = sim)
title <- "Tangency portfolio sampled standard deviation simulation"
p <- ggplot(data = sim_df, aes(x = sim))
p <- p + geom_histogram(alpha = 0.7)
p <- p + ggtitle(title)
p <- p + geom_vline(xintercept = low, color = "red", size = 1.5 ) + geom_vline(xintercept = high, color = "red", size = 1.5)
p <- p + annotate("text", x = low + 0.1, y = 200, label = paste("L = ", round(low, 2))) + annotate("text", x = high, y = 200, label = paste("U = ", round(high, 2))) + ylab("density") + xlab("daily mean: max Sharpe Ratio") + theme_bw()
ggplotly(p)
```

### Max Sharpe Ratio loss thresholds

```{r mepcalc}
price_last <- price[length(price$USD), 3:5] #(USD, PSI, SMH)
value <- 1000000 # portfolio value
w_0 <- w_max # wwights -- e.g., min variance or max sharpe
shares <- value * (w_0/price_last)
w <- as.numeric(shares * price_last)
return_hist <- apply(log(price[, 3:5]), 2, diff)
# Fan these across the length and breadth of the risk factor series
weights_rf <- matrix(w, nrow=nrow(return_hist), ncol=ncol(return_hist), byrow=TRUE)
## We need to compute exp(x) - 1 for very small x: expm1 accomplishes this
loss_rf <- -rowSums(expm1(return_hist) * weights_rf)
loss_df <- data_frame(loss = loss_rf, distribution = rep("historical", each = length(loss_rf)))
#
data <- as.vector(loss_rf[loss_rf > 0]) # data is purely numeric
umin <-  min(data)         # threshold u min
umax <-  max(data) - 0.1   # threshold u max
nint <- 100                # grid length to generate mean excess plot
grid_0 <- numeric(nint)    # grid store
e <- grid_0                # store mean exceedances e
upper <- grid_0            # store upper confidence interval
lower <- grid_0            # store lower confidence interval
u <- seq(umin, umax, length = nint) # threshold u grid
alpha <- 0.95                  # confidence level
for (i in 1:nint) {
    data <- data[data > u[i]]  # subset data above thresholds
    e[i] <- mean(data - u[i])  # calculate mean excess of threshold
    sdev <- sqrt(var(data))    # sUSDdard deviation
    n <- length(data)          # sample size of subsetted data above thresholds
    upper[i] <- e[i] + (qnorm((1 + alpha)/2) * sdev)/sqrt(n) # upper confidence interval
    lower[i] <- e[i] - (qnorm((1 + alpha)/2) * sdev)/sqrt(n) # lower confidence interval
  }
mep_df <- data.frame(threshold = u, threshold_exceedances = e, lower = lower, upper = upper)
```


```{r loss-mep}
# Voila the plot => you may need to tweak these limits!
p <- ggplot(mep_df, aes( x= threshold, y = threshold_exceedances)) + geom_line() + geom_line(aes(x = threshold, y = lower), colour = "red") + geom_line(aes(x = threshold,  y = upper), colour = "red") + annotate("text", x = mean(mep_df$threshold), y = max(mep_df$upper)+100, label = "upper 95%") + annotate("text", x = mean(mep_df$threshold), y = min(mep_df$lower) - 100, label = "lower 5%") + ggtitle("Mean Excess Plot: maximum Sharpe Ratio portfolio") + ylab("threshold exceedances")
ggplotly(p)
```


### Risky capital

```{r loss-capital}
n_sim <- 1000
n_sample <- 100
prob <- 0.95
ES_sim <- replicate(n_sim, ES_calc(sample(loss_rf, n_sample, replace = TRUE), prob))
#
sim <- ES_sim
low <- quantile(sim, 0.025)
high <- quantile(sim, 0.975)
sim_df <- data_frame(sim = sim)
title <- paste0("Loss Capital Simulation: alpha =  ", alpha*100, "% bounds")
p <- ggplot(data = sim_df, aes(x = sim))
p <- p + geom_histogram(alpha = 0.4)
p <- p + ggtitle(title)
p <- p + geom_vline(xintercept = low, color = "red", size = 1.5 ) + geom_vline(xintercept = high, color = "red", size = 1.5)
p <- p + annotate("text", x = low, y = 100, label = paste("L = ", round(low, 2))) + annotate("text", x = high, y = 100, label = paste("U = ", round(high, 2))) + ylab("density") + xlab("expected shortfall") + theme_bw()
ggplotly(p)
```

### Collateral

```{r collateral}
options(digits = 2, scipen = 99999)
#
r_f <- 0.03 # per annum
mu <- mu_P[ind_max] * 252 # pull mu and sigma for tangency portfolio
sigma <- sigma_P[ind_max] * sqrt(252)
#
sigma_p <- seq(0, sigma + 0.25, length.out = 100)
mu_p <- r_f + (mu - r_f)*sigma_p/sigma
w <- sigma_p / sigma
threshold <- -0.12
alpha <- 0.05
z_star <-  qnorm(alpha)
w_star <- (threshold-r_f) / (mu - r_f + sigma*z_star)
sim_df <- data_frame(sigma_p = sigma_p, mu_p = mu_p, w = w)
#
label_42 <- paste(alpha*100, "% alpha, ", threshold*100, "% threshold, \n", round(w_star*100, 2), "% risky asset", sep = "")
label_0 <- paste(0*100, "% risky asset", sep = "")
label_100 <- paste(1.00*100, "% risky asset", sep = "")
p <- ggplot(sim_df, aes(x = sigma_p, y = mu_p)) + 
  geom_line(color = "blue", size = 1.1) +
  geom_point(aes(x = 0.0 * sigma, y = r_f + (mu-r_f)*0.0), color = "red", size = 3.0) + 
  annotate("text", x = 0.2 * sigma, y = r_f + (mu-r_f)*0.0 + 0.01, label = label_0) +
  geom_point(aes(x = w_star * sigma, y = r_f + (mu-r_f)*w_star), shape = 21, color = "red", fill = "white", size = 4, stroke = 4) + 
  annotate("text", x = w_star * sigma + .2, y = r_f + (mu-r_f)*w_star + 0.1, label = label_42) +
  geom_point(aes(x = 1.0 * sigma, y = r_f + (mu-r_f)*1.00), color = "red", size = 3.0) + 
  annotate("text", x = 1.0 * sigma, y = r_f + (mu-r_f)*1.00 + 0.01, label = label_100) +
  xlab("standard deviation of portfolio return") +
  ylab("mean of portfolio return") +
  ggtitle("Risk-return tradeoff of cash and risky asset")
ggplotly(p)
```


References
============================================

column {.sidebar}
--------------------------------------------

### Situation
Our company wants to invest in an industry to take advantage of the current technology bubble, driven by global economic expansion.  The Semiconductor industry presents this opportunity with several analyst seeing a potential for this industry to experience an average growth rate of a 13% annually.  Semiconductor stocks are largely driven by the end use applications, making ETFs a great option to consider.  

### Complications
Even with the predicted high annual growth rate, the unique features of this industry can result in high volatility.  With the Trade War in China and the highly competitive, fast paced technology sector, many Semiconductor companies can experience steep declines in stock prices.  

### Individual Data
Jay Cain - USD
Angie Cooper - PSI
Chad Sittig - SMH
Arsenio Jones - SOXL


column {.tabset}
--------------------------------------------

- 5 Top Semiconductor ETFs, 2017, The Motley Fool, Found at:   https://www.fool.com/investing/2017/07/21/5-top-semiconductor-etfs.aspx  
- Biometric Sensor Chips Information, 2019, IEEE GlobalSpec, Found at:   https://www.globalspec.com/learnmore/semiconductors/sensor_ic/biometric_sensors  
- Global Semiconductor Market Trends, 2018, HIS Markit, Found at:   http://theconfab.com/wp-content/uploads/P-18-Len-Jelinek.pdf  
- Semiconductor Industry, 2019, Wikipedia, Found at: https://en.wikipedia.org/wiki/Semiconductor_industry  
- The Industry Handbook: The Semiconductor Industry, 2018, Investopedia, Found at:   https://www.investopedia.com/features/industryhandbook/semiconductor.asp  
- The Top 5 Semiconductor ETFs, 2018, Investopedia, Found at:   https://www.investopedia.com/articles/etfs/top-semiconductor-etfs/  
- The Top 7 Car Safety Features You Canot Do Without, 2018, Forbes, Found at:   https://www.forbes.com/sites/peterlyon/2018/05/31/the-top-7-car-safety-features-you-cannot-do-without/#2f2e87115fc0
- Flexdashboard template, Dr. Bill Foote, Found at:
https://turing.manhattan.edu/~wfoote01/finalytics/_site/RMD/live-10.Rmd