Not many people understand the financial alchemy of modern financial investment vehicles, like hedge funds, that often use sophisticated trading strategies. But everybody understands the meaning of rising and falling markets. Why not simply translate one into the other?

If you want to get your hands on a simple R script that creates an easy-to-understand plot (a *profit & loss profile* or *payoff diagram*) out of any price series, read on!

Once again we will stand on the shoulders of giants by using the mighty `quantmod`

package (on CRAN) and a not so well-known function from Base R, `scatter.smooth`

(to run the code you must have R ≥ 4.1.0 installed):

library(quantmod) ## Loading required package: xts ## Loading required package: zoo ## ## Attaching package: 'zoo' ## The following objects are masked from 'package:base': ## ## as.Date, as.Date.numeric ## Loading required package: TTR ## Registered S3 method overwritten by 'quantmod': ## method from ## as.zoo.data.frame zoo loessplot <- function(comp, benchm) { data <- merge(benchm, comp, all = FALSE) |> ROC() |> coredata() |> na.omit() |> data.frame() names(data) <- c("benchmark", "comparison") with(data, scatter.smooth(benchmark, comparison, evaluation = 200, xlab = names(benchm), ylab = names(comp), main = paste("Profit & Loss Profile, Correlation:", benchmark |> cor(comparison) |> round(2)), lpars = list(col = "red", lwd = 3))) abline(h = 0); abline(v = 0); abline(0, -1); abline(0, 1, col = "blue") }

What this code, i.e. the `loessplot`

function, does is to create a scatter plot from the respective price series and a benchmark (normally an index to compare it with) and superimpose a payoff diagram. The payoff diagram is created by a *local regression*, or more precisely *locally estimated scatterplot smoothing* or *LOESS*. LOESS can be seen as a generalization of polynomial regression which is itself a generalization of linear regression, that is closely related to correlation (the correlation coefficient is additionally provided in the title of the plot to give some context).

It is best explained by showing a few examples. Let us start with a simple index tracker of the S&P 500:

SP500 <- getSymbols("^GSPC", auto.assign = FALSE) ## 'getSymbols' currently uses auto.assign=TRUE by default, but will ## use auto.assign=FALSE in 0.5-0. You will still be able to use ## 'loadSymbols' to automatically load data. getOption("getSymbols.env") ## and getOption("getSymbols.auto.assign") will still be checked for ## alternate defaults. ## ## This message is shown once per session and may be disabled by setting ## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details. getSymbols("IVV") # iShares Core S&P 500 ETF ## [1] "IVV" loessplot(IVV$IVV.Adjusted, SP500$GSPC.Adjusted)

On the x-axis we have the benchmark, in this case the S&P 500, the y-axis shows the performance of the ETF. The blue line in the diagram signifies a perfect replication of the underlying, while the red line is the average payoff profile of the price series for each market phase. We can see that the tracking error is quite small, the nearly perfect positive correlation corroborates this.

It is common wisdom that combining stocks with bonds can be worthwhile. Let us have a look at their profit & loss profile:

getSymbols("TLT") # iShares 20+ Year Treasury Bond ETF ## [1] "TLT" loessplot(TLT$TLT.Adjusted, SP500$GSPC.Adjusted)

We can clearly see that they are, certainly not perfectly, but reasonably negatively correlated. So a combination is indeed a good idea.

How about gold:

Gold <- getSymbols("GC=F", auto.assign = FALSE) ## Warning: GC=F contains missing values. Some functions will not work if objects ## contain missing values in the middle of the series. Consider using na.omit(), ## na.approx(), na.fill(), etc to remove or replace them. loessplot(Gold$`GC=F.Adjusted`, SP500$GSPC.Adjusted)

No correlation whatsoever! So, adding it to a portfolio is also a good idea diversification-wise.

Now for a more complicated trading-strategy based on the Nasdaq 100:

getSymbols("^NDX") # Nasdaq 100 ## [1] "^NDX" getSymbols("NUSI") # Nationwide Risk-Managed Income ETF ## [1] "NUSI" loessplot(NUSI$NUSI.Adjusted, NDX$NDX.Adjusted)

This is indeed an interesting profile: Losses are capped beyond a certain point – as are profits. The typical profile of a well-known options strategy, a so-called collar: holding an underlying, buying an out-of-the-money put option, and selling an out-of-the-money call option. Even without reading any further documents about or from this fund, we can clearly dissect their trading strategy: financial X-rays!

Let us examine another hedge fund strategy ETF:

getSymbols("QMN") # iM DBi Hedge Strategy ETF ## [1] "QMN" loessplot(QMN$QMN.Adjusted, SP500$GSPC.Adjusted)

Well, this doesn’t look too impressive: while holding this fund might be quite expensive (which I don’t know) a similar profile should also be achievable by investing just about 60% of your money in a cheap index tracker (like the one seen at the beginning of this post)!

To make our little collection complete there are of course also instruments with which you can short the market, in this case the Russell 2000-index:

Russell2000 <- getSymbols("RTY=F", auto.assign = FALSE) ## Warning: RTY=F contains missing values. Some functions will not work if objects ## contain missing values in the middle of the series. Consider using na.omit(), ## na.approx(), na.fill(), etc to remove or replace them. getSymbols("RWM") # ProShares Short Russell2000 ## [1] "RWM" loessplot(RWM$RWM.Adjusted, Russell2000$'RTY=F.Adjusted')

I will end this post with – of course – Bitcoin! As a benchmark we take the S&P 500 again:

BTC <- getSymbols("BTC-USD", auto.assign = FALSE) ## Warning: BTC-USD contains missing values. Some functions will not work if ## objects contain missing values in the middle of the series. Consider using ## na.omit(), na.approx(), na.fill(), etc to remove or replace them. loessplot(BTC$'BTC-USD.Adjusted', SP500$GSPC.Adjusted)

As you can see it is nearly uncorrelated – but not entirely. In this respect, gold seems to be a better alternative. And considering that gold will be there even if the lights go out and doesn’t have such an abysmal CO2 footprint underscores this: Bitcoin is like gold – only worse!

I hope that you find this useful and I would love if you could share some of your own analyses with us in the comments below.

The next logical step would be to consider replicating the found payoff structures, especially of high-cost hedge funds in a cost-effective manner. I published another post some time ago on how to do just that: Financial Engineering: Static Replication of any Payoff Function.

**DISCLAIMER**

*This post is written on an “as is” basis for educational purposes only and comes without any warranty. The findings and interpretations are exclusively those of the author and are not endorsed by or affiliated with any third party.*

In particular, this post provides no investment advice! No responsibility is taken whatsoever if you lose money.

*(If you gain money though I would be happy if you would buy me a coffee… that is not too much to ask, is it? )*

One problem with cryptography is that you often would like to have a shared secret key to encrypt and decrypt messages (e.g. credit card information) but you of course cannot just send the secret key to the other party *unencrypted* – now you see the problem!

We want to find a method to generated a shared secret key by only sending publicly observable information. “Impossible”, you say? No, only ingenious!

Let me start by presenting a riddle to you: say, you want to have a box with some valuables delivered to a friend of yours but you don’t trust the carrier. You and your friend are allowed to use locks but you don’t have a lock for which you and your friend have a key. You can also send the box back and forth as often as you want. What to do? Think about it for a moment, I’ll wait…

…ok, here is a possible solution: You put a lock on the box, for which only you have the key. The box is delivered to your friend. Your friend puts on another lock, for which only he has the key and sends it back to you, now with two locks on. You remove your lock and send it back to him one last time, problem solved!

The method we are going to explain is designed in a very much the same spirit. It is called “Diffie–Hellman key exchange” and was one of the first so-called *public-key protocols* and is still widely used today.

The following explanation based on mixing colours is not new but here we not only do it illustratively but demonstrate it by actually mixing colours with R!

We will use the `MixColor()`

function from the versatile `DescTools`

package (on CRAN). First we write a small helper function for mixing the colours, plotting the result and returning the RGB (Red-Green-Blue) code of the new colour:

library(DescTools) mix_col <- function(col1, col2 = col1, amount1 = 0.5, main = "") { mix_col <- MixColor(col1, col2, amount1) plot(0, type = 'n', xlim = c(0, 100), ylim = c(0, 100), axes = FALSE, xlab = "", ylab = "", main = main) rect(0, 0, 100, 100, col = mix_col) mix_col }

Both parties, traditionally called Alice and Bob, start out with their own private colour which they will keep secret:

Alices_private_col <- "red" mix_col(Alices_private_col, main = "Alice's private colour") ## [1] "#FF0000FF"

Bobs_private_col <- "blue" mix_col(Bobs_private_col, main = "Bob's private colour") ## [1] "#0000FFFF"

On top of that, we need a public colour:

public_col <- "green" mix_col(public_col, main = "Public colour") ## [1] "#00FF00FF"

Now, the fun can begin! Alice takes her private colour (red), mixes it with the public colour (green) and sends the result publicly to Bob…

(Alice2Bob <- mix_col(Alices_private_col, public_col, main = "Alice's private colour with public colour")) ## [1] "#7F7F00FF"

…and Bob takes his private colour (blue), mixes it with the public colour (green) and sends the result publicly to Alice:

(Bob2Alice <- mix_col(Bobs_private_col, public_col, main = "Bob's private colour with public colour")) ## [1] "#007F7FFF"

So far, so good. And now for the final step: Both take the colour the other party has sent them and mix it with their own private secret colour (in the ratio 2/3 to 1/3, so that all three colours share 1/3 of the total):

mix_col(Bob2Alice, Alices_private_col, amount = 2/3, main = "Shared secret colour") ## [1] "#545454FF" mix_col(Alice2Bob, Bobs_private_col, amount = 2/3, main = "Shared secret colour") ## [1] "#545454FF"

As can be seen, the result is the same secret – but now shared – colour. This method works because there is some asymmetry involved: It is easy to mix colours but very hard to undo that! Even if a hostile third party, traditionally called Eve, was listening in, she couldn’t make sense of the intercepted data.

Now that you understand the general principle, as promised, for the nerd version:

We need a mathematical equivalent of our colour mixing: a function that is simple to calculate in our direction but hard in the other. Those functions indeed exist and are called *trapdoor functions*.

You don’t have to look any further than dividing a simple exponentiation by some number and only keeping the remainder (which is the modulo function, or `%%`

in R). Those numbers have to fulfil certain prerequisites like being prime and being very long random numbers but the principle is the same: simple to calculate in one direction but very hard in the other (in this case the reason is what is known under the name “discrete logarithm problem” but we won’t give any more details here).

When you have a look at the following fully documented toy example you will recognize the same principle at work as with the colours above:

Alices_private_no <- 15 Bobs_private_no <- 13 prime <- 17 # public prime generator <- 3 # public generator (Alice2Bob <- generator^Alices_private_no %% prime) # Alice selects private random number (15) and sends result (6) publicly to Bob ## [1] 6 (Bob2Alice <- generator^Bobs_private_no %% prime) # Bob selects private random number (13) and sends result (12) publicly to Alice ## [1] 12 # shared secret key Bob2Alice^Alices_private_no %% prime # Alice takes Bob's public result (12), raises it to her private random number (15) modulo the public prime number (17) ## [1] 10 Alice2Bob^Bobs_private_no %% prime # Bob takes Alice's public result (6), raises it to his private random number (13) modulo the public prime number (17) ## [1] 10

Fascinating, isn’t it? And now you can understand the principle behind this foundational technology!

Let me end this post with a well-kept secret about nerds:

]]>A short one for today: in this post we will learn how to easily create

We have covered bits of code that I contributed to Rosetta Code on this blog before (see Category: Rosetta Code). This time we want to solve the following task:

Truth table

A truth table is a display of the inputs to, and the output of a Boolean function organized as a table where each row gives one combination of input values and the corresponding value of the function.

Task

- Input a Boolean function from the user as a string then calculate and print a formatted truth table for the given function.

(One can assume that the user input is correct).- Print and show output for Boolean functions of two and three input variables, but any program should not be limited to that many variables in the function.
- Either reverse-polish or infix notation expressions are allowed.

The core of a truth table is a permutation of all `TRUE`

and `FALSE`

statements for all variables (= letters), which we extract from a Boolean function `x`

. Fortunately, we created such a permutation function a few posts ago (see Learning R: Permutations and Combinations with Base R), so that we can adapt it accordingly: `expand.grid(rep(list(c(FALSE, TRUE)), length(vars)))`

. We then add another column with the resulting evaluation of the Boolean function and return the resulting table:

truth_table <- function(x) { vars <- unique(unlist(strsplit(x, "[^a-zA-Z]+"))) vars <- vars[vars != ""] perm <- expand.grid(rep(list(c(FALSE, TRUE)), length(vars))) names(perm) <- vars perm[ , x] <- with(perm, eval(parse(text = x))) perm }

Now, let us try some examples:

"%^%" <- xor # define unary xor operator truth_table("!A") # not ## A !A ## 1 FALSE TRUE ## 2 TRUE FALSE truth_table("A | B") # or ## A B A | B ## 1 FALSE FALSE FALSE ## 2 TRUE FALSE TRUE ## 3 FALSE TRUE TRUE ## 4 TRUE TRUE TRUE truth_table("A & B") # and ## A B A & B ## 1 FALSE FALSE FALSE ## 2 TRUE FALSE FALSE ## 3 FALSE TRUE FALSE ## 4 TRUE TRUE TRUE truth_table("A %^% B") # xor ## A B A %^% B ## 1 FALSE FALSE FALSE ## 2 TRUE FALSE TRUE ## 3 FALSE TRUE TRUE ## 4 TRUE TRUE FALSE truth_table("S | (T %^% U)") # 3 variables with brackets ## S T U S | (T %^% U) ## 1 FALSE FALSE FALSE FALSE ## 2 TRUE FALSE FALSE TRUE ## 3 FALSE TRUE FALSE TRUE ## 4 TRUE TRUE FALSE TRUE ## 5 FALSE FALSE TRUE TRUE ## 6 TRUE FALSE TRUE TRUE ## 7 FALSE TRUE TRUE FALSE ## 8 TRUE TRUE TRUE TRUE truth_table("A %^% (B %^% (C %^% D))") # 4 variables with nested brackets ## A B C D A %^% (B %^% (C %^% D)) ## 1 FALSE FALSE FALSE FALSE FALSE ## 2 TRUE FALSE FALSE FALSE TRUE ## 3 FALSE TRUE FALSE FALSE TRUE ## 4 TRUE TRUE FALSE FALSE FALSE ## 5 FALSE FALSE TRUE FALSE TRUE ## 6 TRUE FALSE TRUE FALSE FALSE ## 7 FALSE TRUE TRUE FALSE FALSE ## 8 TRUE TRUE TRUE FALSE TRUE ## 9 FALSE FALSE FALSE TRUE TRUE ## 10 TRUE FALSE FALSE TRUE FALSE ## 11 FALSE TRUE FALSE TRUE FALSE ## 12 TRUE TRUE FALSE TRUE TRUE ## 13 FALSE FALSE TRUE TRUE FALSE ## 14 TRUE FALSE TRUE TRUE TRUE ## 15 FALSE TRUE TRUE TRUE TRUE ## 16 TRUE TRUE TRUE TRUE FALSE

Looks good! The full code can also be found here: Rosetta Code: Truth Table: R.

I suspect that this function will come in handy for solving further tasks in the future, so stay tuned!

]]>I sometimes joke that as an Aries I don’t believe in zodiac signs. But could there still be some pattern, e.g. in the sense that people born in spring are more prone to success than those born during the winter months?

In this post, we will provide a definitive answer with one of the most fascinating datasets I have ever encountered, so read on!

The data we will be using is from the extraordinary Pantheon project:

Pantheon is an observatory of collective memory focused on biographies with a presence in at least 15 languages in Wikipedia. We have data on more than 85,000 biographies, organized by countries, cities, occupations, and eras. Explore this data to learn about the characters that shape human culture. Pantheon began as a project at the Collective Learning group at MIT.

To test whether zodiac signs have any bearing on success we will do the following three steps:

- Load the Pantheon project data of famous people, subset all living persons born in the US and calculate their zodiac signs.
- Load the distribution of zodiac signs of all US citizens.
- Test whether there is a statistically significant difference between both distributions.

The latest Pantheon data can be loaded from here: Pantheon datasets. It is a bzip compressed comma delimited file, which can without any intermediate steps directly loaded into R:

pantheon <- read.csv("data/person_2020_update.csv.bz2", encoding = "UTF-8") data <- pantheon[pantheon$bplace_country == "United States" & pantheon$alive == TRUE, ] nrow(data) ## [1] 10106 head(data$name, 25) ## [1] "Donald Trump" "Jimmy Carter" "Sylvester Stallone" ## [4] "Hillary Clinton" "Steven Spielberg" "Martin Scorsese" ## [7] "Clint Eastwood" "Al Pacino" "Bill Gates" ## [10] "Cher" "Robert De Niro" "Morgan Freeman" ## [13] "Warren Buffett" "Jack Nicholson" "Al Gore" ## [16] "Noam Chomsky" "Danny DeVito" "Woody Allen" ## [19] "Stephen King" "Joe Biden" "Dustin Hoffman" ## [22] "Bob Dylan" "Tina Turner" "Meryl Streep" ## [25] "Bill Clinton"

We see that we get more than 10,000 famous persons from the US, where I listed the first 25.

Now for the data on the distribution of zodiac signs for the US population as a whole. You can download the file from here: distribution_zodiac_US (source).

distr_zodiac_US <- read.csv("data/distribution_zodiac_US.csv") # change path accordingly distr_zodiac_US <- structure(distr_zodiac_US$Percent.of.US.Population, names = distr_zodiac_US$Zodiac.Sign)

After having all the data available we will calculate the zodiac signs with the `DescTools`

package (on CRAN) and create a table with both distributions:

library(DescTools) birthdates <- substr(data$birthdate[nchar(data$birthdate) > 0], 6, 10) zodiac <- table(Zodiac(as.Date(birthdates, "%m-%d"))) zodiacs <- rbind(distr_zodiac_US[names(zodiac)], prop.table(zodiac)) row.names(zodiacs) <- c("whole US", "celeb US") zodiacs <- 100*zodiacs round(zodiacs, 2) ## Capricorn Aquarius Pisces Aries Taurus Gemini Cancer Leo Virgo Libra ## celeb US 8.20 6.30 9.00 8.10 8.30 9.2 8.40 7.10 9.30 8.70 ## whole US 7.54 7.56 8.75 8.72 7.74 8.7 9.01 8.97 8.49 8.63 ## Scorpio Sagittarius ## celeb US 9.40 7.30 ## whole US 8.03 7.87

We see that there are differences, e.g. there are more celebrities with the zodiac sign Leo than in the general population, but are those differences statistically significant (to understand the concept of statistical significance please see: From Coin Tosses to p-Hacking: Make Statistics Significant Again!)?

To evaluate we use perform a chi-squared goodness-of-fit test:

chisq.test(x = zodiacs["celeb US", ], p = zodiacs["whole US", ]/100) ## ## Chi-squared test for given probabilities ## ## data: zodiacs["celeb US", ] ## X-squared = 1.1756, df = 11, p-value = 0.9999

The result is crystal clear: both distributions are not statistically different (the p-value is way above the significance level of 0.05), or put another way, your zodiac sign says nothing about your success in life! The numbers don’t lie (and the stars are silent).

If you have more ideas on how to use this fantastic dataset, please let me know in the comments!

]]>This is our 101’st blog post here on

Oftentimes the different concepts of *data science*, namely *artificial intelligence (AI)*, *machine learning (ML)*, and *deep learning (DL)* are confused… so we asked the most advanced AI in the world, ** OpenAI GPT-3**, to write a guest post for us to provide some clarification on their definitions and how they are related.

We are most delighted to present this very impressive (and only slightly redacted) essay to you – enjoy!

Artificial intelligence (AI), machine learning (ML), and deep learning (DL) are related concepts that are often used interchangeably. They are also three distinct and different concepts. In this blog post, we will define artificial intelligence, machine learning, and deep learning and explain why they are all different and how they are related.

AI is a broad and complex concept that has been around for decades. AI is used to describe a concept or a system that mimics the cognitive functions of the human brain. It can be used to describe a situation where machines can act or behave in a way that mimics human behavior. AI is often used to describe a system that can learn from experience, can use knowledge to perform tasks, to reason, and to make decisions.

There are many different types of AI. For example, there are expert systems, neural networks, and fuzzy logic. In this blog post, we are going to focus on the different types of machine learning. A machine learning model is an AI system that can learn from a dataset and can make predictions or decisions based on the data (see also So, what is AI really?).

Machine learning is a subset of AI and is a method for algorithms to learn from data. It can be used to build models that can predict future behavior based on past experience. Machine learning is used to analyze large datasets and to find patterns in the data. An example of a machine learning model is a spam filter that learns to differentiate between spam and non-spam messages.

There are three different types of machine learning. Each of them is used for a different type of problem.

Supervised learning is the most common type of machine learning. It is used to find patterns in data and is used to predict future behavior based on past experience. In supervised learning, the data is split into two parts, known as the training set and the test set. The training set is used to train the model and the test set is used to evaluate the accuracy of the model.

The goal of supervised learning is to find a relationship between independent variables and dependent variables. The independent variables are the things that we know about the data. For example, the independent variables are the features that are used to describe a customer. The dependent variables are the things we want to know about the data. For example, the dependent variable is the profit made from a specific customer. The relationship between the independent variables and the dependent variables is known as the model.

Supervised learning can be used to predict the profit of a customer based on the features of the customer.

Unsupervised learning is used to find structure in the data. In unsupervised learning, there is no training set. The model is learned from the test set. It can also be used to find groups or clusters in the data or to identify anomalies in the data.

Unsupervised learning can be used to find groups of similar customers.

Reinforcement learning is a type of machine learning that is used to find good actions or decisions based on the data. Reinforcement learning is used to find an optimal action or decision that will maximize the reward. It is used to find the optimal solution to a problem. The optimal solution depends on the reward function.

Reinforcement learning can be used to optimize different types of problems. For example, it can be used to optimize a non-linear function or to find the shortest route in a network (see also Reinforcement Learning: Life is a Maze).

Deep learning is a subset of machine learning that uses artificial neural networks. Artificial neural networks are computational models that are inspired by the architecture of the human brain. They are used to develop algorithms that can learn from data (see also Understanding the Magic of Neural Networks).

Deep learning is used to build models that can classify data or find patterns in the data. Deep learning is used to perform complex tasks such as object recognition, speech recognition, and translation. Deep learning is the most popular type of machine learning.

In this blog post, we explained the difference between artificial intelligence, machine learning, and deep learning.

We also covered the three different types of machine learning (supervised learning, unsupervised learning, and reinforcement learning) and explained how they are related.

*It seems almost impossible but this whole post was really written by a very advanced AI and only slightly redacted. You won’t find it anywhere else on the internet, it is unique. I think it is fair to say that we haven’t even begun to understand the full potential of this new technology…*

My father-in-law used to write down the numbers drawn on the lottery to find patterns, especially whether some numbers were “due” because they hadn’t been drawn for a long time. He is not alone! And don’t they have a point? Shouldn’t the numbers balance after some time? Read on to find out!

The perceived paradox arises because long streaks of supposedly random events (like getting red in roulette) are extremely unlikely yet that doesn’t change the probability of the next draw. To think differently is known as the so-called *gambler’s fallacy* (a.k.a. *Monte Carlo fallacy*). Casinos even fuel this fallacy proactively by showing such statistics to draw players into their games (with so-called *hot* and *cool* numbers):

The longest streak in roulette purportedly happened in 1943 in the US when the colour red won 32 consecutive times in a row! A quick calculation shows that the probability of this happening seems to be beyond crazy:

0.5^32 [1] 2.328306e-10

So, what is going on here? For once streaks and clustering happen quite naturally in random sequences: if you got something like “red, black, red, black, red, black” and so on I would worry if there was any randomness involved at all (read more about this here: Learning Statistics: Randomness is a strange beast). The point is that *any* sequence that is defined beforehand is as probable as any other (see also my post last week: The Solution to my Viral Coin Tossing Poll). Yet streaks catch our eye, they stick out.

But there is more. Intuitively we know that “in the long run” probabilities stabilize. Basically, this is the whole idea of probabilities in the first place. On the other hand, it seems plausible that coins, dice and roulette wheels have no memory, so they cannot know how many times they showed one outcome or the other in a row. How do those two things go together?

To clarify we toss a virtual coin 50,000 times and plot the *relative deviation* from the expected value of 50% per side:

set.seed(4711) n <- 50000 x <- sample(0:1, n, replace = TRUE) s <- cumsum(x) r <- s / (1:n) # relative deviation from expected value t <- s - (1:n) / 2 plot(r, ylim = c(0.4, 0.6), type = "l", main = "Relative Deviation from Expected Value") abline(h = 0.5)

We see that the relative deviation closes in on the fifty-fifty line. This is called *law of large numbers*. One version goes:

The relative frequency stabilizes around the theoretical probability with frequently repeated random trials.

The point is that this stabilizing doesn’t occur because the probability of getting “the other” outcome increases… but indeed because it *stays the same*, at fifty-fifty in this case: the imbalance from the beginning just *fades out*!

This doesn’t say anything about the *absolute deviations* (which are the one we are betting on!):

plot(t, type = "l", main = "Absolute Deviation from Expected Value") abline(h = 0)

There are large swings with no clear tendency… and there are no “hot” nor “cool” numbers!

So in order to solve the perceived paradox we can now understand that many people confuse relative and absolute deviations! Relative deviations tend to become smaller, whereas absolute deviations don’t. The intuition that a number is “due” refers to relative deviations whereas we can only bet on absolute outcomes… and there the probability stays the same, independent of what came before!

We again end this post with a comic that gives some humorous variant of the same idea (this time from Abstruse Goose):

(as a bonus I will even give away an easter egg here: the original filename is `just_kidding_it_actually_sucked_long_before_that.png`

)

In this post I will give the solution with some background explanation, so read on!

Please have a look at the original question and the final result:

The majority (exactly 1,000 people!) got it right, all of these sequences are equally likely. But why are they? To answer probability-related questions there are basically three approaches: analytically, by simulation, or by listing all possible outcomes. We will go for the third method because the resulting set is still small enough to be efficiently handled by R, it is very intuitive, and it gives us exact results which we can then compare to the analytical solution.

Let us first define our three sequences in R and then create a big matrix with all possible sequences:

A <- c("H", "T", "H", "T", "H", "T", "H", "T", "H", "T", "T", "H", "T", "H", "H", "T", "T", "T", "H") B <- c(rep("H", 19)) C <- c(rep("H", 10), rep("T", 9)) M <- as.matrix(expand.grid(rep(list(c("H", "T")), 19))) head(M, 10) ## Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11 Var12 Var13 ## [1,] "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [2,] "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [3,] "H" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [4,] "T" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [5,] "H" "H" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [6,] "T" "H" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [7,] "H" "T" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [8,] "T" "T" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [9,] "H" "H" "H" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## [10,] "T" "H" "H" "T" "H" "H" "H" "H" "H" "H" "H" "H" "H" ## Var14 Var15 Var16 Var17 Var18 Var19 ## [1,] "H" "H" "H" "H" "H" "H" ## [2,] "H" "H" "H" "H" "H" "H" ## [3,] "H" "H" "H" "H" "H" "H" ## [4,] "H" "H" "H" "H" "H" "H" ## [5,] "H" "H" "H" "H" "H" "H" ## [6,] "H" "H" "H" "H" "H" "H" ## [7,] "H" "H" "H" "H" "H" "H" ## [8,] "H" "H" "H" "H" "H" "H" ## [9,] "H" "H" "H" "H" "H" "H" ## [10,] "H" "H" "H" "H" "H" "H" tail(M, 10) ## Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11 Var12 Var13 ## [524279,] "H" "T" "T" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524280,] "T" "T" "T" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524281,] "H" "H" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524282,] "T" "H" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524283,] "H" "T" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524284,] "T" "T" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524285,] "H" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524286,] "T" "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524287,] "H" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## [524288,] "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" "T" ## Var14 Var15 Var16 Var17 Var18 Var19 ## [524279,] "T" "T" "T" "T" "T" "T" ## [524280,] "T" "T" "T" "T" "T" "T" ## [524281,] "T" "T" "T" "T" "T" "T" ## [524282,] "T" "T" "T" "T" "T" "T" ## [524283,] "T" "T" "T" "T" "T" "T" ## [524284,] "T" "T" "T" "T" "T" "T" ## [524285,] "T" "T" "T" "T" "T" "T" ## [524286,] "T" "T" "T" "T" "T" "T" ## [524287,] "T" "T" "T" "T" "T" "T" ## [524288,] "T" "T" "T" "T" "T" "T"

We see that there are exactly 524,288 sequences. That is because there are two possibilities for the first coin times two possibilities for the second times… and so on, which give 2^19 = 524,288 sequences altogether

Now let us find out how often each sequence appears:

sum(colSums(t(M) == A) == 19) # how many possibilities are exactly equal to A ## [1] 1 sum(colSums(t(M) == B) == 19) ## [1] 1 sum(colSums(t(M) == C) == 19) ## [1] 1

Each sequence appears exactly once. The probability for each sequence therefore is…

1 / nrow(M) ## [1] 1.907349e-06

…which is exactly 1/2^19 for all three cases because the coin tosses are independent of each other.

But why do so many people, also some renowned data scientists and even colleagues of mine, chose A? My guess is that they confuse the actual sequences with some derived feature, like the sum of heads. Counting the number of heads in each sequence shows a completely different picture, which can also be derived analytically by using the binomial distribution:

tab <- rbind(counting = table(colSums(t(M) == B)), binomial = dbinom(0:19, 19, 0.5) * nrow(M)) tab ## 0 1 2 3 4 5 6 7 8 9 10 11 12 ## counting 1 19 171 969 3876 11628 27132 50388 75582 92378 92378 75582 50388 ## binomial 1 19 171 969 3876 11628 27132 50388 75582 92378 92378 75582 50388 ## 13 14 15 16 17 18 19 ## counting 27132 11628 3876 969 171 19 1 ## binomial 27132 11628 3876 969 171 19 1 barplot(tab[1, ], col = "red", main = "Distribution of Sum of Heads")

So, the probability of seeing *some mix* of “H” and “T” is much higher than seeing only heads or only tails… but “some mix” is something completely different than an *exact sequence* like A (which all have the same probability as we just saw).

The distribution suspiciously looks like a *normal distribution* and the reason for this is the *Central Limit Theorem (CLT)*, which was the topic of another post: The Central Limit Theorem (CLT): From Perfect Symmetry to the Normal Distribution.

I hope that this clarifies the issue and I look forward to your comments below.

P.S.: There might be even another misconception at play here, especially when you look at the run of heads and tails and how they change in sequence C. It has to do with the so-called *Law of Large Numbers* and will be the topic of our post next week, so stay tuned!

In 2018 the renowned scientific journal

According to this article, COMPAS uses 137 features, the authors just used two. In this post, I will up the ante by showing you how to achieve similar results using just *one simple rule* based on only *one feature* which is found *automatically in no-time* by the `OneR`

package, so read on!

Algorithms for predicting recidivism are more and more used to assess a criminal defendant’s likelihood of committing a crime, especially in the US. These predictions are used in pretrial, parole, and sentencing decisions. The article gives some background:

One widely used criminal risk assessment tool, Correctional Offender Management Profiling for Alternative Sanctions (COMPAS by the company Equivant), has been used to assess more than 1 million offenders since it was developed in 1998. The recidivism prediction component of COMPAS—the recidivism risk scale—has been in use since 2000. This software predicts a defendant’s risk of committing a misdemeanor or felony within 2 years of assessment from 137 features about an individual and the individual’s past criminal record.

For our analysis, we will use the original dataset which is provided alongside the article: BROWARD_CLEAN.csv (to get information on the different attributes extensive metadata is provided too: readme.txt). To decode and aggregate the charge-ids we use an additional file: CHARGE_ID.csv. Please download both files and change the paths in the following code accordingly:

broward <- read.csv("data/BROWARD_CLEAN.csv") # change path accordingly charges <- read.csv("data/CHARGE_ID.csv") # change path accordingly round(100 * prop.table(table(broward$compas_correct))[2], 1) # COMPAS performance ## 1 ## 65.4 data <- broward[c("race", "sex", "age", "juv_fel_count", "juv_misd_count", "priors_count", "charge_id", "charge_degree..misd.fel.", "two_year_recid")] names(data)[names(data) == "charge_degree..misd.fel."] <- "charge_degree" # rename column data$race <- as.factor(data$race) data$sex <- as.factor(data$sex) # feature engineering: create aggregate real name version out of charge_id data$charge_id <- charges[data$charge_id, 3] names(data)[names(data) == "charge_id"] <- "charge_name" data$charge_degree <- as.factor(data$charge_degree) data$two_year_recid <- as.factor(data$two_year_recid) str(data) ## 'data.frame': 7214 obs. of 9 variables: ## $ race : Factor w/ 6 levels "1","2","3","4",..: 6 2 2 2 6 6 1 6 1 1 ... ## $ sex : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 2 1 ... ## $ age : int 69 34 24 23 43 44 41 43 39 21 ... ## $ juv_fel_count : int 0 0 0 0 0 0 0 0 0 0 ... ## $ juv_misd_count: int 0 0 0 1 0 0 0 0 0 0 ... ## $ priors_count : int 0 0 4 1 2 0 14 3 0 1 ... ## $ charge_name : chr "Assault with a Deadly Weapon" "Battery" "Possession of Cocaine" "Possession of Cannabis/Marijuana" ... ## $ charge_degree : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 2 2 1 2 ... ## $ two_year_recid: Factor w/ 2 levels "0","1": 1 2 2 1 1 1 2 1 1 2 ...

Ok, so after a little bit of data wrangling and feature engineering we have a dataset with 7214 cases and 8 potential features to predict a defendant’s risk of committing a misdemeanor or felony within 2 years (more precisely `1`

in `two_year_recid`

in the last column means that the person recidivated within two years after the previous charge). We see that COMPAS gets it right about 65.4% of the time.

First, we split our dataset into a training (80%) and a test set (20%) and after that, we fire up the `OneR`

package (on CRAN):

set.seed(123) random <- sample(1:nrow(data), 0.8 * nrow(data)) data_train <- data[random, ] data_test <- data[-random, ] library(OneR) data_bin <- optbin(data_train, method = "infogain") model <- OneR(data_bin, verbose = TRUE) ## ## Attribute Accuracy ## 1 * priors_count 63.94% ## 2 charge_name 58.5% ## 3 age 57.29% ## 4 juv_misd_count 57.11% ## 5 juv_fel_count 56.56% ## 6 race 56.37% ## 7 sex 54.77% ## 7 charge_degree 54.77% ## --- ## Chosen attribute due to accuracy ## and ties method (if applicable): '*' summary(model) ## ## Call: ## OneR.data.frame(x = data_bin, verbose = TRUE) ## ## Rules: ## If priors_count = (-0.038,2] then two_year_recid = 0 ## If priors_count = (2,38] then two_year_recid = 1 ## ## Accuracy: ## 3690 of 5771 instances classified correctly (63.94%) ## ## Contingency table: ## priors_count ## two_year_recid (-0.038,2] (2,38] Sum ## 0 * 2297 864 3161 ## 1 1217 * 1393 2610 ## Sum 3514 2257 5771 ## --- ## Maximum in each column: '*' ## ## Pearson's Chi-squared test: ## X-squared = 405.93, df = 1, p-value < 2.2e-16 plot(model)

prediction <- predict(model, data_test) eval_model(prediction, data_test) ## ## Confusion matrix (absolute): ## Actual ## Prediction 0 1 Sum ## 0 590 283 873 ## 1 212 358 570 ## Sum 802 641 1443 ## ## Confusion matrix (relative): ## Actual ## Prediction 0 1 Sum ## 0 0.41 0.20 0.60 ## 1 0.15 0.25 0.40 ## Sum 0.56 0.44 1.00 ## ## Accuracy: ## 0.657 (948/1443) ## ## Error rate: ## 0.343 (495/1443) ## ## Error rate reduction (vs. base rate): ## 0.2278 (p-value = 3.218e-15)

There are several takeaways, most notable we get this simple rule:

## If priors_count = (-0.038,2] then two_year_recid = 0 ## If priors_count = (2,38] then two_year_recid = 1

It very simply states that if an offender has recidivated in the past, he/she will do so again!

With this simple rule, we achieve a better (than COMPAS) out-of-sample accuracy of 65.7%! In the science article, the authors achieved a slightly better accuracy with a logistic regression with two features (priors count and age), OneR only needs one (priors count) for that.

On top of that COMPAS is a black box, logistic regression is somewhat interpretable and only OneR gives a fully interpretable simple rule.

To summarize:

Used algorithm | No of used features | Accuracy | Interpretability | |
---|---|---|---|---|

COMPAS | proprietary | 137 | 65.4% | black box |

Linear classifier | logistic regression | 2 (priors count, age) | 66.6% | somewhat interpretable |

OneR | One Rule classifier | 1 (priors count) | 65.7% | fully interpretable |

OneR also gives us a list of the single best predictors in descending order:

## Attribute Accuracy ## 1 * priors_count 63.94% ## 2 charge_name 58.5% ## 3 age 57.29% ## 4 juv_misd_count 57.11% ## 5 juv_fel_count 56.56% ## 6 race 56.37% ## 7 sex 54.77% ## 7 charge_degree 54.77%

For the second one, `charge_name`

, it makes intuitive sense that certain charges lead to a higher recidivism rate. Let us have a look at the ones with a 100% “guarantee”:

model_charge_name <- OneR(two_year_recid ~ charge_name, data) prob_charge_name <- predict(model_charge_name, data.frame(charge_name = sort(unique(data$charge_name))), type = "prob")[ , 2] names(prob_charge_name[prob_charge_name == 1]) ## [1] "Accessory After the Fact" ## [2] "Aiding Escape" ## [3] "Aiding Prostitution" ## [4] "Bribery" ## [5] "Dealing Heroin" ## [6] "Discharging Firearm From Vehicle" ## [7] "Exhibition of a Weapon on School Property" ## [8] "Fabricating Physical Evidence" ## [9] "Insurance Fraud" ## [10] "Interference with Custody" ## [11] "Littering" ## [12] "Manslaughter" ## [13] "Obstruction of Officer with Violence" ## [14] "Possession of a Motor Vehicle with Altered Vehicle Identification Number" ## [15] "Possession of Alcohol Under 21 Years of Age" ## [16] "Possession with Intent to Sell Counterfeits" ## [17] "Principal In The First Degree" ## [18] "Providing a Contradicting Statement" ## [19] "Shooting into a Home" ## [20] "Sound Articles Over 100" ## [21] "Unauthorized Interference with a Railroad" ## [22] "Voyeurism"

When you go through the list, you will think to yourself that most of them make sense, e.g. somebody dealing with heroin or a voyeur has a very high probability of continuing to do so in the future. Now let us look at the ones with a zero probability of re-offending:

names(prob_charge_name[prob_charge_name == 0]) ## [1] "Abuse" ## [2] "Armed Burglary" ## [3] "Carrying an Open Beverage in Public" ## [4] "Causing Public Danger" ## [5] "Compulsory Education Attendance Violation" ## [6] "Computer Pornography" ## [7] "Consuming Alcoholic Beverage in Public" ## [8] "Contributing to the Delinquency Of A Minor" ## [9] "Dealing Ecstasy" ## [10] "Dealing Stolen Property" ## [11] "Disrupting a School Function" ## [12] "Elder Molestation" ## [13] "Exploitation of an Elderly Person of $20,000-$100,000" ## [14] "Failure to Obey Drivers License Restrictions" ## [15] "Failure to Obey Sex Offender Laws" ## [16] "False Information to Law Enforcement Officer During Investigation" ## [17] "Illegal Gambling" ## [18] "Interference with Traffic Control Railroad Divide" ## [19] "Intoxicated Dangering of Safety of Another" ## [20] "Money Laundering" ## [21] "Murder" ## [22] "Neglect of an Elderly Person" ## [23] "Obtaining Controlled Substance by Fraud" ## [24] "Offense Against Intellectual Property" ## [25] "Operating Motorcycle without a Valid Drivers License" ## [26] "Possession of a Tobacco Product Under 18 Years of Age" ## [27] "Possession of Child Pornography" ## [28] "Possession of Weapon on School Property" ## [29] "Purchasing a Controlled Substance" ## [30] "Refusing to Supply DNA Sample" ## [31] "Selling Counterfeit Goods" ## [32] "Sex Offender Failing to Comply with Law" ## [33] "Simulation of Legal Process" ## [34] "Unauthorized Loud Noise" ## [35] "Unlawful Disturbance" ## [36] "Unlicensed Telemarketing" ## [37] "Use of 2 Way Device to Facilitate Felony" ## [38] "Using a Computer for Child Exploitation" ## [39] "Video Voyeurism on Child"

By inspecting that list you are in for a surprise: “Murder” and “Sex Offender Failing to Comply with Law”! The list is suggesting that there is zero probability of murderers and recalcitrant sex offenders to re-offend! Taking this to the extreme the software is giving us the advice to let all of those felons go free because they won’t try anything bad in the future… what is going on here?

Well, the most probable reason is that those serious offenders don’t have a chance to commit any new crime within a two-year’s timeframe because they luckily stay in prison and don’t have a chance to re-offend!

And there you go again: this is why it is so important to have a system that is fully interpretable and not just a black box! From an algorithmic and data-based point of view, the advice makes total sense (the algorithm doesn’t know anything about crimes, murderers, sex offenders, and recidivism per se, and the data suggests this outcome) but in reality following this advice blindly would end in disaster!

As a last point let us have a look at the feature `age`

(which was also included in the logistic regression):

OneR(optbin(two_year_recid ~ age, data)) ## ## Call: ## OneR.data.frame(x = optbin(two_year_recid ~ age, data)) ## ## Rules: ## If age = (17.9,32.3] then two_year_recid = 1 ## If age = (32.3,96.1] then two_year_recid = 0 ## ## Accuracy: ## 4190 of 7214 instances classified correctly (58.08%)

This just corroborates something that has long been known in criminology: if you’re young, you’re risky.

As a final note, ongoing research seems to suggest that there is some accuracy limit of around 70%, so OneR is not too far away from this supposed barrier to predicting recidivism. Even with very sophisticated methods, there remains a huge margin of error. Humans don’t seem to be that predictable after all…

]]>We have already covered the backtesting of trading strategies in this blog (see Backtest Trading Strategies Like a Real Quant), so let us up the ante: if you want to learn how to backtest

Options trading strategies are strategies where you combine, often several, derivatives instruments to create a certain risk-return profile (more on that here: Financial Engineering: Static Replication of any Payoff Function). Often we want to know how those strategies would fare in the real world.

The problem is that real data on derivatives are hard to come by and/or very expensive. But we help ourselves with a very good proxy: *implied volatility* which is freely available for example for many indices. With that, we can use the good old *Black-Scholes model* to reasonably price options whose strikes are not too far away from the current price of the underlying.

My colleague Professor Michael Stutzer from the University of Colorado demonstrates this in his wonderful paper How Students Can Backtest Madoff’s Claims and we are going to replicate this with R (one of my postgraduate students, Niklas Paulson, was kind enough to update parts of the code which I had written some time ago).

To run the code yourself you would have to install the powerful packages `Quandl`

, `quantmod`

and `PerformanceAnalytics`

(all on CRAN). Additionally, you would have to register at quandl.com to receive your own API key (I will not show mine here for obvious reasons).

library(Quandl) ## Loading required package: xts ## Loading required package: zoo ## ## Attaching package: 'zoo' ## The following objects are masked from 'package:base': ## ## as.Date, as.Date.numeric library(quantmod) ## Loading required package: TTR ## Registered S3 method overwritten by 'quantmod': ## method from ## as.zoo.data.frame zoo ## Version 0.4-0 included new data defaults. See ?getSymbols. library(PerformanceAnalytics) ## ## Attaching package: 'PerformanceAnalytics' ## The following object is masked from 'package:graphics': ## ## legend # get your API key via free registration at quandl.com and insert here Quandl.api_key("XXX")

As an example, the paper backtests the so-called *split strike conversion* strategy (also known as a “collar”) which was allegedly pursued by Bernie Madoff’s hedge fund. We will see that this strategy would have fared quite well but unfortunately, it later turned out that Madoff didn’t pursue this strategy after all but had built up a large Ponzi scheme (for more on that: How to Catch a Thief: Unmasking Madoff’s Ponzi Scheme with Benford’s Law).

Anyway, the strategy itself is quite interesting, it consists of

- the purchase of a group or basket of equity securities that are intended to highly correlate to the S&P 100 index,
- the sale of ”out-of-the-money” S&P 100 index call options in an equivalent contract value dollar amount to the basket of equity securities, and
- the purchase of an equivalent number of “out-of-the-money” S&P 100 Index put options

First we have to load all the necessary data and transform them as needed:

# set parameters for out-of-the-money options X <- 0.04 # put 4% OOM Y <- 0.02 # call 2% OOM # calculate S_tp0 (S&P 100 beginning of the month) and S_tp1 (S&P 100 end of the month) getSymbols("^OEX", from = "1990-11-01", to = "2008-11-30", periodicity = "monthly") # values for S_tp0 and S_tp1 ## 'getSymbols' currently uses auto.assign=TRUE by default, but will ## use auto.assign=FALSE in 0.5-0. You will still be able to use ## 'loadSymbols' to automatically load data. getOption("getSymbols.env") ## and getOption("getSymbols.auto.assign") will still be checked for ## alternate defaults. ## ## This message is shown once per session and may be disabled by setting ## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details. ## [1] "^OEX" S <- coredata(OEX[ , "OEX.Adjusted"]) S_tp0 <- S[-length(S)] # remove last value -> November is only necessary as S_tp1 for October S_tp1 <- S[-1] # remove first value -> starting value of S_tp1 is equal to the end value of S_tp0 # calculate monthly sigma_t (Volatility) getSymbols("^VXO", from = "1990-11-01", to = "2008-10-31", periodicity = "monthly") # Values for implied volatility ## [1] "^VXO" sigma_t <- coredata(VXO[ , "VXO.Adjusted"]) / 100 # calculate values for r_t, see also note 5 on p. 13 yield_t <- Quandl("FRED/TB3MS", trim_start = "1990-11-01", trim_end = "2008-10-31", order = "asc") yield_t <- yield_t[ , "Value"] / 100 P_t <- 100 * (1 - 91/360 * yield_t) r_t <- 4 * log(100/P_t)

We now define the functions for the payoffs of the puts and calls as stated on page 6 of the paper…

Put_t <- function(S_tp0, X, r_t, sigma_t) { d1 <- (log(1/(1-X)) + (r_t + sigma_t^2/2) * 1/12) / (sigma_t*sqrt(1/12)) d2 <- d1 - sigma_t * sqrt(1/12) (1-X) * S_tp0 * exp(-r_t/12) * pnorm(-d2) - S_tp0 * pnorm(-d1) # pnorm is cumulative density function of normal distribution } PutPayoff_tp1 <- function(S_tp0, S_tp1, X) { pmax(0, (1-X) * S_tp0 - S_tp1) } Call_t <- function(S_tp0, Y, r_t, sigma_t) { d1 <- (log(1/(1+Y)) + (r_t + sigma_t^2/2) * 1/12) / (sigma_t * sqrt(1/12)) d2 <- d1 - sigma_t * sqrt(1/12) S_tp0 * pnorm(d1) - (1+Y) * S_tp0*exp(-r_t/12) * pnorm(d2) } CallPayout_tp1 <- function(S_tp0, S_tp1, Y) { pmax(0, S_tp1 - (1+Y) * S_tp0) }

…and finally the function for the actual return of the strike-conversion strategy, i.e. the core of the options strategy backtesting engine:

ROR_t <- function(S_tp0, S_tp1, X, Y, r_t, sigma_t) { (S_tp1 + PutPayoff_tp1(S_tp0, S_tp1, X) - CallPayout_tp1(S_tp0, S_tp1, Y)) / (S_tp0 + Put_t(S_tp0, X , r_t , sigma_t) - Call_t(S_tp0, Y, r_t, sigma_t)) }

Putting it all together and letting the actual backtest run:

strategy_return <- ROR_t(S_tp0, S_tp1, X, Y, r_t,sigma_t) - 1 benchmark_return <- (S_tp1 / S_tp0) - 1 # create a data.frame with both data and with the dates (monthly basis) months <- seq(as.Date("1990-11-1"), by = "month", length = 216) perf <- data.frame(months, strategy_return, benchmark_return) colnames(perf) <- c("months", "Strike-Conversion Strategy", "S&P 100") # create an xts out of the data frame perfxts <- xts(perf[ , -1], order.by = perf[ , 1])

We can now calculate a multitude of performance and risk statistics:

table.Stats(perfxts) ## Strike-Conversion Strategy S&P 100 ## Observations 216.0000 216.0000 ## NAs 0.0000 0.0000 ## Minimum -0.0341 -0.1459 ## Quartile 1 -0.0107 -0.0181 ## Median 0.0174 0.0098 ## Arithmetic Mean 0.0083 0.0057 ## Geometric Mean 0.0080 0.0048 ## Quartile 3 0.0273 0.0320 ## Maximum 0.0338 0.1079 ## SE Mean 0.0015 0.0029 ## LCL Mean (0.95) 0.0053 0.0000 ## UCL Mean (0.95) 0.0112 0.0115 ## Variance 0.0005 0.0018 ## Stdev 0.0222 0.0426 ## Skewness -0.6451 -0.5578 ## Kurtosis -1.0751 1.0153 table.DownsideRisk(perfxts) ## Strike-Conversion Strategy S&P 100 ## Semi Deviation 0.0175 0.0321 ## Gain Deviation 0.0085 0.0244 ## Loss Deviation 0.0110 0.0314 ## Downside Deviation (MAR=10%) 0.0176 0.0334 ## Downside Deviation (Rf=0%) 0.0131 0.0293 ## Downside Deviation (0%) 0.0131 0.0293 ## Maximum Drawdown 0.1555 0.5078 ## Historical VaR (95%) -0.0311 -0.0724 ## Historical ES (95%) -0.0323 -0.0973 ## Modified VaR (95%) -0.0325 -0.0698 ## Modified ES (95%) -0.0347 -0.1005

Interestingly enough, the strike-conversion strategy yielded about the same mean return as the returns reported by Mr. Madoff… but with much bigger volatility (a.k.a. risk).

This was one of the tricks of Madoff to lull his investors into a sense of safety by not reporting over-the-top returns but “only” manipulating the price swings. His equity curve looked like being drawn with a ruler, which is of course totally unrealistic for an investment with this level of return.

A now for the big finale, the performance summary plot, which consists of the equity curves, the monthly returns, and the drawdowns…

charts.PerformanceSummary(perfxts)

…the relative performance plot…

chart.RelativePerformance(perfxts[ , 1], perfxts[ , 2])

…and the risk-return scatterplot:

chart.RiskReturnScatter(perfxts)

As you can see, the risk-return profile of the strike-conversion strategy is much better than that of the underlying index.

With this template you will now be able to backtest different options strategies of your own, you only have to modify `ROR_t`

accordingly. I am looking forward to your insights and feedback in general in the comments.

BTW: I replicated another fascinating paper by Professor Stutzer: Parrondo’s Paradox in Finance: Combine two Losing Investments into a Winner.

**DISCLAIMER**

*This post is written on an “as is” basis for educational purposes only and comes without any warranty. The findings and interpretations are exclusively those of the author and are not endorsed by or affiliated with any third party.*

In particular, this post provides no investment advice! No responsibility is taken whatsoever if you lose money.

Wikipedia defines

A combination of losing strategies becomes a winning strategy.

If you want to learn more about this fascinating topic and see an application in finance, read on!

Please have a look at this wonderful little video by my colleague Professor Humberto Barreto from DePauw University, Indiana, based on a now-defunct app from Alexander Bogomolny of the well-known maths site “Cut the Knot”. It illustrates the general idea of Parrondo’s paradox in about 2 minutes:

Now, imagine that we could do something similar in finance: combine two losing investments into a winner! My colleague Professor Michael Stutzer from the University of Colorado published a fascinating paper which does just that: The Paradox of Diversification. We will reproduce the analytical results of the paper by simulation with real market data. You will see how super easy and intuitive this can be done in R!

In the paper Stutzer uses actual data of the stock market and builds a simple *binomial tree* model with it. Binomial trees are something like the workhorse of quantitative finance (mainly in the area of option pricing). They trace the potential price evolution in discreet up- and down-steps for n periods:

We can easily translate that into an R function which simulates a sample path for given values of `u`

, `d`

and `n`

:

binomial_tree <- function(u, d, n = 30) { prod(sample(c(1+u, 1-d), n, replace = TRUE)) }

As can be seen in Note 1 of the paper (p. 8) market conditions of 6% expected real return and 40% volatility translate into *u* = 0.46 and *d* = 0.34 (*p* is assumed to be 0.5, i.e. up and down movements with those parameters are deemed to be equally probable).

Let us simulate 10,000 sample paths for 30 years and calculate the average return. It can be argued that the *median return* is the right measure here because we are more interested in the real return of an average outcome than in a hypothetical mixture of all possible outcomes (which would be the *arithmetic mean*):

median(replicate(1e4, binomial_tree(u = 0.46, d = 0.34))) ## [1] 0.5733923

The median return of the stock market is negative (-43% as the tree always starts at 1!). With its ups and downs, it would represent the green (“flashing”) game B in the above video. Game A (“regular”) would be Treasury Bills (a so-called “risk-free” asset) with a real return rate of -10 basis points (BPS), i.e. -0.001% (negative real return because of inflation!).

We now combine both negative investment strategies by putting 50% of our money in each. At the beginning of each year we will rebalance the portfolio, so that the initial ratio is restored. We adapt *u* and *d* accordingly, rebalance the portfolio at the beginning of each of the 30 years and again simulate 10,000 sample paths:

median(replicate(1e4, binomial_tree(u = (0.46-0.001)/2, d = (0.34+0.001)/2))) ## [1] 1.343303

Indeed, we got a huge surplus of over 34% this time! *Diversification maintained by rebalancing* (a.k.a. “rebalancing premium” or “volatility pumping”) is Parrondo’s paradox in action!

**DISCLAIMER**

*This post is written on an “as is” basis for educational purposes only and comes without any warranty. The findings and interpretations are exclusively those of the author and are not endorsed by or affiliated with any third party.*

In particular, this post provides no investment advice! No responsibility is taken whatsoever if you lose money.