This file is used to create custom offensive and defensive power ratings based on points scored and allowed. The simple ratings are used in the Motivation ratings. Subscribe to my Substack newsletter, Monte Carlo Football Picks, to learn more about the logic behind these calculations.

Load packages

library(tidyverse)

Load data

results <- read_csv("Week 06/inputs/game_results1.csv")
Rows: 272 Columns: 7
-- Column specification -------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (2): Home, Away
dbl (5): Season, Week, Hm, Aw, Past

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(results, 5)

Rearrange data

res_a <- results %>%
  select(Season, Week, Past, Team = Home, Opponent = Away, PF = Hm, PA = Aw)

res_b <- results %>%
  select(Season, Week, Past, Team = Away, Opponent = Home, PF = Aw, PA = Hm)

results2 <- bind_rows(res_a, res_b) %>%
  filter(Past == 1)

head(results2, 5)

Calculate number of games played


game_count <- results2 %>%
  group_by(Team) %>%
  summarise(n = n())
  

head(game_count, 5)

Calculate total PF and PA

team_points <- results2 %>%
  group_by(Team) %>%
  summarize(PF = sum(PF), PA = sum(PA)) %>%
  left_join(game_count, by = "Team") %>%
  mutate(PF_PG = PF/n, PA_PG = PA/n) %>%
  select(Team, PF, PF_PG, PA, PA_PG, n)


head(team_points, 5)

Calculate average points per game

ppg <- (sum(team_points$PF) + sum(team_points$PA))/ (sum(team_points$n)*2)

ppg
[1] 23.8

Opp’s PF, PA and games played

opp_pts <- results2 %>%
  left_join(team_points, by = c("Opponent" = "Team")) %>%
  rename("Opp_PF" = PF.y, "Opp_PA" = PA.y) %>%
  select(Season:Opponent, Opp_PF, Opp_PA, n) %>%
  group_by(Team) %>%
  summarise(Opp_PF = sum(Opp_PF), Opp_PA = sum(Opp_PA), Opp_n = sum(n))

points_summary <- left_join(team_points, opp_pts, by = "Team") %>%
  mutate(Opp_PF_oth = Opp_PF - PA, Opp_PA_oth = Opp_PA - PF, Opp_n_oth = Opp_n - n)
  
head(points_summary, 5)

Calculate Opp PG averages and summarize data

summary <- points_summary %>%
  mutate(Opp_PF_PG_oth = Opp_PF_oth/Opp_n_oth, Opp_PA_PG_oth = Opp_PA_oth/Opp_n_oth) %>%
  select(Team, PF_PG, PA_PG, Opp_PF_PG_oth, Opp_PA_PG_oth)

head(summary, 5)

Calculate simple ratings for Offense and Defense

simple_ratings <- summary %>%
  mutate(rating1 = ppg + (PF_PG - ppg) + (ppg - Opp_PA_PG_oth),
         rating2 = ppg - ((ppg - PA_PG) - (ppg - Opp_PF_PG_oth))) %>%
  mutate(scaled1 = scale(rating1, center = TRUE, scale = TRUE)) %>%
  mutate(off_rating = 25 + if_else(scaled1 * sd(rating1) > 3.5, 3.5,
                                   if_else(scaled1 * sd(rating1) < -3.5, -3.5,
                                           scaled1 * sd(rating1)))) %>%
  mutate(scaled2 = scale(rating2, center = TRUE, scale = TRUE)) %>%
  mutate(def_rating = 25 + if_else(scaled2 * sd(rating2) > 3.5, 3.5,
                                   if_else(scaled2 * sd(rating2) < -3.5, -3.5,
                                           scaled2 * sd(rating2)))) %>%
  select(Team, off_rating, def_rating)

write.csv(simple_ratings, "simple_ratings.csv")

simple_ratings
LS0tDQp0aXRsZTogIlNpbXBsZSBSYXRpbmdzOiAyMDIxIE5GTCBXZWVrIDA2Ig0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KDQoNClRoaXMgZmlsZSBpcyB1c2VkIHRvIGNyZWF0ZSBjdXN0b20gb2ZmZW5zaXZlIGFuZCBkZWZlbnNpdmUgcG93ZXIgcmF0aW5ncyBiYXNlZCBvbiBwb2ludHMgc2NvcmVkIGFuZCBhbGxvd2VkLiBUaGUgc2ltcGxlIHJhdGluZ3MgYXJlIHVzZWQgaW4gdGhlIE1vdGl2YXRpb24gcmF0aW5ncy4gU3Vic2NyaWJlIHRvIG15IFN1YnN0YWNrIG5ld3NsZXR0ZXIsIFtNb250ZSBDYXJsbyBGb290YmFsbCBQaWNrc10oaHR0cHM6Ly9tY2ZwLnN1YnN0YWNrLmNvbS8pLCB0byBsZWFybiBtb3JlIGFib3V0IHRoZSBsb2dpYyBiZWhpbmQgdGhlc2UgY2FsY3VsYXRpb25zLg0KDQoNCg0KTG9hZCBwYWNrYWdlcw0KYGBge3J9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmBgYA0KDQoNCg0KTG9hZCBkYXRhDQpgYGB7cn0NCnJlc3VsdHMgPC0gcmVhZF9jc3YoIldlZWsgMDYvaW5wdXRzL2dhbWVfcmVzdWx0czEuY3N2IikNCg0KaGVhZChyZXN1bHRzLCA1KQ0KYGBgDQoNCg0KDQpSZWFycmFuZ2UgZGF0YQ0KYGBge3J9DQpyZXNfYSA8LSByZXN1bHRzICU+JQ0KICBzZWxlY3QoU2Vhc29uLCBXZWVrLCBQYXN0LCBUZWFtID0gSG9tZSwgT3Bwb25lbnQgPSBBd2F5LCBQRiA9IEhtLCBQQSA9IEF3KQ0KDQpyZXNfYiA8LSByZXN1bHRzICU+JQ0KICBzZWxlY3QoU2Vhc29uLCBXZWVrLCBQYXN0LCBUZWFtID0gQXdheSwgT3Bwb25lbnQgPSBIb21lLCBQRiA9IEF3LCBQQSA9IEhtKQ0KDQpyZXN1bHRzMiA8LSBiaW5kX3Jvd3MocmVzX2EsIHJlc19iKSAlPiUNCiAgZmlsdGVyKFBhc3QgPT0gMSkNCg0KaGVhZChyZXN1bHRzMiwgNSkNCmBgYA0KDQoNCg0KQ2FsY3VsYXRlIG51bWJlciBvZiBnYW1lcyBwbGF5ZWQNCmBgYHtyfQ0KDQpnYW1lX2NvdW50IDwtIHJlc3VsdHMyICU+JQ0KICBncm91cF9ieShUZWFtKSAlPiUNCiAgc3VtbWFyaXNlKG4gPSBuKCkpDQogIA0KDQpoZWFkKGdhbWVfY291bnQsIDUpDQpgYGANCg0KDQoNCkNhbGN1bGF0ZSB0b3RhbCBQRiBhbmQgUEENCmBgYHtyfQ0KdGVhbV9wb2ludHMgPC0gcmVzdWx0czIgJT4lDQogIGdyb3VwX2J5KFRlYW0pICU+JQ0KICBzdW1tYXJpemUoUEYgPSBzdW0oUEYpLCBQQSA9IHN1bShQQSkpICU+JQ0KICBsZWZ0X2pvaW4oZ2FtZV9jb3VudCwgYnkgPSAiVGVhbSIpICU+JQ0KICBtdXRhdGUoUEZfUEcgPSBQRi9uLCBQQV9QRyA9IFBBL24pICU+JQ0KICBzZWxlY3QoVGVhbSwgUEYsIFBGX1BHLCBQQSwgUEFfUEcsIG4pDQoNCg0KaGVhZCh0ZWFtX3BvaW50cywgNSkNCmBgYA0KDQoNCg0KQ2FsY3VsYXRlIGF2ZXJhZ2UgcG9pbnRzIHBlciBnYW1lDQpgYGB7cn0NCnBwZyA8LSAoc3VtKHRlYW1fcG9pbnRzJFBGKSArIHN1bSh0ZWFtX3BvaW50cyRQQSkpLyAoc3VtKHRlYW1fcG9pbnRzJG4pKjIpDQoNCnBwZw0KYGBgDQoNCg0KDQpPcHAncyBQRiwgUEEgYW5kIGdhbWVzIHBsYXllZA0KDQpgYGB7cn0NCm9wcF9wdHMgPC0gcmVzdWx0czIgJT4lDQogIGxlZnRfam9pbih0ZWFtX3BvaW50cywgYnkgPSBjKCJPcHBvbmVudCIgPSAiVGVhbSIpKSAlPiUNCiAgcmVuYW1lKCJPcHBfUEYiID0gUEYueSwgIk9wcF9QQSIgPSBQQS55KSAlPiUNCiAgc2VsZWN0KFNlYXNvbjpPcHBvbmVudCwgT3BwX1BGLCBPcHBfUEEsIG4pICU+JQ0KICBncm91cF9ieShUZWFtKSAlPiUNCiAgc3VtbWFyaXNlKE9wcF9QRiA9IHN1bShPcHBfUEYpLCBPcHBfUEEgPSBzdW0oT3BwX1BBKSwgT3BwX24gPSBzdW0obikpDQoNCnBvaW50c19zdW1tYXJ5IDwtIGxlZnRfam9pbih0ZWFtX3BvaW50cywgb3BwX3B0cywgYnkgPSAiVGVhbSIpICU+JQ0KICBtdXRhdGUoT3BwX1BGX290aCA9IE9wcF9QRiAtIFBBLCBPcHBfUEFfb3RoID0gT3BwX1BBIC0gUEYsIE9wcF9uX290aCA9IE9wcF9uIC0gbikNCiAgDQpoZWFkKHBvaW50c19zdW1tYXJ5LCA1KQ0KYGBgDQoNCg0KDQpDYWxjdWxhdGUgT3BwIFBHIGF2ZXJhZ2VzIGFuZCBzdW1tYXJpemUgZGF0YQ0KYGBge3J9DQpzdW1tYXJ5IDwtIHBvaW50c19zdW1tYXJ5ICU+JQ0KICBtdXRhdGUoT3BwX1BGX1BHX290aCA9IE9wcF9QRl9vdGgvT3BwX25fb3RoLCBPcHBfUEFfUEdfb3RoID0gT3BwX1BBX290aC9PcHBfbl9vdGgpICU+JQ0KICBzZWxlY3QoVGVhbSwgUEZfUEcsIFBBX1BHLCBPcHBfUEZfUEdfb3RoLCBPcHBfUEFfUEdfb3RoKQ0KDQpoZWFkKHN1bW1hcnksIDUpDQpgYGANCg0KDQoNCkNhbGN1bGF0ZSBzaW1wbGUgcmF0aW5ncyBmb3IgT2ZmZW5zZSBhbmQgRGVmZW5zZQ0KYGBge3J9DQpzaW1wbGVfcmF0aW5ncyA8LSBzdW1tYXJ5ICU+JQ0KICBtdXRhdGUocmF0aW5nMSA9IHBwZyArIChQRl9QRyAtIHBwZykgKyAocHBnIC0gT3BwX1BBX1BHX290aCksDQogICAgICAgICByYXRpbmcyID0gcHBnIC0gKChwcGcgLSBQQV9QRykgLSAocHBnIC0gT3BwX1BGX1BHX290aCkpKSAlPiUNCiAgbXV0YXRlKHNjYWxlZDEgPSBzY2FsZShyYXRpbmcxLCBjZW50ZXIgPSBUUlVFLCBzY2FsZSA9IFRSVUUpKSAlPiUNCiAgbXV0YXRlKG9mZl9yYXRpbmcgPSAyNSArIGlmX2Vsc2Uoc2NhbGVkMSAqIHNkKHJhdGluZzEpID4gMy41LCAzLjUsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGlmX2Vsc2Uoc2NhbGVkMSAqIHNkKHJhdGluZzEpIDwgLTMuNSwgLTMuNSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBzY2FsZWQxICogc2QocmF0aW5nMSkpKSkgJT4lDQogIG11dGF0ZShzY2FsZWQyID0gc2NhbGUocmF0aW5nMiwgY2VudGVyID0gVFJVRSwgc2NhbGUgPSBUUlVFKSkgJT4lDQogIG11dGF0ZShkZWZfcmF0aW5nID0gMjUgKyBpZl9lbHNlKHNjYWxlZDIgKiBzZChyYXRpbmcyKSA+IDMuNSwgMy41LA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBpZl9lbHNlKHNjYWxlZDIgKiBzZChyYXRpbmcyKSA8IC0zLjUsIC0zLjUsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2NhbGVkMiAqIHNkKHJhdGluZzIpKSkpICU+JQ0KICBzZWxlY3QoVGVhbSwgb2ZmX3JhdGluZywgZGVmX3JhdGluZykNCg0Kd3JpdGUuY3N2KHNpbXBsZV9yYXRpbmdzLCAic2ltcGxlX3JhdGluZ3MuY3N2IikNCg0Kc2ltcGxlX3JhdGluZ3MNCmBgYA0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg==