simulation_curves.qmd

---
title: "Simulation Curves"
format: html
editor: visual
---

## Simulation Curves

The curves show the conditional probabilities of the true ranking being equal to the observed ranking in the simulations given that the teams with a better true rank (1 denotes the best) are ranked better in the observed rankings. For example, in a 4 team tournament the probabilities would look like the following:

$$
P(R_1 = 1)
$$

$$
P(R_2 = 2 | R_1 \leq 1) = \frac{P(R_1 \leq 1 \cap R_2 = 2)}{P(R_1 \leq 1)}
$$

$$
P(R_3 = 3 | R_1 \leq 2 \cap R_2 \leq2) = \frac{P(R_1 \leq 2 \cap R_2 \leq2 \cap R_3 = 3)}{P(R_1 \leq 2 \cap R_2 \leq2)}
$$

$$
P(R_4 = 4 | R_1 \leq 3 \cap R_2 \leq 3 \cap R_3 \leq 3) = \frac{P(R_1 \leq 3 \cap R_2 \leq 3 \cap R_3 \leq 3 \cap R_4 = 4) }{P(R_1 \leq 3 \cap R_2 \leq 3 \cap R_3 \leq 3)} = 1
$$

Each curve is compared to the baseline curve, which can be found by the following formula:

$$
P(R_i = i) = \frac{1}{n - i}, \text{ where n is the number of teams and i is the true rank}
$$

The baseline curve is the same conditional probabilities solved if each team had the same true rank (each team would be equally likely to win every game). Points above the baseline curve suggest that the tournament structure is more accurate to the true ranks than random chance.

proportion of times $R_1 = 1$ and $R_1 = 1 \text{ or } 2 \text{ and } R_2 = \text{1 or 2}$ etc.

also do counts

## Calculating the Curve

```{r}
library(tidyverse)
curve <- function(sim, num_teams) {
  probability <- numeric(num_teams)
  denominator <- nrow(sim)
  prob_data <- data.frame(rank = 1:num_teams, probability = numeric(num_teams))
  
  for (i in 1:num_teams) {
    prob_data$probability[i] <- nrow(sim[sim$rank_hat <= i & sim$true_rank <= i,]) / denominator
  }
  return(prob_data)
}

# with randomly assigning ties
test_rr_noTies <- test_rr %>%
  group_by(simulation) %>%
  mutate(rank_hat = rank(rank_hat,ties.method="random"))
# Get probabilities for Round Robin and Single Elimination
rr_probs_plot <- curve(test_rr_noTies, 8)
se_probs_plot <- curve(se_norm_results, 8)
de_probs_plot <- curve(de_norm_results_eight,8)

# Add line label to each dataset
rr_probs_plot$line <- "Round Robin"
se_probs_plot$line <- "Single Elimination"
de_probs_plot$line <- "Double Elimination"

# Combine all data for plotting
test_plot <- rbind(rr_probs_plot, se_probs_plot, de_probs_plot)

# Generate ggplot
ggplot(data = test_plot, aes(x = rank, y = probability, color = line, group = line)) +
  geom_point() +
  geom_line() +
  ylim(0, 1) +
  labs(
    x = "Rank",
    y = "Probability",
    title = "Probabilities"
  ) +
  theme_minimal()


```

```{r}
count_curve <- function(sim, num_teams) {
  prob_data <- data.frame(rank = 1:num_teams, probability = numeric(num_teams))
  
  num_sims <- length(unique(sim$simulation)) 
  
  for (i in 1:num_teams) {
    count <- sum(sapply(unique(sim$simulation), function(simulation) {
      subset_sim <- sim[sim$simulation == simulation, ]
      top_true <- subset_sim[order(subset_sim$true_rank), ][1:i, "true_rank"]
      top_hat <- subset_sim[order(subset_sim$rank_hat), ][1:i, "true_rank"]
      all(top_true %in% top_hat)
    }))
    
    prob_data$probability[i] <- count / num_sims
  }
  
  return(prob_data)
}

de_norm_results$simulation <- rep(1:10000, each = nrow(de_norm_results) / 10000)
se_norm_results$simulation <- rep(1:10000, each = nrow(se_norm_results) / 10000)
# with randomly assigning ties
test_rr_noTies <- test_rr %>%
  group_by(simulation) %>%
  mutate(rank_hat = rank(rank_hat,ties.method="random"))
# Get probabilities for Round Robin and Single Elimination
rr_count_plot <- count_curve(test_rr_noTies, 8)
se_count_plot <- count_curve(se_norm_results %>% filter(num_teams==8), 8)
de_count_plot <- count_curve(de_norm_results %>% filter(num_teams==8),8)

# Add line label to each dataset
rr_count_plot$line <- "Round Robin"
se_count_plot$line <- "Single Elimination"
de_count_plot$line <- "Double Elimination"

# Combine all data for plotting
test_plot <- rbind(rr_count_plot, se_count_plot, de_count_plot)

# Generate ggplot
ggplot(data = test_plot, aes(x = rank, y = probability, color = line, group = line)) +
  geom_point() +
  geom_line() +
  labs(
    x = "Rank",
    y = "Count",
    title = "Counts"
  ) +
  theme_minimal()

```