Assignment 3
Mandar Velapure
2024-03-27
Average Chance of Advancing through each round:
# Load the necessary libraries
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.3.3## Warning: package 'ggplot2' was built under R version 4.3.2## Warning: package 'tibble' was built under R version 4.3.2## Warning: package 'tidyr' was built under R version 4.3.2## Warning: package 'readr' was built under R version 4.3.3## Warning: package 'purrr' was built under R version 4.3.2## Warning: package 'dplyr' was built under R version 4.3.2## Warning: package 'stringr' was built under R version 4.3.2## Warning: package 'forcats' was built under R version 4.3.2## Warning: package 'lubridate' was built under R version 4.3.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors# Corrected path to the dataset
data_path <- "C:/Users/vela8270/Desktop/Assignment for GG 501/Tidy tuesday/Data/Public Picks.csv"
# Load the dataset
data <- read.csv(data_path)
# Convert percentage columns to numeric
# This step assumes that your data columns for percentages are formatted as strings with a "%" at the end.
# If this is not the case, adjust accordingly.
data <- data %>%
mutate(across(R64:FINALS, ~ as.numeric(sub("%", "", .))))
# Calculate the average chances for each round,
average_chances <- data %>%
summarise(across(R64:FINALS, ~ mean(.x, na.rm = TRUE)))
# Assuming everything up to the summarise step is correct
# and the column names are as printed above
# Directly specifying the columns to pivot
average_chances_long <- pivot_longer(average_chances,
cols = c(R64, R32, S16, E8, F4, FINALS),
names_to = "Round",
values_to = "Average Chance")
# Proceed with plotting
ggplot(average_chances_long, aes(x = Round, y = `Average Chance`)) +
geom_col() +
theme_minimal() +
labs(title = "Average Chance of Advancing Through Each Round",
x = "Tournament Round",
y = "Average Chance (%)")
The outcome of this analysis, particularly the visualization of average chances of advancing through each round, serves as a concise summary of the tournament’s structure and competitive landscape. It visually communicates where the biggest hurdles lie in progressing towards the finals, which can be invaluable for participants and analysts alike. Essentially, this analysis bridges the gap between raw data and actionable insights, allowing stakeholders to make informed decisions and deepen their understanding of the tournament’s dynamics.
Paths to Final 4 : Performs an analysis to identify and visualize the paths of the top teams with the highest chances of reaching the Final Four in a tournament.
library(tidyverse)
# Assuming data has been loaded and prepared
# Convert percentage columns to numeric if not already done
data <- data %>%
mutate(across(R64:FINALS, ~ as.numeric(sub("%", "", .x))))
# Identify teams with the highest chance of reaching the Final Four
top_teams_f4 <- data %>%
arrange(desc(F4)) %>%
top_n(4, F4)
# Print top teams for review
print(top_teams_f4)## YEAR TEAM.NO TEAM R64 R32 S16 E8 F4 FINALS
## 1 2024 1067 Connecticut 98.41 93.59 80.22 66.20 50.27 34.92
## 2 2024 1038 North Carolina 97.55 88.07 71.16 45.40 29.98 12.10
## 3 2024 1033 Purdue 97.08 86.21 66.25 44.36 21.64 10.22
## 4 2024 1056 Houston 97.01 85.69 63.77 42.54 16.15 9.27# Correcting the mutate() function to use the proper column name
top_teams_f4_long <- top_teams_f4 %>%
pivot_longer(cols = R64:FINALS, names_to = "Round", values_to = "Chance") %>%
mutate(TEAM = factor(TEAM, levels = top_teams_f4$TEAM))
# Plotting the paths of these teams through the tournament rounds with corrections
ggplot(top_teams_f4_long, aes(x = Round, y = Chance, color = TEAM, group = TEAM)) +
geom_line(linewidth = 1) + # Updated to use `linewidth` instead of `size`
geom_point(size = 2) +
theme_minimal() +
labs(title = "Paths to the Final Four: Top Teams",
x = "Tournament Round",
y = "Chance (%)",
color = "Team") +
theme(legend.position = "bottom")
Connecticut has a 50.27% chance of reaching the Final Four and a 34.92%
chance of making it to the finals, indicating they are considered to
have the highest likelihood among the teams listed to both reach the
Final Four and win the tournament. This detailed progression not only
showcases the expected performance of each team through the different
stages but also highlights how their chances decrease as the tournament
progresses, reflecting the increasing difficulty of each subsequent
round.
Distribution of Teams advancement chances by round: It is about teams’ chances of advancing through various rounds of a tournament.
library(tidyverse)
# Assuming data has been loaded and percentage columns converted to numeric
data <- data %>%
mutate(across(R64:FINALS, ~ as.numeric(sub("%", "", .x))))
# Prepare data for plotting
data_long <- data %>%
pivot_longer(cols = R64:FINALS, names_to = "Round", values_to = "Chance")
# Calculate summary statistics per round
summary_stats <- data_long %>%
group_by(Round) %>%
summarise(Mean = mean(Chance, na.rm = TRUE),
Median = median(Chance, na.rm = TRUE),
SD = sd(Chance, na.rm = TRUE))
# Print summary statistics for review
print(summary_stats)## # A tibble: 6 × 4
## Round Mean Median SD
## <chr> <dbl> <dbl> <dbl>
## 1 E8 6.21 0.62 13.0
## 2 F4 3.12 0.24 8.00
## 3 FINALS 1.56 0.115 4.85
## 4 R32 24.8 8.51 30.1
## 5 R64 49.4 49.3 33.9
## 6 S16 12.4 2.18 20.6# Visualize the distribution of chances per round with a box plot
ggplot(data_long, aes(x = Round, y = Chance)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Distribution of Teams' Advancement Chances by Round",
x = "Tournament Round",
y = "Advancement Chances (%)")
# Alternatively, a violin plot for a denser representation of the distribution
ggplot(data_long, aes(x = Round, y = Chance)) +
geom_violin() +
theme_minimal() +
labs(title = "Distribution of Teams' Advancement Chances by Round",
x = "Tournament Round",
y = "Advancement Chances (%)")
High Variability in Early Rounds: The R64 and R32 rounds show high means and standard deviations, reflecting a broad spectrum of team strengths and resulting in varied chances of advancement.
Increasingly Competitive in Later Rounds: The sharp decrease in mean chances and medians from the R64 to the Finals illustrates the tournament’s increasing competitiveness. As teams advance, the likelihood of moving forward decreases significantly, indicating the higher difficulty of competing against the remaining teams.
Lower Chances in Final Stages: The very low median chances in the E8, F4, and Finals rounds (below 1% for the latter two) suggest that for most teams, reaching the final stages of the tournament is highly unlikely, highlighting the competitive nature and the narrowing field of potential victors as the tournament progresses.
Analyzing the Relationship Between Team Performance Metrics and Tournament Success Chances:
library(readr) # or you can use library(tidyverse) which includes readr
file_path <- "C:/Users/vela8270/Desktop/Assignment for GG 501/Tidy tuesday/Data/Team Results.csv"
team_results <- read_csv(file_path)## Rows: 236 Columns: 20
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): TEAM, F4%, CHAMP%
## dbl (17): TEAM ID, PAKE, PAKE RANK, PASE, PASE RANK, GAMES, W, L, WIN%, R64,...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Correct path to your CSV file
file_path <- "C:/Users/vela8270/Desktop/Assignment for GG 501/Tidy tuesday/Data/Team Results.csv"
# Load the data
team_results <- read.csv(file_path)
# Check if 'team_results' exists
if (!exists("team_results")) {
stop("Error: 'team_results' dataframe is not available. Make sure it is loaded or defined correctly.")
} else {
# Correctly extracting numeric values and converting percentages
team_results <- team_results %>%
mutate(F4_percent = as.numeric(sub("%", "", `F4.`)) / 100,
CHAMP_percent = as.numeric(sub("%", "", `CHAMP.`)) / 100) # Assuming 'CHAMP.' column exists
}
# Proceed with correlation analysis
cor_pake_f4 <- cor(team_results$PAKE, team_results$F4_percent, use = "complete.obs")
cor_pake_champ <- cor(team_results$PAKE, team_results$CHAMP_percent, use = "complete.obs")
# Print correlations
print(paste("Correlation between PAKE and Final Four chances:", cor_pake_f4))## [1] "Correlation between PAKE and Final Four chances: 0.258156944462014"print(paste("Correlation between PAKE and Championship chances:", cor_pake_champ))## [1] "Correlation between PAKE and Championship chances: 0.326816396074341"The correlation between PAKE and Final Four chances is 0.258, indicating a positive relationship, though not exceptionally strong. This suggests that as PAKE increases, the chances of reaching the Final Four also tend to increase, but other factors likely play a significant role as well.
The correlation between PAKE and Championship chances is 0.327, which is also positive and slightly stronger than the correlation with Final Four chances. This implies that teams with higher PAKE values have somewhat higher chances of winning the championship, reinforcing the importance of PAKE as a performance metric, albeit still suggesting the influence of additional variables.
library(tidyverse)
# Ensure the win percentage and tournament success chance columns are numeric
# Assuming 'WIN.' represents the win percentage and 'F4_percent' & 'CHAMP_percent' have been correctly calculated
team_results <- team_results %>%
mutate(WIN_percent = `WIN.` / 100) # Convert win percentage to a proportion if needed
# Calculate correlations
cor_win_f4 <- cor(team_results$WIN_percent, team_results$F4_percent, use = "complete.obs")
cor_win_champ <- cor(team_results$WIN_percent, team_results$CHAMP_percent, use = "complete.obs")
# Print correlations
print(paste("Correlation between Win Percentage and Final Four chances:", cor_win_f4))## [1] "Correlation between Win Percentage and Final Four chances: 0.685757582707833"print(paste("Correlation between Win Percentage and Championship chances:", cor_win_champ))## [1] "Correlation between Win Percentage and Championship chances: 0.570916692860807"# Visualization: Scatter plot of Win Percentage vs. Final Four chances
ggplot(team_results, aes(x = WIN_percent, y = F4_percent)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "blue") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Win Percentage vs. Final Four Chances",
x = "Win Percentage",
y = "Chance of Reaching the Final Four")## `geom_smooth()` using formula = 'y ~ x'
# Visualization: Scatter plot of Win Percentage vs. Championship chances
ggplot(team_results, aes(x = WIN_percent, y = CHAMP_percent)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "red") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Win Percentage vs. Championship Chances",
x = "Win Percentage",
y = "Chance of Winning the Championship")## `geom_smooth()` using formula = 'y ~ x'
Win Percentage and Final Four Chances: The correlation of 0.686 is quite strong, suggesting that teams with higher win percentages during the season have a considerably better chance of reaching the Final Four. This implies that regular-season performance is a good predictor of deep tournament runs.
Win Percentage and Championship Chances: With a correlation of 0.571, there’s also a significant positive relationship between a team’s win percentage and their chances of winning the championship, although it’s slightly weaker than the correlation with Final Four chances. This indicates that while a strong regular-season record is important for championship success, other factors also play critical roles in the ultimate victory.
Probabilty of Team Reaching in final 4:
library(readr)
# Define the path to your file
file_path <- "C:/Users/vela8270/Desktop/Assignment for GG 501/Tidy tuesday/Data/Public Picks.csv"
# Load the data
public_picks <- read_csv(file_path)## Rows: 64 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): TEAM, R64, R32, S16, E8, F4, FINALS
## dbl (2): YEAR, TEAM NO
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Convert percentage strings to numeric values
public_picks_numeric <- public_picks %>%
mutate(across(starts_with("R"), ~as.numeric(sub("%", "", .))/100))
# Melt the data into long format for plotting
public_picks_long <- public_picks_numeric %>%
pivot_longer(cols = starts_with("R"), names_to = "Round", values_to = "Probability")
# Plotting with perpendicular x-axis labels
ggplot(public_picks_long, aes(x = TEAM, y = Probability, fill = Round)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Probability of Teams Reaching Final Four (2024)",
x = "Team", y = "Probability",
fill = "Round") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) + # Rotate x-axis labels
scale_y_continuous(labels = scales::percent)
The bar chart visualizes each team’s probability of advancing through
various tournament rounds in 2024.This visualization serves as a
powerful tool for fans, analysts, and team strategists to assess the
competitiveness of teams and the dynamics of the tournament at a glance,
highlighting both favorites and underdogs based on public picks.