# Tiny Steps in Prospect Theory and Investment Decisions Part II

Last time we went through a rigorous process of eliciting prior beliefs about 5 stocks, exploratory data analysis and quite advanced descriptive stats. The last part of the assignment has the goal of drawing connections to the behavioral economics principles. A lesson learned for now, is that there are many pitfalls even in most innocently looking questions.

## Part IV. Portfolio Construction by Simulation

Before we dig in, I would like to suggest the following reading "Please no, not another bias" by Jason Collin. The whole site makes an argument that the missing piece from both Behavioral and Neoclassical economics is Evolution, and I am very tempted by this idea. In contrast, I don’t find it very useful to reason about deviations from the (economic) rationality, as it suggests some kind of patch/ covering of edge cases of classical models, thus making a very subtle assumption about rationality. It’s appealing to me in the same way as Anwar Shaikh’s1 argument of real competition and turbulent dynamics versus the perfect and imperfect competition.

library(tidyquant) # financial data analysis
library(quantmod)  # financial modeling
library(PerformanceAnalytics)

library(GGally)    # ggplot pairwise scatters
library(knitr)     # tables and utilities
library(ochRe)     # fancy color palettes
# Look up how the last time we extracted the data via different options
group_by(symbol) %>%
tq_mutate(
mutate_fun = dailyReturn,
type       = "log",
col_rename = "returns")

returns_wide <- returns %>%
tidyr::spread(key = symbol, value = returns) %>%
na.omit()

getSymbols("SP500", src = "FRED")
## [1] "SP500"
sp_return <- dailyReturn(SP500, type = "log")

returns_wide <- sp_return %>% as_data_frame() %>%
rownames_to_column("date") %>%
mutate(date = as.Date(date)) %>%
right_join(returns_wide, by = "date")
head(returns)
## # A tibble: 6 x 4
## # Groups:   symbol [1]
##   <chr>  <date>        <dbl>    <dbl>
## 1 GOOGL  2007-01-03     234.  0.
## 2 GOOGL  2007-01-04     242.  0.0330
## 3 GOOGL  2007-01-05     244.  0.00810
## 4 GOOGL  2007-01-08     242. -0.00744
## 5 GOOGL  2007-01-09     243.  0.00396
## 6 GOOGL  2007-01-10     245.  0.00812

Recall the prior and updated probabilities of our decidents from the previous post and let’s keep the three “winners” and pick reasonable ranges for probabilities for the two cases:

rsp_eb <- tibble(
id      = rep("EB", 5),
symbol  = c("GOOGL", "AMZN", "NFLX", "JNJ", "TSLA"),
score   = c(7, 9, 7, 5, 8),
prob    = c(0.8, 0.8, 0.5, 0.1, 0.5),
prob_up = c(0.8, 0.9, 0.4, 0.7, 0.4)
)

rsp_mc <- tibble(
id      = rep("MC", 5),
symbol  = c("GOOGL", "AMZN", "NFLX", "JNJ", "TSLA"),
score   = c(8.5, 7, 7.5, 6, 8),
prob    = c(0.85, 0.75, 0.4, 0.70, 0.85),
prob_up = c(0.85, 0.80, 0.4, 0.55, 0.75)
)

rbind(rsp_eb, rsp_mc) %>%
filter(symbol %in% c("GOOGL", "AMZN", "JNJ")) %>%
arrange(symbol) %>%
knitr::kable()
id symbol score prob prob_up
EB AMZN 9.0 0.80 0.90
MC AMZN 7.0 0.75 0.80
EB GOOGL 7.0 0.80 0.80
MC GOOGL 8.5 0.85 0.85
EB JNJ 5.0 0.10 0.70
MC JNJ 6.0 0.70 0.55

Based on respondents’ decisions in Part III and prior, updated probabilities of including the assets in portfolio, choose a reasonable interval and generate random numbers according to a distribution2. Then for each case (prior, updated), generate portfolios using the top two and three assets: Google, Amazon, Johnson&Johnson.

Since we’re running a toy example and not using the matrix form and optimization, the following code won’t be the most pretty one. So what do we expect to see? By combining Google With Amazon we will definitely get more return at the same level of risk. If we were to assign probabilities the full range, that would return the efficiency fronteer. Given that we constrain the range centered at respondents probabilities, it would represent different ranges of possible portfolios. Also, given that the updated changes in probability are not very big, I don’t expect a large difference between prior probability portfolios and updated ones.

Note that the Sharpe ratio is basically the coefficient of variation from stats (applied on returns), so we could summarize the whole exercise in the 2d plane of risks and returns. Here are go-to formulas:

$\mathbf{E}R_{1,2}=p\mu_1 + (1-p)\mu_2$ where $p \sim Unif([a, b])$

$\mathbf{V}R_{1,2} = p^2\sigma_1^2+(1-p)^2\sigma_2^2 + 2p(1-p)\sigma_{1,2}$

set.seed(1337)
# Since don't really have motivation for a distribution
# Let's pick the points uniformly, as we have no idea
# which combination will strike
p    <- runif(n = 100, min = 0.01, max = 0.99) # to draw the  fronteer
pa   <- runif(n = 100, min = 0.001, max = 0.99)
pg   <- runif(n = 100, min = 0.001, max = 0.99)
pj   <- runif(n = 100, min = 0.001, max = 0.99)

pp_a <- runif(n = 100, min = 0.70, max = 0.85)
pu_a <- runif(n = 100, min = 0.80, max = 0.90)
pp_g <- runif(n = 100, min = 0.80, max = 0.85)
pu_g <- runif(n = 100, min = 0.80, max = 0.85)
pp_j <- runif(n = 100, min = 0.10, max = 0.70)
pu_j <- runif(n = 100, min = 0.55, max = 0.70)

pp_a_norm <- pp_a / (pp_a + pp_g)
pp_g_norm <- 1 - pp_a_norm

pu_a_norm <- pu_a / (pu_a + pu_g)
pu_g_norm <- 1 - pu_a_norm

pa <- pa / (pa + pg + pj)
pg <- pg / (pa + pg + pj)
pj <- 1 - pa - pg

pa_norm <- pp_a / (pp_a + pp_g + pp_j)
pg_norm <- pp_g / (pp_g + pp_g + pp_j)
pj_norm <- pp_j / (pp_j + pp_g + pp_j)

ua_norm <- pu_a / (pu_a + pu_g + pu_j)
ug_norm <- pu_g / (pu_g + pu_g + pu_j)
uj_norm <- pu_j / (pu_j + pu_g + pu_j)

# here our task is simpler as we don't need quantiles
qtl <- returns %>%
filter(symbol %in% c("GOOGL", "AMZN", "JNJ")) %>%
group_by(symbol) %>%
summarise( mean = mean(returns), sd = sd(returns))
qtl 
## # A tibble: 3 x 3
##   symbol     mean     sd
##   <chr>     <dbl>  <dbl>
## 1 AMZN   0.00124  0.0248
## 2 GOOGL  0.000544 0.0180
## 3 JNJ    0.000391 0.0101

Case of portfolios built from two assets

# Note that this is just for the demonstration purposes
# this is useless on larger portfolios

cov_ag <- cov(returns_wide[, c("AMZN", "GOOGL", "JNJ")])
#            AMZN     GOOGL       JNJ
# AMZN  1.0000000 0.5242281 0.3236181
# GOOGL 0.5242281 1.0000000 0.3673752
# JNJ   0.3236181 0.3673752 1.0000000

c_ag <- cov_ag[1, 2]
c_aj <- cov_ag[1, 3]
c_gj <- cov_ag[2, 3]
s_g  <- qtl$sd[2] s_a <- qtl$sd[1]
s_j  <- qtl$sd[3] m_g <- qtl$mean[2]
m_a  <- qtl$mean[1] m_j <- qtl$mean[3]
# here we have our hundred portfolios
# first calulate expected returns

front <- tibble(
front_m = p * m_g + (1 - p)*m_a,
front_s = sqrt(p^2*s_g^2 + (1-p)^2*s_a^2 + 2*p*(1-p)*c_ag)
)

prior <- tibble(
mean = pp_a_norm * m_a + (pp_g_norm) * m_g,
sd   = sqrt(pp_a_norm^2*s_a^2 + pp_g_norm^2*s_g^2 + 2*pp_a_norm*pp_g_norm*c_ag)
)

# expecting to shift towards amazon by a bit along fronteer
updated <- tibble(
mean = pu_a_norm*m_a +  pu_g_norm*m_g,
sd   = sqrt(pu_a_norm^2*s_a^2 + pu_g_norm^2*s_g^2 + 2*pu_a_norm*pu_g_norm*c_ag)
)

front3 <- tibble(
front_m = pa*m_a + pg*m_g + pj*m_j,
front_s = sqrt(pa^2*s_a^2 + pg^2*s_g^2 + pj^2*s_j^2 +
2*pa*pg*c_ag + 2*pa*pj*c_aj + 2*pg*pj*c_gj)
)

prior3 <- tibble(
mean = pa_norm*m_a + pg_norm*m_g + pj_norm*m_j,
sd   = sqrt(pa_norm^2*s_a^2 + pg_norm^2*s_g^2 + pj_norm^2*s_j^2 +
2*pa_norm*pg_norm*c_ag + 2*pa_norm*pj_norm*c_aj +
2*pg_norm*pj_norm*c_gj)
)

updated3 <- tibble(
mean = ua_norm*m_a + ug_norm*m_g + uj_norm*m_j,
sd   = sqrt(ua_norm^2*s_a^2 + ug_norm^2*s_g^2 + uj_norm^2*s_j^2 +
2*ua_norm*ug_norm*c_ag + 2*ua_norm*uj_norm*c_aj +
2*ug_norm*uj_norm*c_gj)
)
front %>%
ggplot() +
geom_point(aes(x = front_s, y = front_m),
color = "steelblue", alpha = 0.3) +
geom_point(data = qtl, aes(x = sd, y = mean),
size = 4, color = "indianred2") +
geom_point(data = prior, aes(x = sd, y = mean),
color = "indianred", size = 2) +
geom_point(data = updated, aes(x = sd, y = mean),
color = "gold", size = 2, alpha = 0.1) +
geom_point(data = front3, aes(x = front_s, y = front_m),
color = "grey60") +
geom_point(data = prior3, aes(x = sd, y = mean),
color = "indianred") +
geom_point(data = updated3, aes(x = sd, y = mean),
color = "gold") +
geom_text(data = qtl, aes(label = symbol, x = sd, y = mean), vjust = 1.5) +
theme_minimal() +
labs(title    = "Portfolios for 2 and 3 assets", x = "risk", y = "return",
subtitle = "Prior portfolio range in [Red], Updated in [Gold]") 

Notice that with three assets, we can achieve an even higher level of returns, staying at the same level of volatility. Also, the interval shrinks after we see the data, which is delighting to see. However, the choice of probabilities leads to a slightly suboptimal choice, i.e it can be moved up to the fronteer without sacrificind in risk.

## Part V. Prospect Theory

If we would fit a classical utility function that has constant returns on scale, we could estimate it econometrically. Note however that there is no concept of reference point or probability weighting or asymmetric Value function

$U(x)=\frac{1}{\alpha}x^\alpha$ If you want a micro example of how to write functions with assertions, check out the following post.

U <- function(x, alpha) x^alpha / alpha
alphas <- c(0.5, 0.3, 0.25, 0.18, 0.1)

# apply the function on using 4 different gamma parameters
df <- sapply(X = alphas, FUN = U, x = seq(0, 30, by = 0.1)) %>%
as_tibble()
# add the appropriate values to column names
colnames(df) <- as.character(alphas)
df %>%
mutate(x = seq(0, 30, by = 0.1)) %>%
reshape2::melt(id.vars = "x") %>% # could use tidyr::gather as an alternative
rename(alpha = variable) %>%
ggplot(aes(x = x, y = value, color = alpha)) +
geom_line(size = 1) +
theme_minimal() +
labs(title = "A typical power Utility function") +
scale_color_ochre(palette = "nolan_ned") # if you feel fancy today

The fitting of such an utility function seems reasonable for the 3-Asset case.

The question is actually, on what do we (appropriately) fit the probability weighting and value functions? To use simulated portfolios or choose the parameters by judgement? Will have to read more about this and come back with sharper understanding in order to fit these appropriately.

Need a value function for the previously generated portfolios, but before that transform probabilities in decisional weights.

$\pi(p) =\frac{p^\gamma}{(p^\gamma + (1- p)^\gamma)^{\frac{1}{\gamma}}}$

weight <- function(p, gamma) p^gamma / ((p^gamma + (1 - p)^gamma)^(1/gamma))
gammas <- c(0.5, 0.45, 0.55, 0.4, 0.6)

# apply the function on using 4 different gamma parameters
df <- sapply(X = gammas, FUN = weight, p = seq(from = 0, to = 1, by = 0.005)) %>%
as_tibble()
# add the appropriate values to column names
colnames(df) <- as.character(gammas)
df %>%
mutate(x = seq(from = 0, to = 1, by = 0.005)) %>%
reshape2::melt(id.vars = "x") %>% # could use tidyr::gather as an alternative
rename(gamma = variable) %>%
ggplot(aes(x = x, y = value, color = gamma)) +
geom_line(size = 1) +
theme_minimal() +
labs(title = "Weighting probability function", x = "probability",
y = "decision weight") +
scale_color_ochre(palette = "nolan_ned") # if you feel fancy today

$V(x)= \begin{cases} x^\alpha, ~~ x \ge 0\\ -\lambda(-x)^b, ~x < 0 \end{cases}$

Next Time: Find/Simulate a dataset, mathematically understand the models and their limitations, estimate on appropriate data, statistically validate the results.

## Conclusion

The analysis I did is limited, both in practical sense and uncovering the power of behavioral economics. In practice, we want to look at more realistic portfolios and efficiently compute, optimize those. The low-dimensional approach described here doesn’t scale to larger problems. Second, there is a list of modeling decisions that have to be made which are key when taking such decisions. In practice, every point emphasized here is even more challenging: starting from data collection, exploratory analysis and ending with modeling, interpretation. At the end of the day, people are developing cutting-edge models, and even then decisions are not much easier.

Why doesn’t this uncover as much of the power of Behavioral Economics? We just need to ask a different set of questions. That, in turn will motivate the use of a more appropriate data, like actual investor decisions. Understanding it will make us better decision-makers.

On such data, it is hard to formulate and validate hypotheses regarding people’s beliefs in momentum, reversion to the mean and identify during what time spans is it valid or even practically exploitable? So, the question isn’t only if markets do really exhibit some deviation, but how our judgements about these properties/patterns affect our decisions and how often are we right about it. Also, if we want to estimate parameters of Value Function and Probability Weighting function we need a rigorous design in order to gather data and fit the statistical models.

We need other kind of data and thought experiments in order to reason about fundamental issues like the bias against realizing losses (leading to disposition effects), heuristics and subptimal behaviors. The fact that given how you approach finance you can drift into gruesome mathematics or study of behavior, shows that we cannot assign these things into categories.

Speaking in finance’s jargon, I chose the techical analysis way: looking at trends and past evolution, correlations to predict the future, but there is another perspective of fundamental analysis. I do believe simple models are very useful and should be the starting point, but I’m still not satified with the answers I’m getting from any single perspective on economics. Recently I saw a few very down-to-earth, but amazing lectures by R.Schiller, and a thought that isn’t leaving my head is in the spirit of Please no, not another bias. We all agree by now that behavior is important, but what part of it can be used for innovative policies? It’s not about exploitation anymore: it’s not reasonable for businesses in the long-term to trick people, finance is also moving in the direction of more integrity.

When we ask what is the rational thing to do, this is an extremely tricky question and even considering the enormous quantity of research, it’s not settled and very much an open question for me.

What’s next? Continue studying behavior and decisions. Writing this helped me realize I’m interested in other kinds of questions about finance, especially new types of modeling, rather than going the same paths of chekcing EMH in any of its forms & random walking down Wall Street.

## Appendix

#### Bollinger Bands, Convergence-Divergence MA, Drawdown Plots

After reading Part I, it can be a little bit unclear how to interpret these descriptive statistics. Bollinger bands are meant to represent a smooth evolution via a Moving Average and upper/lower bounds in order to describe the uncertainty in that evolution. Of course, some assumptions are made by doing so, and it’s just an exploratory tool and cannot replace rigorous statistical analysis (and it is expected to have mixed results). Their ubiquitous use shows that a simple technique can still be useful and get us one more level beyond raw data. $MA - k\sigma \le MA \le MA + k\sigma$ Now let’s see that the Moving Average Convergence-Divergence isn’t a scary thing. You basically have a two moving averages of different windows and their divergence represented as a barplot over time. By construction is is supposed to oscilate, thus uncovering some momentum, bearish opportunities, etc. Like any similar signal processing procedure, it can and will return false positives. Mathematically it’s the velocity $\dot y = \frac{dy}{dt}$ that goes through two low pass filters and is then rescaled. The divergence series is basically the acceleration.

Drawdown measures the decline in the historical peak of a series, in our case cumulative returns. Formally,

$D(T)=\max\big\{0; \max_{0 \le t \le T} X(t) - X(T) \big\}$

#### Beta

A basic beta analysis, i.e. a regression of stock returns (y) on Index Fund (x) returns for $i = 1, ..., 5$, would tell us pretty much the same story as previous analysis, so nothing fundamentally new here. I’ll leave the code in case of curiosity. $y^{(i)} = \alpha^{(i)} + \beta^{(i)} x + \epsilon$

Some rules of thumb regarding the interpretation. This should be followed by a sensitivity analysis on the time frame. $\begin{cases} 0 \le \beta^{(i)} \le 1, ~ less ~~volatile\\ \beta^{(i)} > 1, ~~more~~ volatile\\ \beta^{(i)} > 2.5, ~~much~~more~~ volatile \end{cases}$

lowerFn <- function(data, mapping, method = "lm", ...) {
p <- ggplot(data = data, mapping = mapping) +
geom_point(colour = "grey30", alpha = 0.1) +
geom_smooth(method = method, color = "indianred", ...)
p
}

returns_wide %>%
select(-date) %>%
ggpairs(
title = "Pairwise scatterplots of Returns",
lower = list(continuous = wrap(lowerFn, method = "lm")),
diag = list(continuous = wrap("barDiag", fill = "lightblue", color = "grey"))
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1))

Just from a glance, it’s quite clear which stocks are more correlated with S&P returns. Let’s run the model and extract the coefficients.

# excuse the following ugly piece of code, shoud've done a *apply
rbind(
c("AMZN",  lm(AMZN  ~ daily.returns,  data = returns_wide)$coefficients), c("GOOGL", lm(GOOGL ~ daily.returns, data = returns_wide)$coefficients),
c("JNJ",   lm(JNJ   ~ daily.returns,  data = returns_wide)$coefficients), c("NFLX", lm(NFLX ~ daily.returns, data = returns_wide)$coefficients),
c("TSLA",  lm(TSLA  ~ daily.returns,  data = returns_wide)\$coefficients)
) %>% as_tibble() %>%
rename(symbol = V1, alpha = (Intercept), beta = daily.returns) %>%
mutate(alpha = round(as.numeric(as.character(alpha)), 5),
beta = round(as.numeric(as.character(beta)),   5))
## # A tibble: 5 x 3
##   symbol    alpha  beta
##   <chr>     <dbl> <dbl>
## 1 AMZN   0.000680 1.12
## 2 GOOGL  0.000310 0.991
## 3 JNJ    0.000270 0.635
## 4 NFLX   0.000780 1.05
## 5 TSLA   0.000750 1.26

We could also run a few CAPM regressions, but I would prefer to focus on simulating the portfolios.

1. Look up Capitalism: Competition, Conflict, Crises

2. Using a grid would be a bad idea in optimization