Case-scenario 1
This is the fourth season of outfielder Luis Robert with the Chicago
White Socks. If during the first three seasons he hit 11, 13, and 12
home runs, how many does he need on this season for his overall average
to be at least 20?
# Home-runs so far
HR_before <- c(11, 13, 12)
# Average Number of Home-runs per season wanted
wanted_HR <- 20
# Number of seasons
n_seasons <- 4
# Needed Home-runs on season 4
x_4 <- n_seasons*wanted_HR - sum(HR_before)
# Minimum number of Home-runs needed by Robert
x_4
[1] 44
Question 1* Now, you must complete the
problem below which represents a similar case scenario. You may use the
steps that we executed in Case-scenario 1 as a template for your
solution.
This is the sixth season of outfielder Juan Soto in the majors. If
during the first five seasons he received 79, 108,41,145, and 135 walks,
how many does he need on this season for his overall number of walks per
season to be at least 100?
Soto_walks_before <- c(79, 108, 41,145,135)
# Average Number of Home-runs per season wanted
wanted_HR <- 100
# Number of seasons
n_soto_seasons <- 6
# Needed Home-runs on season 4
x_walks_6 <- n_soto_seasons*wanted_HR - sum(Soto_walks_before)
# Minimum number of Home-runs needed by Robert
x_walks_6
[1] 92
Case-scenario 2 The average salary of 10 baseball
players is 72,000 dollars a week and the average salary of 4 soccer
players is 84,000. Find the mean salary of all 14 professional
players
n_1 <- 10
n_2 <- 4
y_1 <- 72000
y_2 <- 84000
# Mean salary overall
salary_ave <- (n_1*y_1 + n_2*y_2)/(n_1+n_2)
salary_ave
[1] 75428.57
**Question 2 The average salary of 7 basketball players is 102,000
dollars a week and the average salary of 9 NFL players is 91,000. Find
the mean salary of all 16 professional players
n_1 <- 7
n_2 <- 9
y_1 <- 10200
y_2 <- 91000
# Mean salary overall
salary_ave2 <- (n_1*y_1 + n_2*y_2)/(n_1+n_2)
salary_ave2
[1] 55650
# Robert's performance
Robert_HRs <- c(11, 13, 12,44)
# Find mean
mean(Robert_HRs)
[1] 20
# Find standard deviation
sd(Robert_HRs)
[1] 16.02082
sd(Robert_HRs)
[1] 16.02082
max(Robert_HRs)
[1] 44
min(Robert_HRs)
[1] 11
summary(Robert_HRs)
Min. 1st Qu. Median Mean 3rd Qu. Max.
11.00 11.75 12.50 20.00 20.75 44.00
# Sample Data
fertilizer <- factor(rep(c("A", "B", "C"), each = 5))
growth <- c(20, 21, 19, 22, 20, 30, 29, 31, 30, 28, 25, 24, 26, 27, 25)
# Combine into a data frame
data <- data.frame(fertilizer, growth)
# Perform ANOVA
anova_result <- aov(growth ~ fertilizer, data = data)
summary(anova_result)
Df Sum Sq Mean Sq F value Pr(>F)
fertilizer 2 212.1 106.1 81.59 1.03e-07 ***
Residuals 12 15.6 1.3
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
# Tukey's HSD post-hoc test
tukey_result <- TukeyHSD(anova_result)
print(tukey_result)
Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = growth ~ fertilizer, data = data)
$fertilizer
diff lwr upr p adj
B-A 9.2 7.276176 11.123824 0.0000001
C-A 5.0 3.076176 6.923824 0.0000434
C-B -4.2 -6.123824 -2.276176 0.0002227
# Optional: Plot the results
plot(tukey_result)

Case-scenario 3 The frequency distribution below lists the number of
active players in the Barclays Premier League and the time left in their
contract.
Years Number of players 6 28 5 72 4 201 3 109 2 56 1 34 Find the
mean,the median and the standard deviation.
What percentage of the data lies within one standard deviation of the
mean?
What percentage of the data lies within two standard deviations of
the mean?
What percent of the data lies within three standard deviations of the
mean?
Draw a histogram to illustrate the data.
Solution
contract_length <- read.table("allcontracts.csv", header = TRUE, sep = ",")
contract_years <- contract_length$years
contract_length
contracts_mean <- mean(contract_years)
contracts_mean
[1] 3.458918
# Median
contracts_median <- median(contract_years)
contracts_median
[1] 3
# Find number of observations
contracts_n <- length(contract_years)
# Find standard deviation
contracts_sd <- sd(contract_years)
contracts_n
[1] 499
contracts_sd
[1] 1.69686
contracts_w1sd <- sum((contract_years - contracts_mean)/contracts_sd < 1)/ contracts_n
# Percentage of observation within one standard deviation of the mean
contracts_w1sd
[1] 0.8416834
## Difference from empirical
contracts_w1sd - 0.68
[1] 0.1616834
## Within 2 sd
contracts_w2sd <- sum((contract_years - contracts_mean)/ contracts_sd < 2)/contracts_n
contracts_w2sd
[1] 1
## Difference from empirical
contracts_w2sd - 0.95
[1] 0.05
## Within 3 sd
contracts_w3sd <- sum((contract_years - contracts_mean)/ contracts_sd < 3)/contracts_n
contracts_w3sd
[1] 1
## Difference from empirical
contracts_w3sd - 0.9973
[1] 0.0027
# Create histogram
hist(contract_years,xlab = "Years Left in Contract",col = "green",border = "red", xlim = c(0,8), ylim = c(0,225),
breaks = 5)

** Question 3 ** Use the skills learned in case scenario number 3 on
one the following data sets. You may choose only one dataset. They are
both available in Canvas.
# Create histogram
hist(contract_years,xlab = "Years Left in Contract",col = "green",border = "yellow", xlim = c(0,4), ylim = c(0,100),
breaks = 10)

LS0tCnRpdGxlOiAiSW50cm9kdWN0aW9uIHRvIFIgZm9yIFNwb3J0cyBBbmFseXRpY3MsIFBhcnQgMiAiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCioqQ2FzZS1zY2VuYXJpbyAxKioKClRoaXMgaXMgdGhlIGZvdXJ0aCBzZWFzb24gb2Ygb3V0ZmllbGRlciBMdWlzIFJvYmVydCB3aXRoIHRoZSBDaGljYWdvIFdoaXRlIFNvY2tzLiBJZiBkdXJpbmcgdGhlIGZpcnN0IHRocmVlIHNlYXNvbnMgaGUgaGl0IDExLCAxMywgYW5kIDEyIGhvbWUgcnVucywgaG93IG1hbnkgZG9lcyBoZSBuZWVkIG9uIHRoaXMgc2Vhc29uIGZvciBoaXMgb3ZlcmFsbCBhdmVyYWdlIHRvIGJlIGF0IGxlYXN0IDIwPwoKYGBge3J9CiMgSG9tZS1ydW5zIHNvIGZhcgpIUl9iZWZvcmUgPC0gYygxMSwgMTMsIDEyKQojIEF2ZXJhZ2UgTnVtYmVyIG9mIEhvbWUtcnVucyBwZXIgc2Vhc29uIHdhbnRlZAp3YW50ZWRfSFIgPC0gMjAKIyBOdW1iZXIgb2Ygc2Vhc29ucwpuX3NlYXNvbnMgPC0gNAojIE5lZWRlZCBIb21lLXJ1bnMgb24gc2Vhc29uIDQKeF80IDwtIG5fc2Vhc29ucyp3YW50ZWRfSFIgLSBzdW0oSFJfYmVmb3JlKQojIE1pbmltdW0gbnVtYmVyIG9mIEhvbWUtcnVucyBuZWVkZWQgYnkgUm9iZXJ0CnhfNApgYGAKCioqKlF1ZXN0aW9uIDEqKioqCk5vdywgeW91IG11c3QgY29tcGxldGUgdGhlIHByb2JsZW0gYmVsb3cgd2hpY2ggcmVwcmVzZW50cyBhIHNpbWlsYXIgY2FzZSBzY2VuYXJpby4gWW91IG1heSB1c2UgdGhlIHN0ZXBzIHRoYXQgd2UgZXhlY3V0ZWQgaW4gQ2FzZS1zY2VuYXJpbyAxIGFzIGEgdGVtcGxhdGUgZm9yIHlvdXIgc29sdXRpb24uCgpUaGlzIGlzIHRoZSBzaXh0aCBzZWFzb24gb2Ygb3V0ZmllbGRlciBKdWFuIFNvdG8gaW4gdGhlIG1ham9ycy4gSWYgZHVyaW5nIHRoZSBmaXJzdCBmaXZlIHNlYXNvbnMgaGUgcmVjZWl2ZWQgNzksIDEwOCw0MSwxNDUsIGFuZCAxMzUgd2Fsa3MsIGhvdyBtYW55IGRvZXMgaGUgbmVlZCBvbiB0aGlzIHNlYXNvbiBmb3IgaGlzIG92ZXJhbGwgbnVtYmVyIG9mIHdhbGtzIHBlciBzZWFzb24gdG8gYmUgYXQgbGVhc3QgMTAwPwpgYGB7cn0KClNvdG9fd2Fsa3NfYmVmb3JlICA8LSBjKDc5LCAxMDgsIDQxLDE0NSwxMzUpCiMgQXZlcmFnZSBOdW1iZXIgb2YgSG9tZS1ydW5zIHBlciBzZWFzb24gd2FudGVkCndhbnRlZF9IUiA8LSAxMDAKIyBOdW1iZXIgb2Ygc2Vhc29ucwpuX3NvdG9fc2Vhc29ucyA8LSA2CiMgTmVlZGVkIEhvbWUtcnVucyBvbiBzZWFzb24gNAp4X3dhbGtzXzYgPC0gbl9zb3RvX3NlYXNvbnMqd2FudGVkX0hSIC0gc3VtKFNvdG9fd2Fsa3NfYmVmb3JlKQojIE1pbmltdW0gbnVtYmVyIG9mIEhvbWUtcnVucyBuZWVkZWQgYnkgUm9iZXJ0Cnhfd2Fsa3NfNgpgYGAKCioqQ2FzZS1zY2VuYXJpbyAyKioKVGhlIGF2ZXJhZ2Ugc2FsYXJ5IG9mIDEwIGJhc2ViYWxsIHBsYXllcnMgaXMgNzIsMDAwIGRvbGxhcnMgYSB3ZWVrIGFuZCB0aGUgYXZlcmFnZSBzYWxhcnkgb2YgNCBzb2NjZXIgcGxheWVycyBpcyA4NCwwMDAuIEZpbmQgdGhlIG1lYW4gc2FsYXJ5IG9mIGFsbCAxNCBwcm9mZXNzaW9uYWwgcGxheWVycwoKYGBge3J9Cm5fMSA8LSAxMApuXzIgPC0gNAp5XzEgPC0gNzIwMDAKeV8yIDwtIDg0MDAwCiMgTWVhbiBzYWxhcnkgb3ZlcmFsbApzYWxhcnlfYXZlIDwtICAobl8xKnlfMSArIG5fMip5XzIpLyhuXzErbl8yKQpzYWxhcnlfYXZlCmBgYAoqKlF1ZXN0aW9uIDIKVGhlIGF2ZXJhZ2Ugc2FsYXJ5IG9mIDcgYmFza2V0YmFsbCBwbGF5ZXJzIGlzIDEwMiwwMDAgZG9sbGFycyBhIHdlZWsgYW5kIHRoZSBhdmVyYWdlIHNhbGFyeSBvZiA5IE5GTCBwbGF5ZXJzIGlzIDkxLDAwMC4gRmluZCB0aGUgbWVhbiBzYWxhcnkgb2YgYWxsIDE2IHByb2Zlc3Npb25hbCBwbGF5ZXJzCgpgYGB7cn0Kbl8xIDwtIDcKbl8yIDwtIDkKeV8xIDwtIDEwMjAwCnlfMiA8LSA5MTAwMAojIE1lYW4gc2FsYXJ5IG92ZXJhbGwKc2FsYXJ5X2F2ZTIgPC0gIChuXzEqeV8xICsgbl8yKnlfMikvKG5fMStuXzIpCnNhbGFyeV9hdmUyCmBgYAoKCmBgYHtyfQojIFJvYmVydCdzIHBlcmZvcm1hbmNlClJvYmVydF9IUnMgPC0gYygxMSwgMTMsIDEyLDQ0KQojIEZpbmQgbWVhbgptZWFuKFJvYmVydF9IUnMpCmBgYAoKYGBge3J9CiMgRmluZCBzdGFuZGFyZCBkZXZpYXRpb24Kc2QoUm9iZXJ0X0hScykKYGBgCgpgYGB7cn0Kc2QoUm9iZXJ0X0hScykKbWF4KFJvYmVydF9IUnMpCm1pbihSb2JlcnRfSFJzKQpzdW1tYXJ5KFJvYmVydF9IUnMpCmBgYAoKYGBge3J9CiMgU2FtcGxlIERhdGEKZmVydGlsaXplciA8LSBmYWN0b3IocmVwKGMoIkEiLCAiQiIsICJDIiksIGVhY2ggPSA1KSkKZ3Jvd3RoIDwtIGMoMjAsIDIxLCAxOSwgMjIsIDIwLCAzMCwgMjksIDMxLCAzMCwgMjgsIDI1LCAyNCwgMjYsIDI3LCAyNSkKCiMgQ29tYmluZSBpbnRvIGEgZGF0YSBmcmFtZQpkYXRhIDwtIGRhdGEuZnJhbWUoZmVydGlsaXplciwgZ3Jvd3RoKQoKIyBQZXJmb3JtIEFOT1ZBCmFub3ZhX3Jlc3VsdCA8LSBhb3YoZ3Jvd3RoIH4gZmVydGlsaXplciwgZGF0YSA9IGRhdGEpCnN1bW1hcnkoYW5vdmFfcmVzdWx0KQoKIyBUdWtleSdzIEhTRCBwb3N0LWhvYyB0ZXN0CnR1a2V5X3Jlc3VsdCA8LSBUdWtleUhTRChhbm92YV9yZXN1bHQpCnByaW50KHR1a2V5X3Jlc3VsdCkKCiMgT3B0aW9uYWw6IFBsb3QgdGhlIHJlc3VsdHMKcGxvdCh0dWtleV9yZXN1bHQpCgpgYGAKQ2FzZS1zY2VuYXJpbyAzClRoZSBmcmVxdWVuY3kgZGlzdHJpYnV0aW9uIGJlbG93IGxpc3RzIHRoZSBudW1iZXIgb2YgYWN0aXZlIHBsYXllcnMgaW4gdGhlIEJhcmNsYXlzIFByZW1pZXIgTGVhZ3VlIGFuZCB0aGUgdGltZSBsZWZ0IGluIHRoZWlyIGNvbnRyYWN0LgoKWWVhcnMJTnVtYmVyIG9mIHBsYXllcnMKNgkyOAo1CTcyCjQJMjAxCjMJMTA5CjIJNTYKMQkzNApGaW5kIHRoZSBtZWFuLHRoZSBtZWRpYW4gYW5kIHRoZSBzdGFuZGFyZCBkZXZpYXRpb24uCgpXaGF0IHBlcmNlbnRhZ2Ugb2YgdGhlIGRhdGEgbGllcyB3aXRoaW4gb25lIHN0YW5kYXJkIGRldmlhdGlvbiBvZiB0aGUgbWVhbj8KCldoYXQgcGVyY2VudGFnZSBvZiB0aGUgZGF0YSBsaWVzIHdpdGhpbiB0d28gc3RhbmRhcmQgZGV2aWF0aW9ucyBvZiB0aGUgbWVhbj8KCldoYXQgcGVyY2VudCBvZiB0aGUgZGF0YSBsaWVzIHdpdGhpbiB0aHJlZSBzdGFuZGFyZCBkZXZpYXRpb25zIG9mIHRoZSBtZWFuPwoKRHJhdyBhIGhpc3RvZ3JhbSB0byBpbGx1c3RyYXRlIHRoZSBkYXRhLgoKU29sdXRpb24KYGBge3J9CmNvbnRyYWN0X2xlbmd0aCA8LSByZWFkLnRhYmxlKCJhbGxjb250cmFjdHMuY3N2IiwgaGVhZGVyID0gVFJVRSwgc2VwID0gIiwiKQpjb250cmFjdF95ZWFycyA8LSBjb250cmFjdF9sZW5ndGgkeWVhcnMKY29udHJhY3RfbGVuZ3RoCmBgYApgYGB7cn0KCmBgYAoKYGBge3J9CmNvbnRyYWN0c19tZWFuICA8LSBtZWFuKGNvbnRyYWN0X3llYXJzKQpjb250cmFjdHNfbWVhbgpgYGAKCmBgYHtyfQojIE1lZGlhbgpjb250cmFjdHNfbWVkaWFuIDwtIG1lZGlhbihjb250cmFjdF95ZWFycykKY29udHJhY3RzX21lZGlhbgpgYGAKCmBgYHtyfQojIEZpbmQgbnVtYmVyIG9mIG9ic2VydmF0aW9ucwpjb250cmFjdHNfbiA8LSBsZW5ndGgoY29udHJhY3RfeWVhcnMpCiMgRmluZCBzdGFuZGFyZCBkZXZpYXRpb24KY29udHJhY3RzX3NkIDwtIHNkKGNvbnRyYWN0X3llYXJzKQpjb250cmFjdHNfbgpjb250cmFjdHNfc2QKYGBgCgoKYGBge3J9CmNvbnRyYWN0c193MXNkIDwtIHN1bSgoY29udHJhY3RfeWVhcnMgLSBjb250cmFjdHNfbWVhbikvY29udHJhY3RzX3NkIDwgMSkvIGNvbnRyYWN0c19uCiMgUGVyY2VudGFnZSBvZiBvYnNlcnZhdGlvbiB3aXRoaW4gb25lIHN0YW5kYXJkIGRldmlhdGlvbiBvZiB0aGUgbWVhbgpjb250cmFjdHNfdzFzZApgYGAKCmBgYHtyfQojIyBEaWZmZXJlbmNlIGZyb20gZW1waXJpY2FsIApjb250cmFjdHNfdzFzZCAtIDAuNjgKYGBgCgoKYGBge3J9CiMjIFdpdGhpbiAyIHNkCmNvbnRyYWN0c193MnNkIDwtIHN1bSgoY29udHJhY3RfeWVhcnMgLSBjb250cmFjdHNfbWVhbikvIGNvbnRyYWN0c19zZCA8IDIpL2NvbnRyYWN0c19uCmNvbnRyYWN0c193MnNkCmBgYAoKYGBge3J9CiMjIERpZmZlcmVuY2UgZnJvbSBlbXBpcmljYWwgCmNvbnRyYWN0c193MnNkIC0gMC45NQpgYGAKCmBgYHtyfQojIyBXaXRoaW4gMyBzZCAKY29udHJhY3RzX3czc2QgPC0gc3VtKChjb250cmFjdF95ZWFycyAtIGNvbnRyYWN0c19tZWFuKS8gY29udHJhY3RzX3NkIDwgMykvY29udHJhY3RzX24KY29udHJhY3RzX3czc2QKYGBgCgpgYGB7cn0KIyMgRGlmZmVyZW5jZSBmcm9tIGVtcGlyaWNhbCAKY29udHJhY3RzX3czc2QgLSAwLjk5NzMKYGBgCgpgYGB7cn0KIyBDcmVhdGUgaGlzdG9ncmFtCmhpc3QoY29udHJhY3RfeWVhcnMseGxhYiA9ICJZZWFycyBMZWZ0IGluIENvbnRyYWN0Iixjb2wgPSAiZ3JlZW4iLGJvcmRlciA9ICJyZWQiLCB4bGltID0gYygwLDgpLCB5bGltID0gYygwLDIyNSksCiAgIGJyZWFrcyA9IDUpCmBgYAoKCioqIFF1ZXN0aW9uIDMgKioKVXNlIHRoZSBza2lsbHMgbGVhcm5lZCBpbiBjYXNlIHNjZW5hcmlvIG51bWJlciAzIG9uIG9uZSB0aGUgZm9sbG93aW5nIGRhdGEgc2V0cy4gWW91IG1heSBjaG9vc2Ugb25seSBvbmUgZGF0YXNldC4gVGhleSBhcmUgYm90aCBhdmFpbGFibGUgaW4gQ2FudmFzLgpgYGB7cn0KIyBDcmVhdGUgaGlzdG9ncmFtCmhpc3QoY29udHJhY3RfeWVhcnMseGxhYiA9ICJZZWFycyBMZWZ0IGluIENvbnRyYWN0Iixjb2wgPSAiZ3JlZW4iLGJvcmRlciA9ICJ5ZWxsb3ciLCB4bGltID0gYygwLDQpLCB5bGltID0gYygwLDEwMCksCiAgIGJyZWFrcyA9IDEwKQpgYGAKCgo=