クラッチタイムの得点効率を徹底比較：エドワーズ／ブランソン／トレイ／ヨキッチ ―― “最後の5分”をどう歩く？クラッチロードを行く4人の決定力【NBA2024-25 レギュラー・シーズン】

※参考＜統計ソフトRに入力するコマンド＞

統計ソフトRのインストール手順をまとめた記事も作成していますので、よろしければご参考ください。

library(BasketballAnalyzeR)
library(gridExtra)
library(dplyr)
library(ggplot2)
dts.PbP.2425 <- read.csv(file="(10-22-2024)-(04-13-2025)-combined-stats.csv")
PbP2425 <- PbPmanipulation(dts.PbP.2425)
df <- PbP2425

PbP_clutch <- df %>%
  filter(
    player %in% c("Anthony Edwards", "Jalen Brunson", "Nikola Jokic", "Trae Young"),
    result %in% c("made", "missed"),
    event_type %in% c("shot", "miss"),
    !is.na(points),
    !is.na(totalTime),
    abs(home_score - away_score) <= 5,
    totalTime >= 2580  # 残り5分以内
  )

PbP_clutch$xx <- PbP_clutch$original_x / -10
PbP_clutch$yy <- PbP_clutch$original_y / 10 - 41.75

# Anthony Edwards
aesc <- shotchart(
  data = subset(PbP_clutch, player == "Anthony Edwards"),
  x = "xx", y = "yy",
  z = "playlength",       # 色にプレイ所要時間をマッピング
  num.sect = 5,
  type = "sectors",
  scatter = FALSE,
  result = "result"
) +
  ggtitle("Anthony Edwards – Clutch Shot Chart") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

aehm <- shotchart(
  data = subset(PbP_clutch, player == "Anthony Edwards"),
  x = "xx", y = "yy",
  type = "density-hexbin", nbins = 30, palette = "bwr"
) +
  ggtitle("Anthony Edwards – Clutch Hexbin Map") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

print(aesc)
print(aehm)

# Jalen Brunson
jbsc <- shotchart(
  data = subset(PbP_clutch, player == "Jalen Brunson"),
  x = "xx", y = "yy",
  z = "playlength",       # 色にプレイ所要時間をマッピング
  num.sect = 5,
  type = "sectors",
  scatter = FALSE,
  result = "result"
) +
  ggtitle("Jalen Brunson – Clutch Shot Chart") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

jbhm <- shotchart(
  data = subset(PbP_clutch, player == "Jalen Brunson"),
  x = "xx", y = "yy",
  type = "density-hexbin", nbins = 30, palette = "bwr"
) +
  ggtitle("Jalen Brunson – Clutch Hexbin Map") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

print(jbsc)
print(jbhm)

# Nikola Jokic
njsc <- shotchart(
  data = subset(PbP_clutch, player == "Nikola Jokic"),
  x = "xx", y = "yy",
  z = "playlength",       # 色にプレイ所要時間をマッピング
  num.sect = 5,
  type = "sectors",
  scatter = FALSE,
  result = "result"
) +
  ggtitle("Nikola Jokic – Clutch Shot Chart") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

njhm <- shotchart(
  data = subset(PbP_clutch, player == "Nikola Jokic"),
  x = "xx", y = "yy",
  type = "density-hexbin", nbins = 30, palette = "bwr"
) +
  ggtitle("Nikola Jokic – Clutch Hexbin Map") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

print(njsc)
print(njhm)

# Trae Young
tysc <- shotchart(
  data = subset(PbP_clutch, player == "Trae Young"),
  x = "xx", y = "yy",
  z = "playlength",       # 色にプレイ所要時間をマッピング
  num.sect = 5,
  type = "sectors",
  scatter = FALSE,
  result = "result"
) +
  ggtitle("Trae Young – Clutch Shot Chart") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

tyhm <- shotchart(
  data = subset(PbP_clutch, player == "Trae Young"),
  x = "xx", y = "yy",
  type = "density-hexbin", nbins = 30, palette = "bwr"
) +
  ggtitle("Trae Young – Clutch Hexbin Map") +
  labs(caption = "Data: NBA 2024-25 Regular Season") +
  scale_x_reverse() + scale_y_reverse()

print(tysc)
print(tyhm)

# 対象データ：すでにフィルタ済みのクラッチデータ
df1 <- PbP_clutch

# クラッチショットからアシスト付き・自力得点を分類
assist_summary <- df1 %>%
  filter(result == "made") %>%
  mutate(assist_type = ifelse(is.na(assist) | assist == "", "Unassisted", "Assisted")) %>%
  group_by(player, assist_type) %>%
  summarise(
    shot_count = n(),
    total_points = sum(points, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  group_by(player) %>%
  mutate(
    shot_pct = round(100 * shot_count / sum(shot_count), 1),
    point_pct = round(100 * total_points / sum(total_points), 1)
  ) %>%
  arrange(player, desc(assist_type))

print(assist_summary)

# プレイヤー名を指定して集計（例：Anthony Edwards）
player_name <- "Anthony Edwards"
player_name <- "Jalen Brunson"
player_name <- "Trae Young"
player_name <- "Nikola Jokic"

df2 <- df %>%
  filter(
    player %in% c("Anthony Edwards", "Jalen Brunson", "Nikola Jokic", "Trae Young"),
    result %in% c("made", "missed"),
    event_type %in% c("shot", "miss", "free throw"),  # ← ここを追加
    !is.na(points),
    !is.na(totalTime),
    abs(home_score - away_score) <= 5,
    totalTime >= 2580  # 残り5分以内
  )

# ① 距離付きフィールドゴール集計（2P, 3P）
df_dist <- df2 %>%
  filter(
    player == player_name,
    !is.na(shot_distance),
    result %in% c("made", "missed"),
    event_type %in% c("shot", "miss")  # FGのみ対象
  ) %>%
  mutate(
    made = ifelse(result == "made", 1, 0),
    range = case_when(
      shot_distance < 5 ~ "0–4 ft (2P)",
      shot_distance < 10 ~ "5–9 ft (2P)",
      shot_distance < 15 ~ "10–14 ft (2P)",
      shot_distance < 20 ~ "15–19 ft (2P)",
      TRUE ~ "20+ ft (3P)"
    )
  )

distance_summary <- df_dist %>%
  group_by(range) %>%
  summarise(
    attempts = n(),
    makes = sum(made),
    FG_percent = round(100 * makes / attempts, 1),
    .groups = "drop"
  ) %>%
  mutate(
    attempt_pct = round(100 * attempts / sum(attempts), 1)
  ) %>%
  arrange(factor(range, levels = c(
    "0–4 ft (2P)", "5–9 ft (2P)", "10–14 ft (2P)", "15–19 ft (2P)", "20+ ft (3P)"
  )))

# ② フリースロー集計（"free throw" event_type使用）
df_ft <- df2 %>%
  filter(
    player == player_name,
    event_type == "free throw",
    result %in% c("made", "missed")
  ) %>%
  mutate(made = ifelse(result == "made", 1, 0))

ft_summary <- df_ft %>%
  summarise(
    range = "Free Throw (FT)",
    attempts = n(),
    makes = sum(made),
    FG_percent = round(100 * makes / attempts, 1),
    attempt_pct = round(100 * attempts / (n() + sum(distance_summary$attempts)), 1)
  )

# ③ 最終的に距離＋FTを結合
final_summary <- bind_rows(distance_summary, ft_summary)

# 結果表示
print(final_summary)

# データフレームの作成
df_attempts <- data.frame(
  Player = rep(c("Anthony Edwards", "Jalen Brunson", "Trae Young", "Nikola Jokic"), each = 6),
  Range = rep(c("0–4 ft", "5–9 ft", "10–14 ft", "15–19 ft", "20+ ft", "FT"), times = 4),
  Attempts = c(
    20, 11, 6, 6, 71, 48,     # Edwards
    20, 13, 18, 13, 38, 47,   # Brunson
    17, 21, 9, 0, 56, 68,     # Young
    33, 29, 7, 4, 15, 48      # Jokic
  )
)

# 距離帯の並び順を定義
range_levels <- c("0–4 ft", "5–9 ft", "10–14 ft", "15–19 ft", "20+ ft", "FT")

# 順序を明示
df_attempts$Range <- factor(df_attempts$Range, levels = range_levels)

# プレイヤー順も明示（前回の並び：Edwards → Brunson → Young → Jokic）
df_attempts$Player <- factor(df_attempts$Player,
                             levels = c("Anthony Edwards", "Jalen Brunson", "Trae Young", "Nikola Jokic")
)

# 描画
ggplot(df_attempts, aes(x = Range, y = Attempts, fill = Player)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(
    title = "Clutch Time Shot Attempts by Distance (Including FT)",
    x = "Shot Distance",
    y = "Number of Attempts",
    fill = "Player"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "right"
  )

# 成功率データ（Attempt_Pct → FG_percent に置き換え）
df_fg <- data.frame(
  Player = rep(c("Anthony Edwards", "Jalen Brunson", "Trae Young", "Nikola Jokic"), each = 6),
  Range = rep(c("0–4 ft", "5–9 ft", "10–14 ft", "15–19 ft", "20+ ft", "FT"), times = 4),
  FG_percent = c(
    50.0, 63.6, 50.0, 33.3, 36.6, 83.3,     # Edwards
    70.0, 61.5, 77.8, 30.8, 34.2, 83.0,     # Brunson
    52.9, 38.1, 55.6, NA,   32.1, 83.8,     # Young（15–19ftは試投ゼロ）
    63.6, 55.2, 57.1, 50.0, 40.0, 72.9      # Jokic
  )
)

# 並び順の定義
range_levels <- c("0–4 ft", "5–9 ft", "10–14 ft", "15–19 ft", "20+ ft", "FT")
player_levels <- c("Anthony Edwards", "Jalen Brunson", "Trae Young", "Nikola Jokic")

# factorで並びを明示
df_fg$Range <- factor(df_fg$Range, levels = range_levels)
df_fg$Player <- factor(df_fg$Player, levels = player_levels)

# 折れ線グラフ：成功率ベース
ggplot(df_fg, aes(x = Range, y = FG_percent, group = Player, color = Player)) +
  geom_line(size = 1) +
  geom_point(size = 2) +
  labs(
    title = "Clutch Time Field Goal Percentage by Distance (Including FT)",
    x = "Shot Distance",
    y = "Field Goal Percentage (%)",
    color = "Player"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  ylim(0, 100)

# ① 対象プレイヤーを指定
players_target <- c("Anthony Edwards", "Jalen Brunson", "Trae Young", "Nikola Jokic")

# ② カラーパレットを明示（視認性重視）
# 明示的なカラーマップを関数で返すようにする
palette_manual <- function(n) {
  cols <- c(
    "Anthony Edwards" = "#E41A1C",
    "Jalen Brunson"   = "#377EB8",
    "Trae Young"      = "#4DAF4A",
    "Nikola Jokic"    = "#984EA3"
  )
  # n の長さで切り出して返す（nより多く指定されると警告が出るのでmin()を使う）
  return(unname(cols[1:min(n, length(cols))]))
}

# ③ 該当プレイヤーのショットデータを抽出
PbP_players <- PbP_clutch %>%
  filter(
    player %in% players_target,
    result != "",
    !is.na(converted_x),
    !is.na(converted_y)
  )

# ④ 期待値得点チャートの描画（expectedptsはbbplotまたは独自関数で定義済みと仮定）
ep_plot <- expectedpts(
  data = PbP_players,
  players = players_target,
  team = FALSE,
  palette = palette_manual,
  col.hline = "transparent"
)

# ⑤ タイトル・凡例付きで表示
ep_plot +
  ggtitle("Expected Points by Shot Distance: 4 Clutch Scorers") +
  labs(
    caption = "Data: NBA 2024-25 Regular Season",
    x = "Shot Distance (ft)",
    y = "Expected Points"
  ) +
  theme_minimal() +
  theme(legend.position = "right")

# 対象プレイヤー
players_target <- c("Anthony Edwards", "Jalen Brunson", "Trae Young", "Nikola Jokic")

# カラーパレットを明示
palette_manual <- function(n) {
  cols <- c(
    "Anthony Edwards" = "#E41A1C",
    "Jalen Brunson"   = "#377EB8",
    "Trae Young"      = "#4DAF4A",
    "Nikola Jokic"    = "#984EA3"
  )
  return(unname(cols[1:min(n, length(cols))]))
}

# クラッチタイムのショットデータ（FGのみ）
PbP_clutch_time <- df %>%
  filter(
    player %in% players_target,
    result != "",
    event_type %in% c("shot", "miss"),
    !is.na(points),
    !is.na(totalTime),
    abs(home_score - away_score) <= 5,
    totalTime >= 2580
  )

# グラフ描画：クラッチ時間に対する期待値得点推移
ep_time <- expectedpts(
  data = PbP_clutch_time,
  var = "totalTime",
  players = players_target,
  team = FALSE,
  bw = 80,  # スムージングの幅（調整可）
  x.range = c(2580, 2880),  # 残り5分（2880秒）〜0秒まで
  col.hline = "transparent",
  palette = palette_manual
)

# タイトル等追加
ep_time +
  ggtitle("Expected Points over Time: Clutch FG Efficiency by Player") +
  labs(
    x = "Game Clock (seconds remaining)",
    y = "Expected Points",
    caption = "Data: NBA 2024-25 Regular Season (Clutch FG only)"
  ) +
  theme_minimal() +
  theme(legend.position = "right")