Lab 3 Probablity

library(tidyverse)

## Warning: package 'tibble' was built under R version 4.1.1

library(openintro)
library(dplyr)
library(tidyr)

Exercise 1

Streak Lengths

#view dataset
glimpse(kobe_basket)

## Rows: 133
## Columns: 6
## $ vs          <fct> ORL, ORL, ORL, ORL, ORL, ORL, ORL, ORL, ORL, ORL, ORL, ORL…
## $ game        <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ quarter     <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3…
## $ time        <fct> 9:47, 9:07, 8:11, 7:41, 7:03, 6:01, 4:07, 0:52, 0:00, 6:35…
## $ description <fct> Kobe Bryant makes 4-foot two point shot, Kobe Bryant misse…
## $ shot        <chr> "H", "M", "M", "H", "H", "M", "M", "M", "M", "H", "H", "H"…

kobe_basket

## # A tibble: 133 × 6
##    vs     game quarter time  description                                   shot 
##    <fct> <int> <fct>   <fct> <fct>                                         <chr>
##  1 ORL       1 1       9:47  Kobe Bryant makes 4-foot two point shot       H    
##  2 ORL       1 1       9:07  Kobe Bryant misses jumper                     M    
##  3 ORL       1 1       8:11  Kobe Bryant misses 7-foot jumper              M    
##  4 ORL       1 1       7:41  Kobe Bryant makes 16-foot jumper (Derek Fish… H    
##  5 ORL       1 1       7:03  Kobe Bryant makes driving layup               H    
##  6 ORL       1 1       6:01  Kobe Bryant misses jumper                     M    
##  7 ORL       1 1       4:07  Kobe Bryant misses 12-foot jumper             M    
##  8 ORL       1 1       0:52  Kobe Bryant misses 19-foot jumper             M    
##  9 ORL       1 1       0:00  Kobe Bryant misses layup                      M    
## 10 ORL       1 2       6:35  Kobe Bryant makes jumper                      H    
## # … with 123 more rows

#calculate kobe streak length
kobe_streak <- calc_streak(kobe_basket$shot)
kobe_streak

##    length
## 1       1
## 2       0
## 3       2
## 4       0
## 5       0
## 6       0
## 7       3
## 8       2
## 9       0
## 10      3
## 11      0
## 12      1
## 13      3
## 14      0
## 15      0
## 16      0
## 17      0
## 18      0
## 19      1
## 20      1
## 21      0
## 22      4
## 23      1
## 24      0
## 25      1
## 26      0
## 27      1
## 28      0
## 29      1
## 30      2
## 31      0
## 32      1
## 33      2
## 34      1
## 35      0
## 36      0
## 37      1
## 38      0
## 39      0
## 40      0
## 41      1
## 42      1
## 43      0
## 44      1
## 45      0
## 46      2
## 47      0
## 48      0
## 49      0
## 50      3
## 51      0
## 52      1
## 53      0
## 54      1
## 55      2
## 56      1
## 57      0
## 58      1
## 59      0
## 60      0
## 61      1
## 62      3
## 63      3
## 64      1
## 65      1
## 66      0
## 67      0
## 68      0
## 69      0
## 70      0
## 71      1
## 72      1
## 73      0
## 74      0
## 75      0
## 76      1

table(kobe_streak)

## kobe_streak
##  0  1  2  3  4 
## 39 24  6  6  1

#quick hit miss proportion calculation for kobe shots
count(kobe_basket, shot)

## # A tibble: 2 × 2
##   shot      n
##   <chr> <int>
## 1 H        58
## 2 M        75

h <- 58
m <- 75
t <- h+m
h/t

## [1] 0.4360902

m/t

## [1] 0.5639098

Hit percentage is 43.6% and miss is 56.4%

#visualizing distribution of kobe streak lengths
ggplot(data = kobe_streak, aes(x = length)) +
  geom_bar() +
  geom_text(stat='count', aes(label=..count..), vjust=-1)

Exercise 2

Independent Shooter

#simulate flipping a fair coin once
coin_outcomes <- c("heads", "tails")
sample(coin_outcomes, size = 1, replace = TRUE)

## [1] "heads"

#simulate flipping a fair coin 100 times
sim_fair_coin <- sample(coin_outcomes, size = 100, replace = TRUE)
sim_fair_coin

##   [1] "tails" "tails" "tails" "tails" "tails" "tails" "heads" "heads" "heads"
##  [10] "heads" "tails" "heads" "heads" "tails" "tails" "tails" "tails" "heads"
##  [19] "heads" "tails" "tails" "tails" "heads" "tails" "heads" "heads" "heads"
##  [28] "heads" "heads" "tails" "heads" "heads" "tails" "heads" "tails" "heads"
##  [37] "tails" "heads" "heads" "tails" "tails" "heads" "tails" "tails" "heads"
##  [46] "tails" "tails" "tails" "heads" "tails" "heads" "heads" "tails" "heads"
##  [55] "heads" "heads" "heads" "tails" "heads" "tails" "heads" "tails" "heads"
##  [64] "heads" "heads" "tails" "tails" "heads" "heads" "heads" "tails" "heads"
##  [73] "tails" "heads" "heads" "tails" "tails" "heads" "heads" "tails" "heads"
##  [82] "tails" "heads" "tails" "tails" "heads" "heads" "heads" "heads" "tails"
##  [91] "tails" "heads" "tails" "tails" "heads" "heads" "tails" "tails" "tails"
## [100] "tails"

table(sim_fair_coin)

## sim_fair_coin
## heads tails 
##    51    49

#simulate flipping an "unfair" coin with 20% heads and 80% tails probability
set.seed(1113197)
sim_unfair_coin <- sample(coin_outcomes, size = 100, replace = TRUE, prob = c(0.2, 0.8))
sim_unfair_coin

##   [1] "tails" "heads" "tails" "tails" "tails" "tails" "heads" "tails" "tails"
##  [10] "tails" "heads" "tails" "tails" "heads" "tails" "tails" "tails" "tails"
##  [19] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "heads" "tails"
##  [28] "heads" "tails" "heads" "tails" "tails" "tails" "heads" "tails" "tails"
##  [37] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "heads" "tails"
##  [46] "tails" "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [55] "heads" "tails" "tails" "heads" "tails" "tails" "heads" "heads" "tails"
##  [64] "tails" "tails" "tails" "tails" "tails" "tails" "heads" "tails" "tails"
##  [73] "tails" "tails" "tails" "heads" "tails" "tails" "tails" "tails" "heads"
##  [82] "tails" "tails" "tails" "heads" "tails" "tails" "tails" "tails" "tails"
##  [91] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
## [100] "tails"

?sample

Exercise 3

#simulating independent shooter with 50/50 probability
shot_outcomes <- c("H", "M")
sim_basket <- sample(shot_outcomes, size = 1, replace = TRUE)
sim_basket

## [1] "M"

Exercise 4

#simulating independent shooter with 45/55 probability
set.seed(1113198)
shot_outcomes <- c("H", "M")
sim_basket <- sample(shot_outcomes, size = 133, replace = TRUE, prob = c(0.45, 0.55))
sim_basket

##   [1] "H" "M" "M" "H" "H" "M" "M" "H" "M" "H" "H" "H" "M" "M" "M" "M" "M" "M"
##  [19] "H" "M" "M" "M" "M" "H" "M" "H" "M" "H" "M" "M" "M" "H" "M" "H" "M" "M"
##  [37] "M" "H" "M" "M" "M" "M" "M" "H" "H" "M" "H" "M" "M" "M" "H" "M" "H" "M"
##  [55] "M" "M" "M" "M" "M" "M" "M" "H" "H" "H" "H" "M" "H" "M" "M" "M" "M" "H"
##  [73] "H" "M" "M" "H" "M" "H" "H" "M" "M" "H" "M" "M" "M" "H" "M" "H" "M" "M"
##  [91] "H" "M" "M" "M" "M" "H" "H" "M" "H" "H" "H" "M" "M" "H" "M" "M" "M" "H"
## [109] "M" "H" "H" "H" "M" "H" "H" "M" "H" "M" "M" "H" "H" "M" "M" "M" "H" "H"
## [127] "M" "M" "H" "M" "H" "M" "H"

table(sim_basket)

## sim_basket
##  H  M 
## 53 80

#quick proportion calculations
53/133

## [1] 0.3984962

80/133

## [1] 0.6015038

Hit percentage is 39.8% and miss is 60.2%

Exercise 5

#calculate simulated streak length
sim_streak <- calc_streak(sim_basket)
sim_streak

##    length
## 1       1
## 2       0
## 3       2
## 4       0
## 5       1
## 6       3
## 7       0
## 8       0
## 9       0
## 10      0
## 11      0
## 12      1
## 13      0
## 14      0
## 15      0
## 16      1
## 17      1
## 18      1
## 19      0
## 20      0
## 21      1
## 22      1
## 23      0
## 24      0
## 25      1
## 26      0
## 27      0
## 28      0
## 29      0
## 30      2
## 31      1
## 32      0
## 33      0
## 34      1
## 35      1
## 36      0
## 37      0
## 38      0
## 39      0
## 40      0
## 41      0
## 42      0
## 43      4
## 44      1
## 45      0
## 46      0
## 47      0
## 48      2
## 49      0
## 50      1
## 51      2
## 52      0
## 53      1
## 54      0
## 55      0
## 56      1
## 57      1
## 58      0
## 59      1
## 60      0
## 61      0
## 62      0
## 63      2
## 64      3
## 65      0
## 66      1
## 67      0
## 68      0
## 69      1
## 70      3
## 71      2
## 72      1
## 73      0
## 74      2
## 75      0
## 76      0
## 77      2
## 78      0
## 79      1
## 80      1
## 81      1

Exercise 6

#visualizing distribution of simulated streak lengths
ggplot(data = sim_streak, aes(x = length, fill = length)) +
  geom_bar() +
  geom_text(stat='count', aes(label=..count..), vjust=-1)

stat(sim_streak)

##    length
## 1       1
## 2       0
## 3       2
## 4       0
## 5       1
## 6       3
## 7       0
## 8       0
## 9       0
## 10      0
## 11      0
## 12      1
## 13      0
## 14      0
## 15      0
## 16      1
## 17      1
## 18      1
## 19      0
## 20      0
## 21      1
## 22      1
## 23      0
## 24      0
## 25      1
## 26      0
## 27      0
## 28      0
## 29      0
## 30      2
## 31      1
## 32      0
## 33      0
## 34      1
## 35      1
## 36      0
## 37      0
## 38      0
## 39      0
## 40      0
## 41      0
## 42      0
## 43      4
## 44      1
## 45      0
## 46      0
## 47      0
## 48      2
## 49      0
## 50      1
## 51      2
## 52      0
## 53      1
## 54      0
## 55      0
## 56      1
## 57      1
## 58      0
## 59      1
## 60      0
## 61      0
## 62      0
## 63      2
## 64      3
## 65      0
## 66      1
## 67      0
## 68      0
## 69      1
## 70      3
## 71      2
## 72      1
## 73      0
## 74      2
## 75      0
## 76      0
## 77      2
## 78      0
## 79      1
## 80      1
## 81      1

Describe the distribution of streak lengths. What is the typical streak length for this simulated independent shooter with a 45% shooting percentage? How long is the player’s longest streak of baskets in 133 shots? Make sure to include a plot in your answer.

As you can see on the bar chart category 0 (45 count) is the most frequent/typical streak, followed by 1 (24), 2 (8), 3 (3), and 4 (1) respectively. The longest streak in the simulated 133 shots is 4.

Exercise 7

If you were to run the simulation of the independent shooter a second time, how would you expect its streak distribution to compare to the distribution from the question above? Exactly the same? Somewhat similar? Totally different? Explain your reasoning.

Without the use of the set.seed function the new sample will likely have slightly different results. Since each shot is an independent trial the probability for a hit or miss is the same, and thus would have a similar, but likely not exactly the same, result. If you ran the trial enough times the average outcome would likely match the 0.45 and 0.55 probability.

Exercise 8

How does Kobe Bryant’s distribution of streak lengths compare to the distribution of streak lengths for the simulated shooter? Using this comparison, do you have evidence that the hot hand model fits Kobe’s shooting patterns? Explain.

Kobe’s distribution of streak lengths is similar but not exactly the same as the simulated version with category 0 (39 count) being the most frequent/typical streak, followed by 1 (24), 2 (6), 3 (6), and 4 (1) respectively. The longest streak in Kobe’s 133 shots is 4.

This evidence suggests that the hot hand model does not fit Kobe’s shooting pattern as you would expect to see a higher count in the longer streak categories and potentially streak categories in excess of 4. Instead Kobe’s streak is closer to the non-hot hand model.