Create a heatmap with ggplot seen as on fivethirtyeight

Question

I have identical data -team names, probabilities of winning, relegation etc.- but could not figure out how to plot it as we see in the picture with ggplot . Any suggestions?

The data:

structure(list(Team = c("Eyupspor", "Samsunspor", "Keciorengucu", 
"Bodrumspor", "Bandirmaspor", "Pendikspor", "Boluspor", "Rizespor", 
"Sakaryaspor", "Goztepe", "Manisa", "Adanaspor", "Altay", "Tuzlaspor", 
"Erzurumspor", "Altinordu", "Malatyaspor", "Denizlispor", "Genclerbirligi"
), Points = c(41, 38, 36, 35, 34, 34, 33, 31, 31, 28, 28, 22, 
19, 19, 18, 16, 13, 12, 10), İlk_iki = c(0.666, 0.592, 0.211, 
0.161, 0.126, 0.169, 0.012, 0.052, 0.008, 0, 0.002, NA, NA, NA, 
NA, NA, NA, NA, NA), Playoff = c(0.996, 0.988, 0.908, 0.875, 
0.818, 0.881, 0.388, 0.694, 0.261, 0.061, 0.126, 0.004, 0, 0, 
0, NA, NA, NA, NA), Küme_Düşme = c(NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, 0.024, 0.093, 0.163, 0.228, 0.751, 0.865, 0.907, 
0.969)), row.names = c(NA, 19L), class = "data.frame")

Answer 1

Just out of curiosity about what and how it could be achieved using ggplot2 here is one possible approach to get you close to the look of the FiveThirtyEight table:

library(tidyr)
library(dplyr)
library(ggplot2)
library(showtext)

font_add_google("Karla", "karla")
font_add_google("Fira Mono", "fira")

showtext.auto()

dat_long <- dat |>
  mutate(
    Team = reorder(Team, -Points),
    y = as.numeric(Team)
  ) |>
  pivot_longer(-c(Team, y))

dat_text <- dat_long |>
  filter(name == "Points")

dat_heat <- dat_long |>
  filter(name != "Points")

dat_header <- data.frame(
  hjust = c(0, .5, rep(1, 3)),
  x = c(.55, 2, (3:5) + .45),
  y = 0,
  label = c("Team", "Points", "İlk iki", "Playoff", "Küme Düşme")
)

fontsize <- 8
ggplot(dat_long, aes(x = name)) +
  # header row
  geom_tile(aes(x = 1:5, y = y),
    data = dat_header,
    fill = c("#F0F0F0", rep(NA, 3), "#555555")
  ) +
  geom_text(aes(x = x, y = y, label = label, hjust = hjust),
    data = dat_header, color = c(rep("black", 4), "white"),
    size = fontsize, fontface = c("bold", rep("plain", 4)), vjust = .5,
    family = "karla"
  ) +
  # Team and Points
  geom_text(aes(x = "Team", y = y, label = Team), data = dat_text, hjust = 0, 
            nudge_x = -.45, size = fontsize, family = "karla") +
  geom_text(aes(y = y, label = value), data = dat_text, size = 8, family = "fira") +
  # Heatmap
  geom_tile(aes(y = y, fill = value), data = dat_heat) +
  geom_text(aes(y = y, label = scales::percent(value, accuracy = 1)),
    data = dat_heat, color = "black",
    hjust = 1, nudge_x = .45, size = fontsize, 
    family = "fira"
  ) +
  geom_text(aes(y = y, label = "<1%"),
    data = filter(dat_heat, is.na(value)), color = "grey80",
    hjust = 1, nudge_x = .45, size = fontsize,
    family = "fira"
  ) +
  # grid and header line
  geom_hline(linewidth = .5, color = "#F0F0F0", yintercept = seq(1.5, 19.5, 1)) +
  geom_hline(linewidth = .5, color = "black", yintercept = .5) +
  scale_x_discrete(
    limits = c("Team", "Points", "İlk_iki", "Playoff", "Küme_Düşme"),
    position = "top", expand = c(0, 0)
  ) +
  scale_y_reverse(breaks = 0:19, expand = c(0, 0)) +
  scale_fill_gradient(low = "#FFF8D3", high = "#FF602F", na.value = NA) +
  labs(x = NULL, y = NULL) +
  guides(fill = "none") +
  theme_minimal() +
  theme(
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    axis.text.y = element_blank(),
    axis.text.x = element_blank(),
    panel.ontop = TRUE
  ) +
  coord_cartesian(clip = "off")

ggsave("foo.png", bg = "white", w = 16, h = 12, unit = "cm")