Final Project
George Miahkov
2024-12-10
options(repos = c("https://cloud.r-project.org"))
knitr::opts_chunk$set(echo = TRUE)
library(stargazer)##
## Please cite as:## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2.3. https://CRAN.R-project.org/package=stargazerlibrary(corrplot)## corrplot 0.95 loadedlibrary(car)## Loading required package: carDatalibrary(ggplot2)
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionurl <- "https://raw.githubusercontent.com/JeffSackmann/tennis_atp/master/atp_matches_2016.csv"
destination <- "atp_matches_2016.csv"
download.file(url, destfile = destination, mode = "wb")
atp_data <- read.csv(destination)
head(atp_data)## tourney_id tourney_name surface draw_size tourney_level tourney_date
## 1 2016-M020 Brisbane Hard 32 A 20160104
## 2 2016-M020 Brisbane Hard 32 A 20160104
## 3 2016-M020 Brisbane Hard 32 A 20160104
## 4 2016-M020 Brisbane Hard 32 A 20160104
## 5 2016-M020 Brisbane Hard 32 A 20160104
## 6 2016-M020 Brisbane Hard 32 A 20160104
## match_num winner_id winner_seed winner_entry winner_name winner_hand
## 1 271 105062 NA Mikhail Kukushkin R
## 2 272 103285 NA PR Radek Stepanek R
## 3 273 106071 7 Bernard Tomic R
## 4 275 104471 NA Q Ivan Dodig R
## 5 276 106298 NA Lucas Pouille R
## 6 277 105676 6 David Goffin R
## winner_ht winner_ioc winner_age loser_id loser_seed loser_entry
## 1 183 KAZ 28.0 104797 NA
## 2 185 CZE 37.1 105583 NA
## 3 193 AUS 23.2 103917 NA
## 4 183 CRO 31.0 117352 NA Q
## 5 185 FRA 21.8 106415 NA Q
## 6 180 BEL 25.0 105064 NA
## loser_name loser_hand loser_ht loser_ioc loser_age score
## 1 Denis Istomin R 188 UZB 29.3 6-2 7-5
## 2 Dusan Lajovic R 180 SRB 25.5 6-0 6-3
## 3 Nicolas Mahut R 190 FRA 33.9 6-4 6-3
## 4 Oliver Anderson U NA AUS 17.6 6-3 6-2
## 5 Yoshihito Nishioka L 170 JPN 20.2 4-6 6-3 7-5
## 6 Thomaz Bellucci L 188 BRA 28.0 6-4 6-4
## best_of round minutes w_ace w_df w_svpt w_1stIn w_1stWon w_2ndWon w_SvGms
## 1 3 R32 84 1 3 67 36 27 20 10
## 2 3 R32 67 3 2 48 25 18 16 8
## 3 3 R32 69 8 0 59 34 28 14 10
## 4 3 R32 67 11 2 49 30 24 13 9
## 5 3 R32 143 17 2 95 64 53 15 16
## 6 3 R32 82 3 4 57 30 23 16 10
## w_bpSaved w_bpFaced l_ace l_df l_svpt l_1stIn l_1stWon l_2ndWon l_SvGms
## 1 3 3 6 0 53 32 22 12 10
## 2 2 2 0 2 46 25 15 8 7
## 3 4 5 4 1 50 29 21 10 9
## 4 0 0 3 1 52 30 22 9 8
## 5 2 4 4 3 120 64 42 30 15
## 6 1 2 7 2 66 40 25 15 10
## l_bpSaved l_bpFaced winner_rank winner_rank_points loser_rank
## 1 4 7 65 762 61
## 2 4 8 197 252 76
## 3 3 6 18 1675 71
## 4 3 6 87 636 813
## 5 12 15 78 672 117
## 6 7 10 16 1880 37
## loser_rank_points
## 1 781
## 2 678
## 3 710
## 4 25
## 5 495
## 6 1105df <- atp_data- Summarizing prior work.
Data used: “atp_matches_2016.csv” This data contains about 50 types of variables, which I separated into three categories: Player info, Match Details, and Match stats.
Variables for Player info: winner_name, loser_name, winner_seed, loser_seed, etc. Variables for Match stats: winner_age, loser_age, w_ace/l_ace ‘number of aces hit by w ot l’, etc. Variables for Match details: tourney_id, tourney_name, surface (clay, hard, grass), etc.
Research questions mostly focus on specific statistical relations within the ATP matches played in 2016. In “Project 1,” I explored how players’ seeding influences winning and how a player’s age impacts winning. In “Project 2,” I explored whether there is a statistical relationship between a player’s
Creating a new variable ‘avg_rank’ that contine sertain valiable
player_rank_data <- rbind(df %>% select(player_name = winner_name, player_rank = winner_rank),
df %>% select(player_name = loser_name, player_rank = loser_rank))
#calculate average rank for each player
player_rank_data <- player_rank_data %>%
group_by(player_name) %>%
summarise(avg_rank = mean(player_rank, na.rm = TRUE)) %>%
arrange(avg_rank)
#add avg_rank to main data frame
df <- df %>%
left_join(player_rank_data, by = c("winner_name" = "player_name"))Creating Match Outcome Variable
df <- df %>%
mutate(match_outcome = ifelse(winner_name %in% player_rank_data$player_name, 1, 0))- Multiple Regression Models
To ensure regresion analysis, I will convert certain categorical variable (surface, tourney_level and round) into numeric
df <- df %>%
mutate(
surface_numeric = as.numeric(as.factor(surface)),
tourney_level_numeric = as.numeric(as.factor(tourney_level)),
round_numeric = as.numeric(as.factor(round))
)
#regression models
model_1 <- lm(match_outcome ~ avg_rank + surface_numeric + tourney_level_numeric, data = df)
model_2 <- lm(match_outcome ~ avg_rank + surface_numeric + tourney_level_numeric + round_numeric, data = df)
summary(model_1)##
## Call:
## lm(formula = match_outcome ~ avg_rank + surface_numeric + tourney_level_numeric,
## data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.900e-15 -2.900e-15 -1.000e-15 -4.000e-16 3.511e-12
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.000e+00 4.837e-15 2.068e+14 <2e-16 ***
## avg_rank -5.756e-19 9.458e-18 -6.100e-02 0.951
## surface_numeric 1.130e-15 1.329e-15 8.500e-01 0.395
## tourney_level_numeric -6.308e-16 7.204e-16 -8.760e-01 0.381
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.499e-14 on 2921 degrees of freedom
## (16 observations deleted due to missingness)
## Multiple R-squared: 0.5, Adjusted R-squared: 0.4995
## F-statistic: 973.7 on 3 and 2921 DF, p-value: < 2.2e-16summary(model_2)##
## Call:
## lm(formula = match_outcome ~ avg_rank + surface_numeric + tourney_level_numeric +
## round_numeric, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.500e-15 -2.700e-15 -8.000e-16 -4.000e-16 3.511e-12
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.000e+00 6.334e-15 1.579e+14 <2e-16 ***
## avg_rank -1.057e-18 9.709e-18 -1.090e-01 0.913
## surface_numeric 1.129e-15 1.329e-15 8.490e-01 0.396
## tourney_level_numeric -6.381e-16 7.213e-16 -8.850e-01 0.376
## round_numeric 1.680e-16 7.624e-16 2.200e-01 0.826
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.5e-14 on 2920 degrees of freedom
## (16 observations deleted due to missingness)
## Multiple R-squared: 0.5, Adjusted R-squared: 0.4993
## F-statistic: 730 on 4 and 2920 DF, p-value: < 2.2e-16Both models focus on the match’s outcome but from different perspectives. Model 1 considered factors that directly influence match outcomes, such as surface type and player rank. In the case of Model 2, I am adding round, considering the impact of tournament progression, a serious factor in sports, which can change the dynamics of player consistency and thus influence outcome of the match.
- Classical assumption for multiple regression
#focus on multicollinearity
vif_values <- vif(lm(match_outcome ~ avg_rank + surface_numeric + tourney_level_numeric + round_numeric, data = df))
# correlation matrix between independent variables through
independent_vars <- df %>%
select(avg_rank, surface_numeric, tourney_level_numeric, round_numeric)
cor_matrix <- cor(independent_vars, use = "complete.obs")
print(cor_matrix)## avg_rank surface_numeric tourney_level_numeric
## avg_rank 1.00000000 -0.0232037134 -0.13056611
## surface_numeric -0.02320371 1.0000000000 0.06330919
## tourney_level_numeric -0.13056611 0.0633091893 1.00000000
## round_numeric 0.22096451 -0.0002485381 0.01536586
## round_numeric
## avg_rank 0.2209645071
## surface_numeric -0.0002485381
## tourney_level_numeric 0.0153658584
## round_numeric 1.0000000000corrplot(cor_matrix, method = "circle", tl.col = "blue")
There is a reason to concern due to high collinearity and fit of the
data I am using,
- Regression results, use stargazer to create a table with results
stargazer(model_1, model_2, type = "text",
title = "Regression Results",
dep.var.labels = "Match Outcome",
covariate.labels = c("avrg rank", "surface", "tournament lvl", "round"),
omit.stat = c("f"),
add.lines = list(
c("R-squared", round(summary(model_1)$r.squared, 3), round(summary(model_2)$r.squared, 3)),
c("N Observations", nobs(model_1), nobs(model_2))
))##
## Regression Results
## =======================================================
## Dependent variable:
## -----------------------------------
## Match Outcome
## (1) (2)
## -------------------------------------------------------
## avrg rank -0.000 -0.000
## (0.000) (0.000)
##
## surface 0.000 0.000
## (0.000) (0.000)
##
## tournament lvl -0.000 -0.000
## (0.000) (0.000)
##
## round 0.000
## (0.000)
##
## Constant 1.000*** 1.000***
## (0.000) (0.000)
##
## -------------------------------------------------------
## R-squared 0.5 0.5
## N Observations 2925 2925
## Observations 2,925 2,925
## R2 0.500 0.500
## Adjusted R2 0.499 0.499
## Residual Std. Error 0.000 (df = 2921) 0.000 (df = 2920)
## =======================================================
## Note: *p<0.1; **p<0.05; ***p<0.01- Interpretation of results
The concerns that have been mentioned above were real. The fact that coefficients are zero might indicate multicollinearity issues. R-squared value is 0.5, that indicates model explains 50% of the variance in the dependent variable, but the despite seeming reasonable, the r-squared itslef doesn’t tell if coefficients are statisticlly significant. The Constant 1.000 could be a sign that the whole model is being dominated be the constant or again issue of multicollinearity.
6.Confidance interval
confint(model_1, level = 0.95)## 2.5 % 97.5 %
## (Intercept) 1.000000e+00 1.000000e+00
## avg_rank -1.912152e-17 1.797040e-17
## surface_numeric -1.475975e-15 3.735328e-15
## tourney_level_numeric -2.043457e-15 7.818008e-16confint(model_2, leve = 0.95)## 2.5 % 97.5 %
## (Intercept) 1.000000e+00 1.000000e+00
## avg_rank -2.009361e-17 1.798000e-17
## surface_numeric -1.477060e-15 3.735106e-15
## tourney_level_numeric -2.052387e-15 7.762625e-16
## round_numeric -1.326948e-15 1.662987e-15All the numbers are tiny, which means there is no statistical significance towards avg_rank at a 95% confidence level, but it also should be taken to account issues that appeared in previous steps
- F-test
model_full <- lm(match_outcome ~ avg_rank + surface_numeric + tourney_level_numeric + round_numeric, data = df)
#linearHypothesis(model_full, c("avg_rank = 0", "surface_numeric = 0", "tourney_level_numeric = 0", "round_numeric = 0"))Can not run linear hypothesis test, due to RSS = 0.
8.Residual Analysis
# Extract residuals from the full model
residuals_model1 <- residuals(model_full)
residuals_df <- data.frame(residuals = residuals_model1)
# Plot density distribution of residuals for the full model
ggplot(residuals_df, aes(x = residuals)) +
geom_density(fill = "blue", alpha = 0.5) +
labs(title = "Density Distribution of Residuals (Full Model)", x = "Residuals", y = "Density") +
theme_minimal()
# Simple model for comparison
model_simple <- lm(match_outcome ~ avg_rank, data = df)
residuals_simple <- residuals(model_simple)
residuals_simple_df <- data.frame(residuals = residuals_simple)
# Plot density distribution for the simple model
ggplot(residuals_simple_df, aes(x = residuals)) +
geom_density(fill = "green", alpha = 0.5) +
labs(title = "Density Distribution of Residuals (Simple Model)", x = "Residuals", y = "Density") +
theme_minimal()
8,9. The residual analysis itself doesn’t give extraordinary results and
again conclude the fact of data problems. Speaking of the difference
between simple and multiple regression can be in their plots, for
example, in the area of multiple regression, if the model shows
approximately normal residuals, it eans that adding more predictors not
really affects the normality of error. On the other hand if density plot
of simple regression significantly different from the multiple one, it
could be a sign of adding more variubles to the influnce on normality of
error.
- It’s hard to say where does this project go, with fact of having issue with multicollinearity, that basicaly ruins the purpose of the work, but in same time this project helped with increasing coding skills and work with the data. I really want to know, what i can change in my project to make it better.