Dynamic ARM Rankings 2025

ARM Ranking

1. Win% (PFN)
2. Point Differential (PFN)
3. EPA/play (nflfastR)
4. EPA/play Against (nflfastR)
5. SOS (initial values)

ARM Initial Formula

\[ \text{ARM}_i = (WP \cdot c_1) + (\frac{(PD - \alpha_1)}{\alpha_2} \cdot c_1) + ((EPA + c_2) \cdot c_3) + ((EPA_A - c_2) \cdot -c_3) \]

ARM Formula

\[ \text{ARM} = \text{ARM}_i + (\frac{(SOS - \alpha_3)}{\alpha_4} \cdot c_1) \]

Load Packages

library(rvest)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(nflfastR)

## Warning: package 'nflfastR' was built under R version 4.5.2

library(DT)
library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.5.2

library(nflplotR)

## Warning: package 'nflplotR' was built under R version 4.5.2

Load Play-By-Play Data

pbp <- load_pbp(2025)

Get Win% and PD Data

Get Team Abbreviations

team_abbr <- c(
  "Arizona Cardinals" = "ARI",
  "Atlanta Falcons"  = "ATL",
  "Baltimore Ravens" = "BAL",
  "Buffalo Bills"    = "BUF",
  "Carolina Panthers"= "CAR",
  "Chicago Bears"    = "CHI",
  "Cincinnati Bengals" = "CIN",
  "Cleveland Browns" = "CLE",
  "Dallas Cowboys"   = "DAL",
  "Denver Broncos"   = "DEN",
  "Detroit Lions"    = "DET",
  "Green Bay Packers"= "GB",
  "Houston Texans"   = "HOU",
  "Indianapolis Colts" = "IND",
  "Jacksonville Jaguars" = "JAX",
  "Kansas City Chiefs" = "KC",
  "Las Vegas Raiders" = "LV",
  "Los Angeles Chargers" = "LAC",
  "Los Angeles Rams" = "LA",
  "Miami Dolphins"   = "MIA",
  "Minnesota Vikings"= "MIN",
  "New England Patriots" = "NE",
  "New Orleans Saints" = "NO",
  "New York Giants"  = "NYG",
  "New York Jets"    = "NYJ",
  "Philadelphia Eagles" = "PHI",
  "Pittsburgh Steelers" = "PIT",
  "San Francisco 49ers" = "SF",
  "Seattle Seahawks" = "SEA",
  "Tampa Bay Buccaneers" = "TB",
  "Tennessee Titans" = "TEN",
  "Washington Commanders" = "WAS"
)

Scrape Webpage

url <- "https://www.profootballnetwork.com/nfl/standings/league/2025"

page <- read_html(url)

tables <- page %>% html_nodes("table") %>% html_table(fill = TRUE)

standings <- tables[[1]]

colnames(standings) <- standings[1, ]

standings <- standings[-1, ]

colnames(standings)[1] <- "team"

standings <- standings %>%
  mutate(pct = as.numeric(PCT), pf = as.numeric(PF), pa = as.numeric(PA)) %>%
  select(team, pct, pf, pa) %>%
  mutate(diff = pf-pa) %>%
  mutate(team = gsub("\\s*\\(([a-z]|\\*)\\)", "", team)) %>%
  mutate(team = team_abbr[team]) %>%
  select(team, pct, diff)

standings

## # A tibble: 32 × 3
##    team    pct  diff
##    <chr> <dbl> <dbl>
##  1 DEN   0.824    90
##  2 SEA   0.824   191
##  3 NE    0.824   170
##  4 JAX   0.765   138
##  5 BUF   0.706   116
##  6 HOU   0.706   109
##  7 LA    0.706   172
##  8 SF    0.706    66
##  9 PHI   0.647    54
## 10 CHI   0.647    26
## # ℹ 22 more rows

Get EPA Data

Create get_epa Function

get_epa <- function(team_input) {
  off_output <- pbp %>%
    filter(posteam == team_input) %>%
    group_by(posteam) %>%
    summarize(off_epa = round(mean(epa, na.rm = TRUE), 3)) %>%
    rename(team = posteam)
  
  def_output <- pbp %>%
    filter(defteam == team_input) %>%
    group_by(defteam) %>%
    summarize(def_epa = round(mean(epa, na.rm = TRUE), 3)) %>%
    rename(team = defteam)

  combined <- off_output %>%
    left_join(def_output, by = "team")

  return(combined)
}

get_epa_wo_team <- function(team_input, team_remove) {
  off_output <- pbp %>%
    filter(posteam == team_input, defteam != team_remove) %>%
    group_by(posteam) %>%
    summarize(off_epa = round(mean(epa, na.rm = TRUE), 3)) %>%
    rename(team = posteam)
  
  def_output <- pbp %>%
    filter(defteam == team_input, posteam != team_remove) %>%
    group_by(defteam) %>%
    summarize(def_epa = round(mean(epa, na.rm = TRUE), 3)) %>%
    rename(team = defteam)

  combined <- off_output %>%
    left_join(def_output, by = "team")

  return(combined)
}

Loop Through Teams

teams <- pbp %>%
  filter(!is.na(posteam)) %>%
  distinct(posteam) %>%
  arrange(posteam) %>%
  pull(posteam)

epa_results <- tibble()
for (i in teams) {
  epa_results <- bind_rows(epa_results, get_epa(i))
}
epa_results

## # A tibble: 32 × 3
##    team  off_epa def_epa
##    <chr>   <dbl>   <dbl>
##  1 ARI    -0.021   0.091
##  2 ATL    -0.017   0.024
##  3 BAL     0.045   0.027
##  4 BUF     0.119   0.024
##  5 CAR    -0.018   0.047
##  6 CHI     0.053   0.029
##  7 CIN     0.032   0.1  
##  8 CLE    -0.159  -0.072
##  9 DAL     0.1     0.138
## 10 DEN     0.029  -0.037
## # ℹ 22 more rows

Combine For Initial Values

initial_values <- standings %>%
  left_join(epa_results, by = "team")
initial_values

## # A tibble: 32 × 5
##    team    pct  diff off_epa def_epa
##    <chr> <dbl> <dbl>   <dbl>   <dbl>
##  1 DEN   0.824    90   0.029  -0.037
##  2 SEA   0.824   191   0.047  -0.121
##  3 NE    0.824   170   0.109  -0.036
##  4 JAX   0.765   138   0.055  -0.059
##  5 BUF   0.706   116   0.119   0.024
##  6 HOU   0.706   109  -0.003  -0.109
##  7 LA    0.706   172   0.099  -0.046
##  8 SF    0.706    66   0.088   0.027
##  9 PHI   0.647    54   0.012  -0.037
## 10 CHI   0.647    26   0.053   0.029
## # ℹ 22 more rows

Get initial Ratings

min_diff <- min(initial_values$diff)
max_diff <- max(initial_values$diff)
diff_range <- max_diff - min_diff

get_init_ratings <- function(input_df) {
  output <- input_df %>% mutate(
    pct = round(pct * 2, 2), # min: 0%, mean: 50%, max: 100%
    diff = round(((diff-min_diff) / diff_range) * 2, 2), # min: min_diff, mean: ?, max: max_diff
    off_epa = round(pmax(pmin((off_epa + .15) * 6.67, 2), 0), 2), # min: -.15, mean: 0, max: .15
    def_epa = round(pmax(pmin((def_epa - .15) * -6.67, 2), 0), 2), # min: .15, mean: 0, max: -.15
    total = pct + diff + off_epa + def_epa
  ) %>%
    arrange(-total)
  return(output)
}

# Without a certain team (used for SOS, can only remove epa)
get_init_ratings_wo_team <- function(team_remove, opponents) {
  epa_results_wo_team <- tibble()
  for (i in opponents) {
    epa_results_wo_team <- bind_rows(epa_results_wo_team, get_epa_wo_team(i, team_remove))
  }
  
  epa_results_wo_team <- epa_results_wo_team %>%
    distinct(team, .keep_all = TRUE)
  
  initial_values_wo_team <- rows_update(initial_values, epa_results_wo_team, by = "team")

  return(get_init_ratings(initial_values_wo_team))
}

initial_ratings <- get_init_ratings(initial_values)
initial_ratings

## # A tibble: 32 × 6
##    team    pct  diff off_epa def_epa total
##    <chr> <dbl> <dbl>   <dbl>   <dbl> <dbl>
##  1 SEA    1.65  2       1.31    1.81  6.77
##  2 NE     1.65  1.89    1.73    1.24  6.51
##  3 LA     1.41  1.9     1.66    1.31  6.28
##  4 JAX    1.53  1.73    1.37    1.39  6.02
##  5 HOU    1.41  1.58    0.98    1.73  5.7 
##  6 BUF    1.41  1.62    1.79    0.84  5.66
##  7 DEN    1.65  1.49    1.19    1.25  5.58
##  8 SF     1.41  1.37    1.59    0.82  5.19
##  9 PHI    1.29  1.3     1.08    1.25  4.92
## 10 DET    1.06  1.38    1.46    0.89  4.79
## # ℹ 22 more rows

#test <- get_init_ratings_wo_team("LAC")
#test

Get SOS

Get Opponents

get_opponents <- function(team_input) {
  output <- pbp %>%
  filter(posteam == team_input) %>%
  group_by(game_id) %>%
  slice_min(., order_by = play_id) %>% # Take only first play
  ungroup() %>%
  pull(defteam) %>%
  unique() # Remove duplicate teams
return(output)
}

sos_results <- tibble()
for (i in teams) {
  opp <- get_opponents(i)
  ratings <- c()
  # Get EPA data without x team
  initial_ratings_wo_team <- get_init_ratings_wo_team(i, opp)
  for (j in opp) {
    #opp_rating <- initial_ratings %>%
      #filter(team == j) %>%
      #pull(total)
    #ratings <- append(ratings, opp_rating)
    
    opp_rating <- initial_ratings_wo_team %>%
      filter(team == j) %>%
      pull(total)
    ratings <- append(ratings, opp_rating)
  }
  mean_rating <- round(mean(ratings), 2)
  rating_tibble <- tibble(i, mean_rating)
  sos_results <- bind_rows(sos_results, rating_tibble)
}
sos_results <- sos_results %>%
  rename(team = i, sos = mean_rating)
sos_results

## # A tibble: 32 × 2
##    team    sos
##    <chr> <dbl>
##  1 ARI    4.23
##  2 ATL    4.1 
##  3 BAL    4.33
##  4 BUF    3.81
##  5 CAR    4.3 
##  6 CHI    3.63
##  7 CIN    4.2 
##  8 CLE    3.78
##  9 DAL    3.57
## 10 DEN    3.59
## # ℹ 22 more rows

Get SOS Ratings

min_sos <- min(sos_results$sos)
max_sos <- max(sos_results$sos)
sos_range <- max_sos - min_sos
get_sos <- function(input_df) {
  output <- input_df %>%
    mutate(
      sos = round((((sos - min_sos) / sos_range) * 2), 2)
        )
  return(output)
}
sos_ratings <- get_sos(sos_results)
sos_ratings

## # A tibble: 32 × 2
##    team    sos
##    <chr> <dbl>
##  1 ARI    1.61
##  2 ATL    1.42
##  3 BAL    1.75
##  4 BUF    1.01
##  5 CAR    1.7 
##  6 CHI    0.76
##  7 CIN    1.56
##  8 CLE    0.97
##  9 DAL    0.68
## 10 DEN    0.7 
## # ℹ 22 more rows

Get Final Ratings

final_ratings <- initial_ratings %>%
  left_join(sos_ratings, by = "team") %>%
  select(-total) %>%
  mutate(total = round(pct + diff + off_epa + def_epa + sos, 2)) %>%
  arrange(-total)
datatable(final_ratings)

final_ratings_tier <- final_ratings %>%
  mutate(
    tier = case_when(
      total >= 7        ~ "7+",
      total >= 6        ~ "6-7",
      total >= 5        ~ "5-6",
      total >= 4        ~ "4-5",
      total >= 3        ~ "3-4",
      TRUE              ~ "3-"
    )
  )
final_ratings_tier

## # A tibble: 32 × 8
##    team    pct  diff off_epa def_epa   sos total tier 
##    <chr> <dbl> <dbl>   <dbl>   <dbl> <dbl> <dbl> <chr>
##  1 SEA    1.65  2       1.31    1.81  1.34  8.11 7+   
##  2 LA     1.41  1.9     1.66    1.31  1.68  7.96 7+   
##  3 HOU    1.41  1.58    0.98    1.73  1.89  7.59 7+   
##  4 JAX    1.53  1.73    1.37    1.39  1.23  7.25 7+   
##  5 BUF    1.41  1.62    1.79    0.84  1.01  6.67 6-7  
##  6 NE     1.65  1.89    1.73    1.24  0     6.51 6-7  
##  7 SF     1.41  1.37    1.59    0.82  1.32  6.51 6-7  
##  8 PHI    1.29  1.3     1.08    1.25  1.54  6.46 6-7  
##  9 IND    0.94  1.3     1.57    0.79  1.69  6.29 6-7  
## 10 DEN    1.65  1.49    1.19    1.25  0.7   6.28 6-7  
## # ℹ 22 more rows

Create Power Ranking Tiers

final_ratings_tier <- final_ratings_tier %>%
  group_by(tier) %>%
  arrange(desc(total)) %>%
  mutate(
    xpos = seq_along(team),
    xpos_text = xpos + 0.25
  ) %>%
  ungroup()

ggplot(final_ratings_tier, aes(x = xpos, y = tier)) +
  geom_nfl_logos(aes(team_abbr = team), width = 0.07) +
  geom_text(aes(x = xpos_text, label = total), hjust = -0.25, vjust = -2, size = 3) +
  scale_y_discrete(limits = rev(levels(final_ratings_tier$tier))) +
  scale_x_continuous(expand = expansion(mult = c(0.05, 0.1))) +
  labs(x = NULL, y = NULL) +
  theme(
    axis.text.x = element_blank(),
    axis.ticks.x = element_blank()
  )