library(tidyverse)
library(openintro)
Exercise 1
## Rows: 133
## Columns: 6
## $ vs <fct> 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...
## $ quarter <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3...
## $ time <fct> 9:47, 9:07, 8:11, 7:41, 7:03, 6:01, 4:07, 0:52, 0:00, 6...
## $ description <fct> Kobe Bryant makes 4-foot two point shot, Kobe Bryant mi...
## $ shot <chr> "H", "M", "M", "H", "H", "M", "M", "M", "M", "H", "H", ...
A streak length of 1 means one hit/basket was made before being followed up by a consecutive miss.
A streak length of 0 means a shot resulted in a miss only with no preceding hits.
kobe_streak <- calc_streak(kobe_basket$shot)
Exercise 2
The distribution is strongly skewed to the right, suggesting that most of the shots that Kobe took in the 2009 NBA finals were misses.
His typical streak length was 0.
His longest streak of baskets was 4.
## kobe_streak
## 0 1 2 3 4
## 39 24 6 6 1
ggplot(data = kobe_streak, aes(x = length)) +
geom_bar()

Exercise 3
In my simulation, heads came up 26 times, tails came up 74 times.
coin_outcomes <- c("heads", "tails")
sim_unfair_coin <- sample(coin_outcomes, size = 100, replace = TRUE,
prob = c(0.2, 0.8))
## [1] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
## [10] "heads" "tails" "tails" "tails" "heads" "tails" "tails" "heads" "tails"
## [19] "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
## [28] "tails" "tails" "tails" "heads" "tails" "tails" "tails" "tails" "tails"
## [37] "tails" "tails" "heads" "tails" "tails" "tails" "tails" "heads" "tails"
## [46] "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
## [55] "tails" "tails" "tails" "tails" "tails" "heads" "tails" "tails" "heads"
## [64] "tails" "heads" "tails" "tails" "tails" "tails" "tails" "tails" "heads"
## [73] "tails" "tails" "tails" "tails" "heads" "tails" "tails" "tails" "tails"
## [82] "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
## [91] "tails" "tails" "heads" "tails" "heads" "tails" "tails" "tails" "tails"
## [100] "tails"
## sim_unfair_coin
## heads tails
## 15 85
Exercise 4
shot_outcomes <- c("H", "M")
sim_basket <- sample(shot_outcomes, size = 133, replace = TRUE, prob = c(0.45, 0.55))
Exercise 5
sim_streak <- calc_streak(sim_basket)
Exercise 6
The typical streak length for the simulated independent shooter is 0.
The longest streak length for the simulated independent shooter in 133 shots is 4.
## sim_streak
## 0 1 2 3 4 5 8
## 30 18 8 6 1 1 1
ggplot(data = sim_streak, aes(x = length)) +
geom_bar()

Exercise 7
I would expect to seem a similar distribution, if not the same numbers. If hit success rate is an independent 45% in each shot, then the successive shots probability/frequency will only decrease. Just taking 2 successful shots in a row - the probability decreases to 20.25% (45% x 45%). The likelihood of successful hit in a row has half the probability of making it as the one before. This plays out in the simulation data where a miss happens 44 times, a single streak 21, a 2 streak length occurs half of that at 10 occurrences, and so on.
Exercise 8
I am seeing the same rapid drop off in Kobe’s streak length as I do in the independent shooter. This suggests that the probability of consecutive hits decreases in the same way as if the shots were independent.
I am not seeing evidence of any conditional boost in streak length ‘having scored in the previous shot’. …
LS0tDQp0aXRsZTogIkxhYiAzIC0gUHJvYmFiaWxpdHkiDQphdXRob3I6ICJDYXNzaWUgQm95bGFuIg0KZGF0ZTogImByIFN5cy5EYXRlKClgIg0Kb3V0cHV0OiBvcGVuaW50cm86OmxhYl9yZXBvcnQNCi0tLQ0KDQpgYGB7ciBsb2FkLXBhY2thZ2VzLCBtZXNzYWdlPUZBTFNFfQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KG9wZW5pbnRybykNCmBgYA0KDQojIyMgRXhlcmNpc2UgMQ0KDQpgYGB7ciBjb2RlLWNodW5rLWxhYmVsfQ0KZ2xpbXBzZShrb2JlX2Jhc2tldCkNCmBgYA0KDQpBIHN0cmVhayBsZW5ndGggb2YgMSBtZWFucyBvbmUgaGl0L2Jhc2tldCB3YXMgbWFkZSBiZWZvcmUgYmVpbmcgZm9sbG93ZWQgdXAgYnkgYSBjb25zZWN1dGl2ZSBtaXNzLiAgDQogIA0KQSBzdHJlYWsgbGVuZ3RoIG9mIDAgbWVhbnMgYSBzaG90IHJlc3VsdGVkIGluIGEgbWlzcyBvbmx5IHdpdGggbm8gcHJlY2VkaW5nIGhpdHMuDQpgYGB7cn0NCmtvYmVfc3RyZWFrIDwtIGNhbGNfc3RyZWFrKGtvYmVfYmFza2V0JHNob3QpDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDINCiAgDQpUaGUgZGlzdHJpYnV0aW9uIGlzIHN0cm9uZ2x5IHNrZXdlZCB0byB0aGUgcmlnaHQsIHN1Z2dlc3RpbmcgdGhhdCBtb3N0IG9mIHRoZSBzaG90cyB0aGF0IEtvYmUgdG9vayBpbiB0aGUgMjAwOSBOQkEgZmluYWxzIHdlcmUgbWlzc2VzLg0KDQpIaXMgdHlwaWNhbCBzdHJlYWsgbGVuZ3RoIHdhcyAwLiAgDQpIaXMgbG9uZ2VzdCBzdHJlYWsgb2YgYmFza2V0cyB3YXMgNC4gIA0KDQpgYGB7cn0NCnRhYmxlKGtvYmVfc3RyZWFrKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBrb2JlX3N0cmVhaywgYWVzKHggPSBsZW5ndGgpKSArDQogIGdlb21fYmFyKCkNCmBgYA0KDQojIyMgRXhlcmNpc2UgMw0KDQpJbiBteSBzaW11bGF0aW9uLCBoZWFkcyBjYW1lIHVwIDI2IHRpbWVzLCB0YWlscyBjYW1lIHVwIDc0IHRpbWVzLg0KDQpgYGB7ciBzZXQtc2VlZH0NCnNldC5zZWVkKDc1MjI5KQ0KYGBgDQoNCmBgYHtyIHJ1bi11bmZhaXItY29pbi1zaW11bGF0aW9ufQ0KY29pbl9vdXRjb21lcyA8LSBjKCJoZWFkcyIsICJ0YWlscyIpDQpzaW1fdW5mYWlyX2NvaW4gPC0gc2FtcGxlKGNvaW5fb3V0Y29tZXMsIHNpemUgPSAxMDAsIHJlcGxhY2UgPSBUUlVFLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgcHJvYiA9IGMoMC4yLCAwLjgpKQ0KYGBgDQoNCmBgYHtyIHRhYnVsYXRlLXJlc3VsdHN9DQpzaW1fdW5mYWlyX2NvaW4NCnRhYmxlKHNpbV91bmZhaXJfY29pbikNCmBgYA0KDQoNCiMjIyBFeGVyY2lzZSA0DQoNCmBgYHtyfQ0Kc2hvdF9vdXRjb21lcyA8LSBjKCJIIiwgIk0iKQ0Kc2ltX2Jhc2tldCA8LSBzYW1wbGUoc2hvdF9vdXRjb21lcywgc2l6ZSA9IDEzMywgcmVwbGFjZSA9IFRSVUUsIHByb2IgPSBjKDAuNDUsIDAuNTUpKQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSA1DQoNCmBgYHtyIGNvbXB1dGUtc3RyZWFrLWxlbmd0aHN9DQpzaW1fc3RyZWFrIDwtIGNhbGNfc3RyZWFrKHNpbV9iYXNrZXQpDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDYNCg0KVGhlIHR5cGljYWwgc3RyZWFrIGxlbmd0aCBmb3IgdGhlIHNpbXVsYXRlZCBpbmRlcGVuZGVudCBzaG9vdGVyIGlzIDAuDQoNClRoZSBsb25nZXN0IHN0cmVhayBsZW5ndGggZm9yIHRoZSBzaW11bGF0ZWQgaW5kZXBlbmRlbnQgc2hvb3RlciBpbiAxMzMgc2hvdHMgaXMgNC4NCg0KYGBge3J9DQp0YWJsZShzaW1fc3RyZWFrKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGRhdGEgPSBzaW1fc3RyZWFrLCBhZXMoeCA9IGxlbmd0aCkpICsNCiAgZ2VvbV9iYXIoKQ0KYGBgDQoNCiMjIyBFeGVyY2lzZSA3DQoNCkkgd291bGQgZXhwZWN0IHRvIHNlZW0gYSBzaW1pbGFyIGRpc3RyaWJ1dGlvbiwgaWYgbm90IHRoZSBzYW1lIG51bWJlcnMuICBJZiBoaXQgc3VjY2VzcyByYXRlIGlzIGFuIGluZGVwZW5kZW50IDQ1JSBpbiBlYWNoIHNob3QsIHRoZW4gdGhlICBzdWNjZXNzaXZlIHNob3RzIHByb2JhYmlsaXR5L2ZyZXF1ZW5jeSB3aWxsIG9ubHkgZGVjcmVhc2UuICBKdXN0IHRha2luZyAyIHN1Y2Nlc3NmdWwgc2hvdHMgaW4gYSByb3cgLSB0aGUgcHJvYmFiaWxpdHkgZGVjcmVhc2VzIHRvIDIwLjI1JSAoNDUlIHggNDUlKS4gVGhlIGxpa2VsaWhvb2Qgb2Ygc3VjY2Vzc2Z1bCBoaXQgaW4gYSByb3cgaGFzIGhhbGYgdGhlIHByb2JhYmlsaXR5IG9mIG1ha2luZyBpdCBhcyB0aGUgb25lIGJlZm9yZS4gIFRoaXMgcGxheXMgb3V0IGluIHRoZSBzaW11bGF0aW9uIGRhdGEgd2hlcmUgYSBtaXNzIGhhcHBlbnMgNDQgdGltZXMsIGEgc2luZ2xlIHN0cmVhayAyMSwgYSAyIHN0cmVhayBsZW5ndGggb2NjdXJzIGhhbGYgb2YgdGhhdCBhdCAxMCBvY2N1cnJlbmNlcywgYW5kIHNvIG9uLg0KDQojIyMgRXhlcmNpc2UgOA0KDQpJIGFtIHNlZWluZyB0aGUgc2FtZSByYXBpZCBkcm9wIG9mZiBpbiBLb2JlJ3Mgc3RyZWFrIGxlbmd0aCBhcyBJIGRvIGluIHRoZSBpbmRlcGVuZGVudCBzaG9vdGVyLiAgVGhpcyBzdWdnZXN0cyB0aGF0IHRoZSBwcm9iYWJpbGl0eSBvZiBjb25zZWN1dGl2ZSBoaXRzIGRlY3JlYXNlcyBpbiB0aGUgc2FtZSB3YXkgYXMgaWYgdGhlIHNob3RzIHdlcmUgaW5kZXBlbmRlbnQuDQoNCkkgYW0gbm90IHNlZWluZyBldmlkZW5jZSBvZiBhbnkgY29uZGl0aW9uYWwgYm9vc3QgaW4gc3RyZWFrIGxlbmd0aCAnaGF2aW5nIHNjb3JlZCBpbiB0aGUgcHJldmlvdXMgc2hvdCcuDQouLi4NCg0K