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.4.3
library(DT)
## Warning: package 'DT' was built under R version 4.4.3

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 = team_abbr[team]) %>%
  select(team, pct, diff)

standings
## # A tibble: 32 × 3
##    team    pct  diff
##    <chr> <dbl> <dbl>
##  1 BUF    1       43
##  2 PHI    1       20
##  3 LAC    0.75    17
##  4 PIT    0.75    -2
##  5 IND    0.75    40
##  6 JAX    0.75    24
##  7 SF     0.75     5
##  8 SEA    0.75    44
##  9 LA     0.75    19
## 10 DET    0.75    49
## # ℹ 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.011  -0.017
##  2 ATL    -0.033  -0.004
##  3 BAL     0.139   0.112
##  4 BUF     0.184   0.056
##  5 CAR    -0.058  -0.013
##  6 CHI    -0.036   0.023
##  7 CIN    -0.159   0.052
##  8 CLE    -0.199  -0.036
##  9 DAL     0.126   0.204
## 10 DEN     0.036  -0.06 
## # ℹ 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 BUF    1       43   0.184   0.056
##  2 PHI    1       20   0.024  -0.044
##  3 LAC    0.75    17  -0.002  -0.06 
##  4 PIT    0.75    -2   0.042   0.039
##  5 IND    0.75    40   0.151  -0.011
##  6 JAX    0.75    24   0.002  -0.087
##  7 SF     0.75     5  -0.022  -0.047
##  8 SEA    0.75    44   0.045  -0.113
##  9 LA     0.75    19   0.005  -0.063
## 10 DET    0.75    49   0.114  -0.067
## # ℹ 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))
  }
  
  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 DET    1.5   2       1.76    1.45  6.71
##  2 BUF    2     1.9     2       0.63  6.53
##  3 SEA    1.5   1.92    1.3     1.75  6.47
##  4 IND    1.5   1.85    2       1.07  6.42
##  5 PHI    2     1.51    1.16    1.29  5.96
##  6 JAX    1.5   1.58    1.01    1.58  5.67
##  7 LA     1.5   1.49    1.03    1.42  5.44
##  8 GB     1.25  1.51    1.66    0.95  5.37
##  9 LAC    1.5   1.46    0.99    1.4   5.35
## 10 DEN    1     1.66    1.24    1.4   5.3 
## # ℹ 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)
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    3.85
##  2 ATL    4.3 
##  3 BAL    5.26
##  4 BUF    2.31
##  5 CAR    4.7 
##  6 CHI    4.36
##  7 CIN    4.15
##  8 CLE    4.2 
##  9 DAL    4.22
## 10 DEN    3.61
## # ℹ 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.03
##  2 ATL    1.33
##  3 BAL    1.97
##  4 BUF    0   
##  5 CAR    1.6 
##  6 CHI    1.37
##  7 CIN    1.23
##  8 CLE    1.26
##  9 DAL    1.28
## 10 DEN    0.87
## # ℹ 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)