Intro to R for Sports Analytics, Part 2

# 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

# Robert's performance
Robert_HRs <- c(11, 13, 12,44)
# Find mean
mean(Robert_HRs)

[1] 20

sd(Robert_HRs)

[1] 16.02082

# Find the maximum number of home-runs during the four seasons period
max(Robert_HRs)

[1] 44

# Find the minimum number of home-runs during the four seasons period
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 

#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?

# Walks so far
walks_before <- c(79, 108, 41, 145, 135)

# Average number of walks per season wanted
wanted_walks <- 100

# Number of seasons
n_seasons <- 6

# Needed walks in season 6
x_6 <- n_seasons * wanted_walks - sum(walks_before)

# Minimum number of walks needed by Soto
x_6

[1] 92

# Soto's performance
Soto_walks <- c(79, 108, 41, 145, 135, 92)

# Find mean
mean(Soto_walks)

[1] 100

#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

##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.
#Total for basketball players: 7 × 102,000 = 714,000
#Total for football players: 9 × 91,000 = 819,000
#Combined: (714,000 + 819,000) / 16 = 1,533,000 / 16 = 95,812.50

n_1 <- 7        # number of basketball players
n_2 <- 9        # number of NFL players
y_1 <- 102000   # mean basketball salary
y_2 <- 91000    # mean NFL salary

# Mean salary overall
salary_ave <- (n_1*y_1 + n_2*y_2)/(n_1 + n_2)
salary_ave

[1] 95812.5

#So the mean weekly salary of all 16 players is $95,812.50. The salary lands closer to 91,000 than to 102,000, that’s because the football group is bigger (9 players vs. 7), so it pulls the combined average toward its side.

contract_length <- read.table("allcontracts.csv", header = TRUE, sep = ",")
contract_years <- contract_length$years

# Mean 
contracts_mean  <- mean(contract_years)
contracts_mean

[1] 3.458918

#2. What percentage of the data lies within one standard deviation of the mean?

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

# 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)

## 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.

doubles <- read.table("doubles_hit.csv", header = TRUE, sep = ",")
doublesnumber <- doubles$doubles_hit

doubles_mean <- mean(doublesnumber)
doubles_mean

[1] 23.55

# Number of observations
doubles_n <- length(doublesnumber)

# Standard deviation
doubles_sd <- sd(doublesnumber)
doubles_sd

[1] 13.37371

# Within 1 sd
doubles_w1sd <- sum((doublesnumber - doubles_mean)/doubles_sd < 1)/doubles_n
doubles_w1sd

[1] 0.79

## Difference from empirical
doubles_w1sd - 0.68

[1] 0.11

# Within 2 sd
doubles_w2sd <- sum((doublesnumber - doubles_mean)/doubles_sd < 2)/doubles_n
doubles_w2sd

[1] 1

## Difference from empirical
doubles_w2sd - 0.95

[1] 0.05

# Within 3 sd
doubles_w3sd <- sum((doublesnumber - doubles_mean)/doubles_sd < 3)/doubles_n
doubles_w3sd

[1] 1

## Difference from empirical
doubles_w3sd - 0.9973

[1] 0.0027

hist(doublesnumber,
     xlab = "Number of Doubles",
     col = "green",
     border = "red",
     xlim = c(0, 50),
     ylim = c(0, 30),
     breaks = 5)

#The histogram shows a roughly uniform distribution of doubles from 0 to 40, with a noticeably smaller group of players reaching 40–50. The distribution is approximately symmetric (mean ≈ median) but not bell-shaped, which explains why the observed percentages deviate from the empirical rule’s predictions.