library(tidyverse)
library(openintro)

The Hot Hand

Exercise 1

Streak length of 1 mean the streak contained 1 hit and 1 miss. Streak of 0 mean the streak contained 0 hit and 1 miss.

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_streak <- calc_streak(kobe_basket$shot)
ggplot(data = kobe_streak, aes(x = length)) +
  geom_bar()

### Exercise 2

The distribution of Kobe’s streak lengths from the 2009 NBA finals is unimodel (have a single prominent peak) and right skewed. His typical streak length is 0. The IQR of the distribution is 1. His longest streak of baskets of lenth 4.

Simulations in R

coin_outcomes <- c("heads", "tails")
sample(coin_outcomes, size = 1, replace = TRUE)
## [1] "heads"
sim_fair_coin <- sample(coin_outcomes, size = 100, replace = TRUE)
sim_fair_coin
##   [1] "heads" "tails" "tails" "tails" "tails" "tails" "heads" "heads" "heads"
##  [10] "tails" "tails" "tails" "heads" "tails" "heads" "heads" "tails" "tails"
##  [19] "heads" "tails" "tails" "heads" "heads" "heads" "heads" "tails" "heads"
##  [28] "tails" "tails" "tails" "tails" "tails" "heads" "tails" "tails" "heads"
##  [37] "heads" "tails" "tails" "heads" "tails" "heads" "heads" "tails" "tails"
##  [46] "heads" "heads" "heads" "tails" "tails" "tails" "heads" "heads" "tails"
##  [55] "heads" "heads" "heads" "tails" "tails" "heads" "heads" "heads" "heads"
##  [64] "heads" "tails" "heads" "heads" "tails" "heads" "tails" "heads" "tails"
##  [73] "tails" "heads" "tails" "tails" "tails" "tails" "tails" "tails" "heads"
##  [82] "heads" "tails" "heads" "heads" "tails" "heads" "tails" "heads" "tails"
##  [91] "heads" "heads" "tails" "heads" "heads" "tails" "tails" "tails" "tails"
## [100] "tails"
table(sim_fair_coin)
## sim_fair_coin
## heads tails 
##    47    53
set.seed(2022)                 # make sure to change the seed
sim_unfair_coin <- sample(coin_outcomes, size = 100, replace = TRUE, 
                          prob = c(0.2, 0.8))
sim_unfair_coin
##   [1] "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [10] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [19] "tails" "heads" "heads" "tails" "tails" "tails" "tails" "heads" "tails"
##  [28] "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [37] "heads" "tails" "heads" "tails" "tails" "tails" "tails" "tails" "heads"
##  [46] "tails" "heads" "tails" "tails" "heads" "tails" "tails" "tails" "tails"
##  [55] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [64] "heads" "tails" "heads" "tails" "tails" "tails" "tails" "heads" "heads"
##  [73] "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [82] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "heads"
##  [91] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "heads" "tails"
## [100] "tails"
table(sim_unfair_coin)
## sim_unfair_coin
## heads tails 
##    17    83

Exercise 3

sim_unfair_coin

heads tails

17 83

In the simulation of flipping the unfair coin 100 times, 17 flips came up heads,

?sample
## starting httpd help server ... done

Simulating the Independent Shooter

shot_outcomes <- c("H", "M")
sim_basket <- sample(shot_outcomes, size = 1, replace = TRUE)
shot_outcomes
## [1] "H" "M"
table(shot_outcomes)
## shot_outcomes
## H M 
## 1 1

Exercise 4

The change needs to be made to the sample function so that it reflects a shooting percentage of 45% is the H (hit) needs to be .45 and the M(miss) needs to be .55. The simulated independent shooter result With probability of hits being 45% and miss being 55% in 133 shots is 61 hits and 72 misses.

set.seed(2022)                 
sim_basket <- sample(shot_outcomes, size = 133, replace = TRUE, 
                          prob = c(0.45, 0.55))
sim_basket
##   [1] "H" "H" "M" "M" "M" "H" "M" "M" "M" "H" "M" "M" "M" "M" "H" "M" "H" "M"
##  [19] "H" "H" "H" "H" "M" "M" "M" "H" "M" "H" "M" "H" "M" "H" "M" "M" "M" "M"
##  [37] "H" "M" "H" "H" "H" "M" "H" "M" "H" "M" "H" "H" "M" "H" "M" "M" "H" "M"
##  [55] "H" "H" "M" "M" "M" "M" "M" "M" "H" "H" "M" "H" "M" "M" "M" "H" "H" "H"
##  [73] "H" "H" "H" "M" "H" "H" "M" "M" "M" "M" "H" "H" "M" "M" "M" "M" "M" "H"
##  [91] "M" "M" "H" "M" "M" "M" "M" "H" "H" "H" "H" "M" "H" "H" "H" "M" "H" "M"
## [109] "H" "H" "H" "M" "M" "M" "H" "H" "M" "H" "H" "H" "M" "M" "M" "M" "M" "H"
## [127] "H" "M" "M" "H" "M" "H" "M"
table(sim_basket)
## sim_basket
##  H  M 
## 61 72

More Practice

sim_streak <- calc_streak(sim_basket)
ggplot(data = kobe_streak, aes(x = length)) +
  geom_bar()

Exercise 5

ggplot(data = sim_streak, aes(x = length)) +
  geom_bar()

### Exercise 6

The typical streak length for this simulated independent shooter with a 45% shooting percentage is unimodel (have a single prominent peak) and right skewed, with a potentially unusual observation of an outlier at 6 streak. His typical streak length is 0. His IQR of the distribution is 1.His longest streak of baskets was 6.

Exercise 7

If I were to run the simulation of the independent shooter a second time, I would expect its streak distribution to be somewhat different compare to the distribution from the question # 4? The reason for this is the simulated independent shooter result With probability of hits being 45% and miss being 55% in 133 shots is now 69 hits and 64 misses.

sim_basket <- sample(shot_outcomes, size = 133, replace = TRUE, 
                          prob = c(0.45, 0.55))
sim_basket
##   [1] "M" "H" "M" "H" "H" "H" "H" "M" "H" "H" "M" "H" "H" "M" "H" "H" "M" "M"
##  [19] "H" "H" "H" "H" "H" "H" "M" "H" "H" "M" "H" "H" "M" "H" "H" "M" "H" "M"
##  [37] "M" "H" "M" "H" "M" "H" "M" "H" "M" "M" "M" "H" "M" "H" "M" "H" "M" "M"
##  [55] "H" "H" "H" "M" "H" "M" "H" "H" "H" "H" "M" "H" "H" "M" "M" "M" "M" "M"
##  [73] "H" "H" "M" "H" "M" "H" "M" "H" "M" "M" "M" "H" "H" "H" "M" "H" "H" "M"
##  [91] "H" "M" "M" "M" "H" "M" "M" "M" "M" "H" "H" "H" "M" "H" "H" "M" "M" "M"
## [109] "H" "H" "M" "M" "M" "M" "M" "H" "M" "M" "M" "M" "M" "H" "H" "M" "H" "H"
## [127] "M" "H" "H" "M" "H" "M" "H"
table(sim_basket)
## sim_basket
##  H  M 
## 69 64

Exercise 8

Kobe Bryant’s distribution of streak lengths compare to the distribution of streak lengths for the simulated shooter are similar. There is not enough evidence that the hot hand theory to Kobe bryants shooting data. Both have similarities that the data plots are unimodel (have a single prominent peak), both are right skewed, and both typical streak length 0, both IQR of distribution is 1. The difference is Kobe had a longest streak lengths of 4 compare to the simulate shooter longest steak lengths of 6, which is potentially unusual observation of an outlier at 6 streak. Kobe shots seem to be independent of each other.

LS0tDQp0aXRsZTogIlByb2JhYmlsaXR5Ig0KYXV0aG9yOiAiRW5pZCBSb21hbiINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCm91dHB1dDogb3BlbmludHJvOjpsYWJfcmVwb3J0DQotLS0NCg0KYGBge3IgbG9hZC1wYWNrYWdlcywgbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShvcGVuaW50cm8pDQpgYGANCg0KIyMgKipUaGUgSG90IEhhbmQqKg0KDQojIyMgRXhlcmNpc2UgMQ0KDQojIyMjIFN0cmVhayBsZW5ndGggb2YgMSBtZWFuIHRoZSBzdHJlYWsgY29udGFpbmVkIDEgaGl0IGFuZCAxIG1pc3MuIFN0cmVhayBvZiAwIG1lYW4gdGhlIHN0cmVhayBjb250YWluZWQgMCBoaXQgYW5kIDEgbWlzcy4gDQoNCmBgYHtyIGNvZGUtY2h1bmstbGFiZWx9DQpnbGltcHNlKGtvYmVfYmFza2V0KQ0KYGBgDQoNCmBgYHtyfQ0Ka29iZV9zdHJlYWsgPC0gY2FsY19zdHJlYWsoa29iZV9iYXNrZXQkc2hvdCkNCmBgYA0KDQpgYGB7cn0NCmdncGxvdChkYXRhID0ga29iZV9zdHJlYWssIGFlcyh4ID0gbGVuZ3RoKSkgKw0KICBnZW9tX2JhcigpDQpgYGANCiMjIyBFeGVyY2lzZSAyDQoNCiMjIyMgVGhlIGRpc3RyaWJ1dGlvbiBvZiBLb2Jl4oCZcyBzdHJlYWsgbGVuZ3RocyBmcm9tIHRoZSAyMDA5IE5CQSBmaW5hbHMgaXMgdW5pbW9kZWwgKGhhdmUgYSBzaW5nbGUgcHJvbWluZW50IHBlYWspIGFuZCByaWdodCBza2V3ZWQuIEhpcyB0eXBpY2FsIHN0cmVhayBsZW5ndGggaXMgMC4gVGhlIElRUiBvZiB0aGUgZGlzdHJpYnV0aW9uIGlzIDEuIEhpcyBsb25nZXN0IHN0cmVhayBvZiBiYXNrZXRzIG9mIGxlbnRoIDQuDQoNCiMjICoqU2ltdWxhdGlvbnMgaW4gUioqDQoNCmBgYHtyfQ0KY29pbl9vdXRjb21lcyA8LSBjKCJoZWFkcyIsICJ0YWlscyIpDQpzYW1wbGUoY29pbl9vdXRjb21lcywgc2l6ZSA9IDEsIHJlcGxhY2UgPSBUUlVFKQ0KYGBgDQpgYGB7cn0NCnNpbV9mYWlyX2NvaW4gPC0gc2FtcGxlKGNvaW5fb3V0Y29tZXMsIHNpemUgPSAxMDAsIHJlcGxhY2UgPSBUUlVFKQ0KYGBgDQoNCmBgYHtyfQ0Kc2ltX2ZhaXJfY29pbg0KYGBgDQoNCmBgYHtyfQ0KdGFibGUoc2ltX2ZhaXJfY29pbikNCmBgYA0KDQpgYGB7cn0NCnNldC5zZWVkKDIwMjIpICAgICAgICAgICAgICAgICAjIG1ha2Ugc3VyZSB0byBjaGFuZ2UgdGhlIHNlZWQNCnNpbV91bmZhaXJfY29pbiA8LSBzYW1wbGUoY29pbl9vdXRjb21lcywgc2l6ZSA9IDEwMCwgcmVwbGFjZSA9IFRSVUUsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICBwcm9iID0gYygwLjIsIDAuOCkpDQpgYGANCg0KYGBge3J9DQpzaW1fdW5mYWlyX2NvaW4NCmBgYA0KDQpgYGB7cn0NCnRhYmxlKHNpbV91bmZhaXJfY29pbikNCmBgYA0KDQojIyMgRXhlcmNpc2UgMw0KDQojIyMjIHNpbV91bmZhaXJfY29pbg0KIyMjIyBoZWFkcyB0YWlscyANCiMjIyMgICAxNyAgICA4MyANCiMjIyMgSW4gdGhlIHNpbXVsYXRpb24gb2YgZmxpcHBpbmcgdGhlIHVuZmFpciBjb2luIDEwMCB0aW1lcywgMTcgZmxpcHMgY2FtZSB1cCBoZWFkcywgDQoNCmBgYHtyfQ0KP3NhbXBsZQ0KYGBgDQoNCiMjICoqU2ltdWxhdGluZyB0aGUgSW5kZXBlbmRlbnQgU2hvb3RlcioqDQoNCg0KYGBge3J9DQpzaG90X291dGNvbWVzIDwtIGMoIkgiLCAiTSIpDQpzaW1fYmFza2V0IDwtIHNhbXBsZShzaG90X291dGNvbWVzLCBzaXplID0gMSwgcmVwbGFjZSA9IFRSVUUpDQpzaG90X291dGNvbWVzDQpgYGANCmBgYHtyfQ0KdGFibGUoc2hvdF9vdXRjb21lcykNCmBgYA0KDQojIyMgRXhlcmNpc2UgNA0KDQojIyMjIFRoZSBjaGFuZ2UgbmVlZHMgdG8gYmUgbWFkZSB0byB0aGUgc2FtcGxlIGZ1bmN0aW9uIHNvIHRoYXQgaXQgcmVmbGVjdHMgYSBzaG9vdGluZyBwZXJjZW50YWdlIG9mIDQ1JSBpcyB0aGUgSCAoaGl0KSBuZWVkcyB0byBiZSAuNDUgYW5kIHRoZSBNKG1pc3MpIG5lZWRzIHRvIGJlIC41NS4gVGhlIHNpbXVsYXRlZCBpbmRlcGVuZGVudCBzaG9vdGVyIHJlc3VsdCBXaXRoIHByb2JhYmlsaXR5IG9mIGhpdHMgYmVpbmcgNDUlIGFuZCBtaXNzIGJlaW5nIDU1JSBpbiAxMzMgc2hvdHMgaXMgNjEgaGl0cyBhbmQgNzIgbWlzc2VzLg0KDQpgYGB7cn0NCnNldC5zZWVkKDIwMjIpICAgICAgICAgICAgICAgICANCnNpbV9iYXNrZXQgPC0gc2FtcGxlKHNob3Rfb3V0Y29tZXMsIHNpemUgPSAxMzMsIHJlcGxhY2UgPSBUUlVFLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgcHJvYiA9IGMoMC40NSwgMC41NSkpDQpzaW1fYmFza2V0DQpgYGANCg0KYGBge3J9DQp0YWJsZShzaW1fYmFza2V0KQ0KYGBgDQoNCiMjICoqTW9yZSBQcmFjdGljZSoqDQoNCmBgYHtyfQ0Kc2ltX3N0cmVhayA8LSBjYWxjX3N0cmVhayhzaW1fYmFza2V0KQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBrb2JlX3N0cmVhaywgYWVzKHggPSBsZW5ndGgpKSArDQogIGdlb21fYmFyKCkNCmBgYA0KDQojIyMgRXhlcmNpc2UgNQ0KDQpgYGB7cn0NCmdncGxvdChkYXRhID0gc2ltX3N0cmVhaywgYWVzKHggPSBsZW5ndGgpKSArDQogIGdlb21fYmFyKCkNCmBgYA0KIyMjIEV4ZXJjaXNlIDYNCg0KIyMjIyBUaGUgdHlwaWNhbCBzdHJlYWsgbGVuZ3RoIGZvciB0aGlzIHNpbXVsYXRlZCBpbmRlcGVuZGVudCBzaG9vdGVyIHdpdGggYSA0NSUgc2hvb3RpbmcgcGVyY2VudGFnZSBpcyB1bmltb2RlbCAoaGF2ZSBhIHNpbmdsZSBwcm9taW5lbnQgcGVhaykgYW5kIHJpZ2h0IHNrZXdlZCwgd2l0aCBhIHBvdGVudGlhbGx5IHVudXN1YWwgb2JzZXJ2YXRpb24gb2YgYW4gb3V0bGllciBhdCA2IHN0cmVhay4gSGlzIHR5cGljYWwgc3RyZWFrIGxlbmd0aCBpcyAwLiBIaXMgSVFSIG9mIHRoZSBkaXN0cmlidXRpb24gaXMgMS5IaXMgbG9uZ2VzdCBzdHJlYWsgb2YgYmFza2V0cyB3YXMgNi4NCg0KIyMjIEV4ZXJjaXNlIDcNCg0KIyMjIyBJZiBJIHdlcmUgdG8gcnVuIHRoZSBzaW11bGF0aW9uIG9mIHRoZSBpbmRlcGVuZGVudCBzaG9vdGVyIGEgc2Vjb25kIHRpbWUsIEkgd291bGQgZXhwZWN0IGl0cyBzdHJlYWsgZGlzdHJpYnV0aW9uIHRvIGJlIHNvbWV3aGF0IGRpZmZlcmVudCBjb21wYXJlIHRvIHRoZSBkaXN0cmlidXRpb24gZnJvbSB0aGUgcXVlc3Rpb24gIyA0PyBUaGUgcmVhc29uIGZvciB0aGlzIGlzIHRoZSBzaW11bGF0ZWQgaW5kZXBlbmRlbnQgc2hvb3RlciByZXN1bHQgV2l0aCBwcm9iYWJpbGl0eSBvZiBoaXRzIGJlaW5nIDQ1JSBhbmQgbWlzcyBiZWluZyA1NSUgaW4gMTMzIHNob3RzIGlzIG5vdyA2OSBoaXRzIGFuZCA2NCBtaXNzZXMuDQoNCmBgYHtyfQ0Kc2ltX2Jhc2tldCA8LSBzYW1wbGUoc2hvdF9vdXRjb21lcywgc2l6ZSA9IDEzMywgcmVwbGFjZSA9IFRSVUUsIA0KICAgICAgICAgICAgICAgICAgICAgICAgICBwcm9iID0gYygwLjQ1LCAwLjU1KSkNCnNpbV9iYXNrZXQNCmBgYA0KDQpgYGB7cn0NCnRhYmxlKHNpbV9iYXNrZXQpDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDgNCg0KIyMjIyBLb2JlIEJyeWFudOKAmXMgZGlzdHJpYnV0aW9uIG9mIHN0cmVhayBsZW5ndGhzIGNvbXBhcmUgdG8gdGhlIGRpc3RyaWJ1dGlvbiBvZiBzdHJlYWsgbGVuZ3RocyBmb3IgdGhlIHNpbXVsYXRlZCBzaG9vdGVyIGFyZSBzaW1pbGFyLiBUaGVyZSBpcyBub3QgZW5vdWdoIGV2aWRlbmNlIHRoYXQgdGhlIGhvdCBoYW5kIHRoZW9yeSB0byBLb2JlIGJyeWFudHMgc2hvb3RpbmcgZGF0YS4gQm90aCBoYXZlIHNpbWlsYXJpdGllcyB0aGF0IHRoZSBkYXRhIHBsb3RzIGFyZSB1bmltb2RlbCAoaGF2ZSBhIHNpbmdsZSBwcm9taW5lbnQgcGVhayksIGJvdGggYXJlIHJpZ2h0IHNrZXdlZCwgYW5kIGJvdGggdHlwaWNhbCBzdHJlYWsgbGVuZ3RoIDAsIGJvdGggSVFSIG9mIGRpc3RyaWJ1dGlvbiBpcyAxLiBUaGUgZGlmZmVyZW5jZSBpcyBLb2JlIGhhZCBhIGxvbmdlc3Qgc3RyZWFrIGxlbmd0aHMgb2YgNCBjb21wYXJlIHRvIHRoZSBzaW11bGF0ZSBzaG9vdGVyIGxvbmdlc3Qgc3RlYWsgbGVuZ3RocyBvZiA2LCB3aGljaCBpcyBwb3RlbnRpYWxseSB1bnVzdWFsIG9ic2VydmF0aW9uIG9mIGFuIG91dGxpZXIgYXQgNiBzdHJlYWsuIEtvYmUgc2hvdHMgc2VlbSB0byBiZSBpbmRlcGVuZGVudCBvZiBlYWNoIG90aGVyLiA=