discussion8

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggplot2)

In this problem, we’re given a discrete probability distribution for the change in price of a particular stock. The stock price changes and probabilities for the distribution \(p_x\) are given as follows:

-1: 1/4 0: 1/2 1: 1/8 2: 1/8

The change in stock price over two days is given by the sum of the two discrete outcomes, and the probability of that outcome is given by the product of the individual probability of each outcomes. We can calculate the probability of each joint outcome iteratively using a nested loop:

#The probabilities of each outcome over each of the two days
p_1 <- c(1/4, 1/2, 1/8, 1/8)
p_2 <- c(1/4, 1/2, 1/8, 1/8)

#The net stock change over each of the two days
c_1 <- c(-1,0,1,2)
c_2 <- c(-1,0,1,2)

#the total stock change over two days, and the probability of each change
#running through the first set of probabilities and results

outcomes <- c()
probabilities <- c()

#loop through first run
for (i in 1:4) {
  #loop through second run
  for (j in 1:4) {
    outcome <- c_1[i] * c_2[j]
    prob <- p_1[i] * p_2[j]
    
    outcomes <- c(outcomes, outcome)
    probabilities <- c(probabilities, prob)
  }
}

#The resulting data frame consists of all possible outcomes and their probabilities.
df_prob <- data.frame('outcome'=outcomes,
           'probability'=probabilities)

#There are duplicate outcomes, which we can group by summing
df_prob_final <- df_prob %>%
  group_by(outcome) %>%
  summarise(sum(probability))

#As a check, we can confirm that the total probabilities for our distribution equal 1
df_prob_final$`sum(probability)` %>%
  sum()

## [1] 1

#lastly, we can graph our distribution:

ggplot(df_prob_final, aes(x = outcome, y = `sum(probability)`)) + 
  geom_bar(stat = "identity") +
  xlab("Outcomes") + 
  ylab("Probability") +
  ggtitle("Discrete Probability Distribution") +
  theme_minimal()

It appears the chance of no net change after 2 days is very high, owing the relatively high probability of 0 change any particular day, and the multiple opportunities to net out at 0 (-1 then 1, or 1 then -1).