library(tidyverse)
library(openintro)

Look at the dataset kobe_basket from opentro

glimpse(kobe_basket)
## 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", ...

Excercise 1: What does a streak length of 1 mean, i.e. how many hits and misses are in a streak of 1? What about a streak length of 0?

Use the character variable “shot” to create a new variable

We define the length of a shooting streak to be the number of consecutive baskets made until a miss occurs.

kobe_streak <- calc_streak(kobe_basket$shot)
glimpse(kobe_streak)
## Rows: 76
## Columns: 1
## $ length <dbl> 1, 0, 2, 0, 0, 0, 3, 2, 0, 3, 0, 1, 3, 0, 0, 0, 0, 0, 1, 1, ...

**Answer: A streak length of 1 means 1 Hit (H) followed by a Miss(M); a length of O is a a string of Miss(M), until a hit occurs.

Create a distribution to examine streak lengths

kobe_streak %>% 
  ggplot() +
  geom_bar(mapping = aes(x = length))

Exercize 2: Describe the distribution of Kobe’s streak lengths from the 2009 NBA finals. What was his typical streak length? How long was his longest streak of baskets? Make sure to include the accompanying plot in your answer.

**The typical length is 0, i.e. no streak of baskets; from the plot above, his longest streak was 4.

Simulations in R

Simulate an independent basket shooter with a coin toss, where “heads” is equivalent to making a basket

coin_outcomes <- c("heads", "tails")
sim_fair_coin <- sample(coin_outcomes, size = 100, replace = TRUE)
sim_fair_coin
##   [1] "heads" "tails" "tails" "heads" "heads" "heads" "heads" "heads" "tails"
##  [10] "heads" "tails" "heads" "heads" "heads" "heads" "heads" "tails" "tails"
##  [19] "heads" "heads" "tails" "tails" "heads" "tails" "tails" "tails" "heads"
##  [28] "heads" "heads" "heads" "tails" "heads" "heads" "tails" "tails" "tails"
##  [37] "tails" "tails" "heads" "tails" "heads" "heads" "tails" "heads" "tails"
##  [46] "tails" "heads" "tails" "tails" "tails" "tails" "tails" "tails" "tails"
##  [55] "tails" "heads" "heads" "tails" "heads" "tails" "heads" "tails" "tails"
##  [64] "heads" "tails" "tails" "heads" "heads" "heads" "tails" "heads" "heads"
##  [73] "heads" "tails" "heads" "heads" "heads" "tails" "heads" "heads" "heads"
##  [82] "heads" "tails" "heads" "heads" "heads" "heads" "tails" "tails" "tails"
##  [91] "heads" "heads" "tails" "heads" "tails" "heads" "heads" "heads" "tails"
## [100] "tails"
table(sim_fair_coin)
## sim_fair_coin
## heads tails 
##    54    46

Simulate an unfair coin simulation with probability of heads at 20%

set.seed(20871)
sim_unfair_coin <- sample(coin_outcomes, size = 100, replace = TRUE, 
                          prob = c(0.2, 0.8))
table(sim_unfair_coin)
## sim_unfair_coin
## heads tails 
##    24    76

Exercise 3: In your simulation of flipping the unfair coin 100 times, how many flips came up heads? Include the code for sampling the unfair coin in your response. Since the markdown file will run the code, and generate a new sample each time you Knit it, you should also “set a seed” before you sample. Read more about setting a seed below.

**Answer: 24 heads came up after setting the seed to keep the same answer in the report when knitted. See R code immediately above.

Simulating the Independent Shooter

Exercise 4

What change needs to be made to the sample function so that it reflects a shooting percentage of 45%? Make this adjustment, then run a simulation to sample 133 shots. Assign the output of this simulation to a new object called sim_basket.

**Answer: need to change the probability of 45% rather than 50% and sample size to 133 rather than 100

basket_outcomes <- c("H", "M")
set.seed(60466)
sim_basket <- sample(basket_outcomes, size = 133, replace = TRUE, prob = c(0.45, 0.55))
table(sim_basket)
## sim_basket
##  H  M 
## 62 71

More Practice

Comparing Kobe Bryant to the Independent Shooter

Exercise 5: Using calc_streak, compute the streak lengths of sim_basket, and save the results in a data frame called sim_streak.

sim_streak <- calc_streak(sim_basket)
glimpse(sim_streak)
## Rows: 72
## Columns: 1
## $ length <dbl> 2, 1, 4, 1, 0, 0, 0, 0, 1, 0, 0, 0, 2, 1, 0, 0, 0, 1, 0, 0, ...

Exercise 6: 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.

sim_streak %>% 
  ggplot() +
  geom_bar(mapping = aes(x = length))

**Answer: Typical streak is 0, longest 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.

** Answer: Somewhat similar; it won’t be exact because basket hits will be in different order,but will still roughly be at 45%.

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.

They are similar; most are 0 length, second longest is 1, longest is 4. Even though there is some variation, there is no evidence so far of a hot hand.

LS0tDQp0aXRsZTogIkxhYiAzOiBUaGUgSG90IEhhbmQiDQphdXRob3I6ICJFbGl6YWJldGggQ2xpY2siDQpkYXRlOiAiU2VwdGVtYmVyLCAxNCAyMDIwYCINCm91dHB1dDogb3BlbmludHJvOjpsYWJfcmVwb3J0DQotLS0NCg0KYGBge3IgbG9hZC1wYWNrYWdlcywgbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShvcGVuaW50cm8pDQpgYGANCg0KIyMgTG9vayBhdCB0aGUgZGF0YXNldCBrb2JlX2Jhc2tldCBmcm9tIG9wZW50cm8NCg0KYGBge3J9DQpnbGltcHNlKGtvYmVfYmFza2V0KQ0KYGBgDQoNCiMgRXhjZXJjaXNlIDE6IFdoYXQgZG9lcyBhIHN0cmVhayBsZW5ndGggb2YgMSBtZWFuLCBpLmUuIGhvdyBtYW55IGhpdHMgYW5kIG1pc3NlcyBhcmUgaW4gYSBzdHJlYWsgb2YgMT8gV2hhdCBhYm91dCBhIHN0cmVhayBsZW5ndGggb2YgMD8NCiMjIFVzZSB0aGUgY2hhcmFjdGVyIHZhcmlhYmxlICJzaG90IiB0byBjcmVhdGUgYSBuZXcgdmFyaWFibGUNCldlIGRlZmluZSB0aGUgbGVuZ3RoIG9mIGEgc2hvb3Rpbmcgc3RyZWFrIHRvIGJlIHRoZSBudW1iZXIgb2YgY29uc2VjdXRpdmUgYmFza2V0cyBtYWRlIHVudGlsIGEgbWlzcyBvY2N1cnMuDQoNCmBgYHtyfQ0Ka29iZV9zdHJlYWsgPC0gY2FsY19zdHJlYWsoa29iZV9iYXNrZXQkc2hvdCkNCmdsaW1wc2Uoa29iZV9zdHJlYWspDQpgYGANCg0KKipBbnN3ZXI6IEEgc3RyZWFrIGxlbmd0aCBvZiAxIG1lYW5zIDEgSGl0IChIKSBmb2xsb3dlZCBieSBhIE1pc3MoTSk7IGEgbGVuZ3RoIG9mIE8gaXMgYSBhIHN0cmluZyBvZiBNaXNzKE0pLCB1bnRpbCBhIGhpdCBvY2N1cnMuDQoNCiMjIENyZWF0ZSBhIGRpc3RyaWJ1dGlvbiB0byBleGFtaW5lIHN0cmVhayBsZW5ndGhzDQoNCmBgYHtyfQ0Ka29iZV9zdHJlYWsgJT4lIA0KICBnZ3Bsb3QoKSArDQogIGdlb21fYmFyKG1hcHBpbmcgPSBhZXMoeCA9IGxlbmd0aCkpDQpgYGANCg0KIyMgRXhlcmNpemUgMjogRGVzY3JpYmUgdGhlIGRpc3RyaWJ1dGlvbiBvZiBLb2Jl4oCZcyBzdHJlYWsgbGVuZ3RocyBmcm9tIHRoZSAyMDA5IE5CQSBmaW5hbHMuIFdoYXQgd2FzIGhpcyB0eXBpY2FsIHN0cmVhayBsZW5ndGg/IEhvdyBsb25nIHdhcyBoaXMgbG9uZ2VzdCBzdHJlYWsgb2YgYmFza2V0cz8gTWFrZSBzdXJlIHRvIGluY2x1ZGUgdGhlIGFjY29tcGFueWluZyBwbG90IGluIHlvdXIgYW5zd2VyLg0KDQpgYGB7cn0NCg0KYGBgDQoNCioqVGhlIHR5cGljYWwgbGVuZ3RoIGlzIDAsIGkuZS4gbm8gc3RyZWFrIG9mIGJhc2tldHM7IGZyb20gdGhlIHBsb3QgYWJvdmUsIGhpcyBsb25nZXN0IHN0cmVhayB3YXMgNC4NCg0KDQojIyBTaW11bGF0aW9ucyBpbiBSDQpTaW11bGF0ZSBhbiBpbmRlcGVuZGVudCBiYXNrZXQgc2hvb3RlciB3aXRoIGEgY29pbiB0b3NzLCB3aGVyZSAiaGVhZHMiIGlzIGVxdWl2YWxlbnQgdG8gbWFraW5nIGEgYmFza2V0DQoNCmBgYHtyfQ0KY29pbl9vdXRjb21lcyA8LSBjKCJoZWFkcyIsICJ0YWlscyIpDQpzaW1fZmFpcl9jb2luIDwtIHNhbXBsZShjb2luX291dGNvbWVzLCBzaXplID0gMTAwLCByZXBsYWNlID0gVFJVRSkNCnNpbV9mYWlyX2NvaW4NCnRhYmxlKHNpbV9mYWlyX2NvaW4pDQpgYGANCg0KU2ltdWxhdGUgYW4gdW5mYWlyIGNvaW4gc2ltdWxhdGlvbiB3aXRoIHByb2JhYmlsaXR5IG9mIGhlYWRzIGF0IDIwJQ0KDQpgYGB7cn0NCnNldC5zZWVkKDIwODcxKQ0Kc2ltX3VuZmFpcl9jb2luIDwtIHNhbXBsZShjb2luX291dGNvbWVzLCBzaXplID0gMTAwLCByZXBsYWNlID0gVFJVRSwgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHByb2IgPSBjKDAuMiwgMC44KSkNCnRhYmxlKHNpbV91bmZhaXJfY29pbikNCmBgYA0KDQojIyBFeGVyY2lzZSAzOiBJbiB5b3VyIHNpbXVsYXRpb24gb2YgZmxpcHBpbmcgdGhlIHVuZmFpciBjb2luIDEwMCB0aW1lcywgaG93IG1hbnkgZmxpcHMgY2FtZSB1cCBoZWFkcz8gSW5jbHVkZSB0aGUgY29kZSBmb3Igc2FtcGxpbmcgdGhlIHVuZmFpciBjb2luIGluIHlvdXIgcmVzcG9uc2UuIFNpbmNlIHRoZSBtYXJrZG93biBmaWxlIHdpbGwgcnVuIHRoZSBjb2RlLCBhbmQgZ2VuZXJhdGUgYSBuZXcgc2FtcGxlIGVhY2ggdGltZSB5b3UgS25pdCBpdCwgeW91IHNob3VsZCBhbHNvIOKAnHNldCBhIHNlZWTigJ0gYmVmb3JlIHlvdSBzYW1wbGUuIFJlYWQgbW9yZSBhYm91dCBzZXR0aW5nIGEgc2VlZCBiZWxvdy4NCg0KKipBbnN3ZXI6IDI0IGhlYWRzIGNhbWUgdXAgYWZ0ZXIgc2V0dGluZyB0aGUgc2VlZCB0byBrZWVwIHRoZSBzYW1lIGFuc3dlciBpbiB0aGUgcmVwb3J0IHdoZW4ga25pdHRlZC4gIFNlZSBSIGNvZGUgaW1tZWRpYXRlbHkgYWJvdmUuDQoNCiMgU2ltdWxhdGluZyB0aGUgSW5kZXBlbmRlbnQgU2hvb3Rlcg0KDQojIyBFeGVyY2lzZSA0DQpXaGF0IGNoYW5nZSBuZWVkcyB0byBiZSBtYWRlIHRvIHRoZSBzYW1wbGUgZnVuY3Rpb24gc28gdGhhdCBpdCByZWZsZWN0cyBhIHNob290aW5nIHBlcmNlbnRhZ2Ugb2YgNDUlPyBNYWtlIHRoaXMgYWRqdXN0bWVudCwgdGhlbiBydW4gYSBzaW11bGF0aW9uIHRvIHNhbXBsZSAxMzMgc2hvdHMuIEFzc2lnbiB0aGUgb3V0cHV0IG9mIHRoaXMgc2ltdWxhdGlvbiB0byBhIG5ldyBvYmplY3QgY2FsbGVkIHNpbV9iYXNrZXQuDQoNCioqQW5zd2VyOiBuZWVkIHRvIGNoYW5nZSB0aGUgcHJvYmFiaWxpdHkgb2YgNDUlIHJhdGhlciB0aGFuIDUwJSBhbmQgc2FtcGxlIHNpemUgdG8gMTMzIHJhdGhlciB0aGFuIDEwMA0KDQpgYGB7cn0NCmJhc2tldF9vdXRjb21lcyA8LSBjKCJIIiwgIk0iKQ0Kc2V0LnNlZWQoNjA0NjYpDQpzaW1fYmFza2V0IDwtIHNhbXBsZShiYXNrZXRfb3V0Y29tZXMsIHNpemUgPSAxMzMsIHJlcGxhY2UgPSBUUlVFLCBwcm9iID0gYygwLjQ1LCAwLjU1KSkNCnRhYmxlKHNpbV9iYXNrZXQpDQpgYGANCg0KIyBNb3JlIFByYWN0aWNlDQoNCiMjIENvbXBhcmluZyBLb2JlIEJyeWFudCB0byB0aGUgSW5kZXBlbmRlbnQgU2hvb3Rlcg0KDQojIyBFeGVyY2lzZSA1OiBVc2luZyBjYWxjX3N0cmVhaywgY29tcHV0ZSB0aGUgc3RyZWFrIGxlbmd0aHMgb2Ygc2ltX2Jhc2tldCwgYW5kIHNhdmUgdGhlIHJlc3VsdHMgaW4gYSBkYXRhIGZyYW1lIGNhbGxlZCBzaW1fc3RyZWFrLg0KDQpgYGB7cn0NCnNpbV9zdHJlYWsgPC0gY2FsY19zdHJlYWsoc2ltX2Jhc2tldCkNCmdsaW1wc2Uoc2ltX3N0cmVhaykNCmBgYA0KDQoNCiMjIEV4ZXJjaXNlIDY6IERlc2NyaWJlIHRoZSBkaXN0cmlidXRpb24gb2Ygc3RyZWFrIGxlbmd0aHMuIFdoYXQgaXMgdGhlIHR5cGljYWwgc3RyZWFrIGxlbmd0aCBmb3IgdGhpcyBzaW11bGF0ZWQgaW5kZXBlbmRlbnQgc2hvb3RlciB3aXRoIGEgNDUlIHNob290aW5nIHBlcmNlbnRhZ2U/IEhvdyBsb25nIGlzIHRoZSBwbGF5ZXLigJlzIGxvbmdlc3Qgc3RyZWFrIG9mIGJhc2tldHMgaW4gMTMzIHNob3RzPyBNYWtlIHN1cmUgdG8gaW5jbHVkZSBhIHBsb3QgaW4geW91ciBhbnN3ZXIuDQoNCmBgYHtyfQ0Kc2ltX3N0cmVhayAlPiUgDQogIGdncGxvdCgpICsNCiAgZ2VvbV9iYXIobWFwcGluZyA9IGFlcyh4ID0gbGVuZ3RoKSkNCmBgYA0KDQoqKkFuc3dlcjogVHlwaWNhbCBzdHJlYWsgaXMgMCwgbG9uZ2VzdCBpcyA0DQoNCiMjIEV4ZXJjaXNlIDc6IElmIHlvdSB3ZXJlIHRvIHJ1biB0aGUgc2ltdWxhdGlvbiBvZiB0aGUgaW5kZXBlbmRlbnQgc2hvb3RlciBhIHNlY29uZCB0aW1lLCBob3cgd291bGQgeW91IGV4cGVjdCBpdHMgc3RyZWFrIGRpc3RyaWJ1dGlvbiB0byBjb21wYXJlIHRvIHRoZSBkaXN0cmlidXRpb24gZnJvbSB0aGUgcXVlc3Rpb24gYWJvdmU/IEV4YWN0bHkgdGhlIHNhbWU/IFNvbWV3aGF0IHNpbWlsYXI/IFRvdGFsbHkgZGlmZmVyZW50PyBFeHBsYWluIHlvdXIgcmVhc29uaW5nLg0KDQoqKiBBbnN3ZXI6IFNvbWV3aGF0IHNpbWlsYXI7IGl0IHdvbid0IGJlIGV4YWN0IGJlY2F1c2UgYmFza2V0IGhpdHMgd2lsbCBiZSBpbiBkaWZmZXJlbnQgb3JkZXIsYnV0IHdpbGwgc3RpbGwgcm91Z2hseSBiZSBhdCA0NSUuDQoNCiMjIEV4ZXJjaXNlIDg6IEhvdyBkb2VzIEtvYmUgQnJ5YW504oCZcyBkaXN0cmlidXRpb24gb2Ygc3RyZWFrIGxlbmd0aHMgY29tcGFyZSB0byB0aGUgZGlzdHJpYnV0aW9uIG9mIHN0cmVhayBsZW5ndGhzIGZvciB0aGUgc2ltdWxhdGVkIHNob290ZXI/IFVzaW5nIHRoaXMgY29tcGFyaXNvbiwgZG8geW91IGhhdmUgZXZpZGVuY2UgdGhhdCB0aGUgaG90IGhhbmQgbW9kZWwgZml0cyBLb2Jl4oCZcyBzaG9vdGluZyBwYXR0ZXJucz8gRXhwbGFpbi4NCg0KVGhleSBhcmUgc2ltaWxhcjsgbW9zdCBhcmUgMCBsZW5ndGgsIHNlY29uZCBsb25nZXN0IGlzIDEsIGxvbmdlc3QgaXMgNC4gRXZlbiB0aG91Z2ggdGhlcmUgaXMgc29tZSB2YXJpYXRpb24sIHRoZXJlIGlzIG5vIGV2aWRlbmNlIHNvIGZhciBvZiBhICBob3QgaGFuZC4=