スタットキャストのデータを使って2023年の大谷の投球を可視化する

今回はMLBのデータベースから大谷のデータを可視化してみます。
以下の本を参考にしました。

https://www.amazon.co.jp/R%E3%81%AB%E3%82%88%E3%82%8B%E3%82%BB%E3%82%A4%E3%83%90%E3%83%BC%E3%83%A1%E3%83%88%E3%83%AA%E3%82%AF%E3%82%B9%E5%85%A5%E9%96%80-Max-Marchi/dp/4297116847

https://www.amazon.co.jp/%E9%87%8E%E7%90%83%E3%83%87%E3%83%BC%E3%82%BF%E3%81%A7%E3%82%84%E3%81%95%E3%81%97%E3%81%8F%E5%AD%A6%E3%81%B9%E3%82%8BPython%E5%85%A5%E9%96%80-%E3%81%84%E3%81%8D%E3%81%AA%E3%82%8A%E3%80%8C%E3%82%B0%E3%83%A9%E3%83%95%E4%BD%9C%E6%88%90%E3%80%8D%E3%80%8C%E9%A1%A7%E5%AE%A2%E5%88%86%E6%9E%90%E3%80%8D%E3%81%8C%E3%81%A7%E3%81%8D%E3%82%8B-%E9%BD%8B%E8%97%A4-%E5%91%A8/dp/453406067X

大谷のデータの可視化は下の本でやっていて、この本はPythonの入門用でしたが今回は自分の好きなRでやってみます。

```R:statcastのデータをダウンロード
#statcastのデータをダウンロードするためのライブラリ
install.packages("devtools")
devtools::install_github("BillPetti/baseballr")
library(baseballr)

#2023年の大谷の投手データをダウンロード
Ohtani_p<-scrape_statcast_savant(start_date = "2023-03-01",
                               end_date="2023-10-31",
                               playerid=660271,
                               player_type ="pitcher")
#次の使用のため保存しておく
write.csv(Ohtani_p,"C:/Users/ユーザー名/Ohtani_p.csv")
glimpse(Ohtani_p)
```
```
> glimpse(Ohtani_p)
Rows: 2,094
Columns: 94
$ pitch_type                      <chr> "FF", "ST", "ST", "FS", "FS", "ST", "FF", "ST", "ST…
$ game_date                       <date> 2023-08-23, 2023-08-23, 2023-08-23, 2023-08-23, 20…
$ release_speed                   <dbl> 94.2, 76.1, 77.2, 90.1, 90.0, 79.8, 92.2, 80.6, 78.…
$ release_pos_x                   <dbl> -1.98, -2.01, -2.05, -1.94, -1.83, -2.17, -1.67, -2…
$ release_pos_z                   <dbl> 5.78, 5.74, 5.60, 5.69, 5.76, 5.70, 5.95, 5.64, 5.6…
$ player_name                     <chr> "Ohtani, Shohei", "Ohtani, Shohei", "Ohtani, Shohei…
$ batter                          <dbl> 687952, 687952, 687952, 687952, 687952, 458015, 668…
$ pitcher                         <dbl> 660271, 660271, 660271, 660271, 660271, 660271, 660…
$ events                          <chr> "", "", "", "", "", "field_out", "walk", "", "", ""…
$ description                     <chr> "foul", "swinging_strike", "swinging_strike", "ball…
$ spin_dir                        <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ spin_rate_deprecated            <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ break_angle_deprecated          <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ break_length_deprecated         <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ zone                            <dbl> 5, 14, 6, 14, 14, 11, 14, 14, 14, 13, 14, 9, 13, 13…
$ des                             <chr> "Christian Encarnacion-Strand grounds into a double…
$ game_type                       <chr> "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "…
$ stand                           <chr> "R", "R", "R", "R", "R", "L", "R", "R", "R", "R", "…
$ p_throws                        <chr> "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "…
$ home_team                       <chr> "LAA", "LAA", "LAA", "LAA", "LAA", "LAA", "LAA", "L…
$ away_team                       <chr> "CIN", "CIN", "CIN", "CIN", "CIN", "CIN", "CIN", "C…
$ type                            <chr> "S", "S", "S", "B", "B", "X", "B", "B", "B", "S", "…
$ hit_location                    <int> NA, NA, NA, NA, NA, 6, NA, NA, NA, NA, NA, 2, NA, N…
$ bb_type                         <chr> "", "", "", "", "", "popup", "", "", "", "", "", ""…
$ balls                           <int> 2, 2, 2, 1, 0, 0, 3, 2, 1, 1, 0, 2, 1, 1, 1, 1, 0, …
$ strikes                         <int> 2, 1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 2, 2, 2, 1, 0, 0, …
$ game_year                       <int> 2023, 2023, 2023, 2023, 2023, 2023, 2023, 2023, 202…
$ pfx_x                           <dbl> -0.61, 1.20, 0.75, -1.41, -1.36, 0.25, -0.15, 1.03,…
$ pfx_z                           <dbl> 1.05, 0.09, 0.55, 0.58, 0.72, 1.12, 1.60, 0.56, 0.6…
$ plate_x                         <dbl> -0.11, 0.89, 0.80, 0.59, 1.29, -1.03, 2.56, 1.91, 1…
$ plate_z                         <dbl> 2.14, 2.39, 2.11, 1.01, 0.18, 2.98, 1.30, 0.99, 0.8…
$ on_3b                           <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ on_2b                           <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ on_1b                           <dbl> 668715, 668715, 668715, 668715, 668715, 668715, NA,…
$ outs_when_up                    <int> 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 2, …
$ inning                          <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, …
$ inning_topbot                   <chr> "Top", "Top", "Top", "Top", "Top", "Top", "Top", "T…
$ hc_x                            <dbl> NA, NA, NA, NA, NA, 98.31, NA, NA, NA, NA, NA, NA, …
$ hc_y                            <dbl> NA, NA, NA, NA, NA, 137.39, NA, NA, NA, NA, NA, NA,…
$ tfs_deprecated                  <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ tfs_zulu_deprecated             <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ fielder_2                       <dbl> 681351, 681351, 681351, 681351, 681351, 681351, 681…
$ umpire                          <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ sv_id                           <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ vx0                             <dbl> 6.2710158, 3.9295742, 4.7352438, 9.3693038, 10.7237…
$ vy0                             <dbl> -136.82562, -110.68789, -112.32252, -130.71915, -13…
$ vz0                             <dbl> -6.07122345, 0.02359945, -1.35002339, -6.85245440, …
$ ax                              <dbl> -9.087423, 8.873675, 5.239909, -18.235704, -17.7337…
$ ay                              <dbl> 33.04721, 24.05326, 23.74440, 29.71527, 27.04930, 2…
$ az                              <dbl> -17.75564, -31.75224, -27.53750, -24.19750, -22.053…
$ sz_top                          <dbl> 3.36, 3.36, 3.36, 3.39, 3.49, 3.40, 3.39, 3.37, 3.3…
$ sz_bot                          <dbl> 1.55, 1.55, 1.55, 1.53, 1.53, 1.60, 1.58, 1.58, 1.6…
$ hit_distance_sc                 <dbl> 211, NA, NA, NA, NA, 175, NA, NA, NA, NA, NA, NA, N…
$ launch_speed                    <dbl> 73.8, NA, NA, NA, NA, 75.3, NA, NA, NA, NA, NA, NA,…
$ launch_angle                    <dbl> 32, NA, NA, NA, NA, 61, NA, NA, NA, NA, NA, NA, NA,…
$ effective_speed                 <dbl> 94.6, 75.7, 77.2, 90.5, 90.8, 80.2, 92.6, 80.7, 79.…
$ release_spin_rate               <dbl> 2289, 1217, 2188, 1000, 1045, 2191, 2165, 2279, 221…
$ release_extension               <dbl> 6.8, 6.5, 6.7, 6.9, 7.0, 6.6, 6.9, 6.6, 6.7, 6.9, 6…
$ game_pk                         <dbl> 716890, 716890, 716890, 716890, 716890, 716890, 716…
$ pitcher_1                       <dbl> 660271, 660271, 660271, 660271, 660271, 660271, 660…
$ fielder_2_1                     <dbl> 681351, 681351, 681351, 681351, 681351, 681351, 681…
$ fielder_3                       <dbl> 592273, 592273, 592273, 592273, 592273, 592273, 592…
$ fielder_4                       <dbl> 650859, 650859, 650859, 650859, 650859, 650859, 650…
$ fielder_5                       <dbl> 500871, 500871, 500871, 500871, 500871, 500871, 500…
$ fielder_6                       <dbl> 623205, 623205, 623205, 623205, 623205, 623205, 623…
$ fielder_7                       <dbl> 545341, 545341, 545341, 545341, 545341, 545341, 545…
$ fielder_8                       <dbl> 666160, 666160, 666160, 666160, 666160, 666160, 666…
$ fielder_9                       <dbl> 592669, 592669, 592669, 592669, 592669, 592669, 592…
$ release_pos_y                   <dbl> 53.65, 54.01, 53.82, 53.64, 53.52, 53.86, 53.60, 53…
$ estimated_ba_using_speedangle   <dbl> NA, NA, NA, NA, NA, 0.017, NA, NA, NA, NA, NA, NA, …
$ estimated_woba_using_speedangle <dbl> NA, NA, NA, NA, NA, 0.015000, 0.695903, NA, NA, NA,…
$ woba_value                      <dbl> NA, NA, NA, NA, NA, 0.0, 0.7, NA, NA, NA, NA, 0.0, …
$ woba_denom                      <int> NA, NA, NA, NA, NA, 1, 1, NA, NA, NA, NA, 1, NA, NA…
$ babip_value                     <int> NA, NA, NA, NA, NA, 0, 0, NA, NA, NA, NA, 0, NA, NA…
$ iso_value                       <int> NA, NA, NA, NA, NA, 0, 0, NA, NA, NA, NA, 0, NA, NA…
$ launch_speed_angle              <int> NA, NA, NA, NA, NA, 3, NA, NA, NA, NA, NA, NA, NA, …
$ at_bat_number                   <dbl> 11, 11, 11, 11, 11, 10, 9, 9, 9, 9, 9, 3, 3, 3, 3, …
$ pitch_number                    <dbl> 5, 4, 3, 2, 1, 1, 5, 4, 3, 2, 1, 6, 5, 4, 3, 2, 1, …
$ pitch_name                      <chr> "4-Seam Fastball", "Sweeper", "Sweeper", "Split-Fin…
$ home_score                      <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, …
$ away_score                      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ bat_score                       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ fld_score                       <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, …
$ post_away_score                 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ post_home_score                 <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, …
$ post_bat_score                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ post_fld_score                  <dbl> 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, …
$ if_fielding_alignment           <chr> "Standard", "Standard", "Standard", "Standard", "St…
$ of_fielding_alignment           <chr> "Standard", "Standard", "Standard", "Standard", "St…
$ spin_axis                       <dbl> 204, 65, 69, 317, 191, 105, 203, 46, 85, 313, 211, …
$ delta_home_win_exp              <dbl> 0.000, 0.000, 0.000, 0.000, 0.000, 0.036, -0.039, 0…
$ delta_run_exp                   <dbl> 0.000, -0.064, -0.072, 0.063, 0.042, -0.361, 0.232,…
$ bat_speed                       <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
$ swing_length                    <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,…
```
列数だけでも94ありかなり膨大なデータセットです。

2022年のデータであれば著者が運営しているnoteからデータもダウンロードできます。

https://note.com/amapen/n/n86c90e2c09d1

まずは球種ごとの投球数を見ていきます。

```R:
#球種ごとの投球数をカウント
Ohtani_pitch <- Ohtani_p %>%
  group_by(pitch_type) %>%
  summarise(count = n()) %>% 
  arrange(desc(count))

#球種ごとの投球数を棒グラフにする
ggplot(Ohtani_pitch, aes(x = pitch_type, y = count, fill = pitch_type)) +
  geom_bar(stat = "identity") +
  scale_fill_brewer(palette = "Set1")  # カラーパレットを指定
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/c763dcb9-c4c6-9a92-1983-3f170d1a1fd8.png)

FFはストレート、CUはカーブ、FCはカットボール、FSはスプリット、SIはシンカー、SLはスライダー、 STはスイーパーです。
ほとんどストレートとスイーパーですね。

ところで、スライダーとスイーパーの違いについて調べてみましたが、
スイーパーは128km以上の球速で、25cm以上横に曲がり、縦の変化が10cm以上沈まないものをいうそうです。要はめっちゃ横に曲がるスライダーですね。

https://note.com/baseball_namiki/n/n9fdb8fab3aa2

年グラフも描いてみます。
```R:
#円グラフの作成
ggplot(Ohtani_pitch, aes(x = "", y = count, fill = pitch_type)) +
  geom_bar(stat = "identity", width = 1, color = "black") +
  coord_polar(theta = "y") +
  labs(title = "大谷投手の投球割合", x = "", y = "") +
  theme_void()+
  geom_text(aes(label = pitch_type), 
              position = position_stack(vjust = 0.5))+
  theme(legend.position = "none")
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/f9075ea2-c1c2-f1e6-b5ea-6542b3100f4a.png)

今度は球速のデータを見てみます。
```r:
#球速の単位を変換
Ohtani_p %>% 
  mutate(release_speedkm=release_speed*1.61)->
  Ohtani_p

#球種を日本語に変更
Ohtani_p$pitch_type <- recode(Ohtani_p$pitch_type, "FF" = "ストレート", "CU" = "カーブ", "FS" = "スプリット", "FC" = "カット", "SI" = "シンカー", "SL" = "スライダー", "ST" = "スイーパー")

Ohtani_p %>%
  filter(pitch_type=="ストレート") %>% 
  group_by(inning) %>%
  summarise(speed = mean(release_speedkm)) %>% 
  ggplot(aes(x = inning, y = speed )) +
  geom_line() +
  labs(title = "大谷のイニング別の球速", x = "イニング", y = "球速") +
  theme_bw()+
  theme(legend.position = "none")+
  scale_x_continuous(breaks = seq(1, 9, by = 1)) 
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/0f0f13af-28ee-5abd-9df2-831c1bb5203c.png)

6回で急に球速が落ちるものの（といっても下げ幅は1キロ程度）7回以降は再び持ち直し8回で最速になっています。
8回以降まで投げることはほとんどないので調子がいいときのバイアスになってそうです。
投球日ごとに細かくみてみます。

```R:
#投球日ごとにイニング毎の球速を表示
Ohtani_p %>%
  filter(pitch_type=="ストレート") %>% 
  group_by(game_date,inning) %>%
  summarise(speed = mean(release_speedkm)) %>% 
  ggplot(aes(x = inning, y = speed )) +
  geom_line() +
  labs(title = "大谷のイニング別の球速", x = "イニング", y = "球速") +
  theme_bw()+
  theme(legend.position = "none")+
  scale_x_continuous(breaks = seq(1, 9, by = 1)) +
  facet_wrap(~game_date)
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/3bdf6382-4eb1-13b2-306b-56d44aaeef21.png)


日によって結構パターンがばらついてますが、登板日の3分1くらいは6～7回から落ちてくる傾向がありますね。

こうなるとイニング毎の球種割合もみてみたくなります。
```
#投球日ごとにイニング毎の球種割合を表示
Ohtani_p %>%
  group_by(game_date,inning,pitch_type) %>%
  summarise(count = n()) %>%
  mutate(percentage = count / sum(count) * 100) %>% 
  ggplot(aes(x = inning, y = percentage,fill=pitch_type )) +
  geom_bar(stat = "identity") +
  labs(title = "大谷のイニング別の球種割合", x = "イニング", y = "球種別の投球割合") +
  theme_bw()+
  scale_x_continuous(breaks = seq(1, 9, by = 1)) +
  facet_wrap(~game_date)
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/7de3580a-e233-029b-2aa9-603d567c5272.png)


今度は球種ごとの球速を見てみます。
```
#球種ごとの球速
ggplot(Ohtani_p, aes(x = release_speedkm, fill = pitch_type)) +
  geom_histogram( alpha = 0.7) +
  labs(title = "大谷の球種別の球速", x = "球速", y = "頻度") +
  theme_bw()+
  theme(legend.position = c(0.1, 0.7))
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/553d168b-4521-6042-b310-6583468b62ff.png)

かぶってわかりにくいので箱ひげ図にします。
```
#球種ごとの球速の箱ひげ図の作成
ggplot(Ohtani_p, aes(x = pitch_type, y = release_speedkm, fill = pitch_type)) +
  geom_boxplot() +
  labs(title = "大谷の球種別の球速", x = "球種", y = "球速") +
  theme_bw()+
  theme(legend.position = "none")
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/58f4fda8-92e4-438d-14bc-95f323a0152b.png)

```
#投球位置の単位を変更
Ohtani_p %>% 
  mutate(plate_x_cm=plate_x*30.48) %>% 
  mutate(plate_z_cm=plate_z*30.48)->
  Ohtani_p

#ストレートの位置をプロット
Ohtani_p %>%
  filter(pitch_type=="ストレート") %>% 
  ggplot()+
  geom_point(aes(x = plate_x_cm, y = plate_z_cm))+
  geom_rect(aes(xmin = -30, xmax = 30, ymin = 50, ymax = 110), 
            fill = NA, color = "red")+
  coord_fixed() +
  labs(title = "大谷のストレートの投球位置", x = "投球のコース(cm)", y = "投球の高さ(cm)") +
  theme_bw()
  ```

  ![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/503998e9-c5b7-6dc1-1348-7130fe94e08b.png)

投手目線でなく捕手目線なので注意が必要です。
つまりプラスが1塁側でマイナスが三塁側になります。

```
#空振りと見逃しに絞ってプロット
Ohtani_p %>%
  filter(pitch_type=="ストレート") %>% 
  filter(description=="called_strike"|description=="swinging_strike") %>% 
  ggplot()+
  geom_point(aes(x = plate_x_cm, y = plate_z_cm,color=description))+
  geom_rect(aes(xmin = -30, xmax = 30, ymin = 50, ymax = 110), 
            fill = NA, color = "red")+
  labs(title = "大谷のストレートの投球位置", x = "投球のコース(cm)", y = "投球の高さ(cm)",color="投球の結果") +
  theme_bw()+
  coord_fixed() +
  scale_x_continuous(limits = c(-80, 80, by = 25)) +
  scale_y_continuous(limits = c(-0, 150, by = 25)) 
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/8618bcb8-b931-3832-c41d-54a6056a252e.png)



```
# 9つのゾーンにストライクゾーンを分割する
# ストライクゾーンのデータだけを抽出
strike_zone_data <- Ohtani_p %>%
  filter(plate_x_cm >= -30 & plate_x_cm<= 30,   # x軸方向の範囲（-30 ~ 30）
         plate_z_cm >= 50 & plate_z_cm <= 110)   # y軸方向の範囲（50 ~ 110）

# x軸方向を -30 ~ 30, y軸方向を 50 ~ 110 の範囲で3x3のグリッドに分割
data_grid <- strike_zone_data %>%
  filter(pitch_type=="ストレート") %>% 
  mutate(
    x_zone = cut(plate_x_cm, breaks = c(-30, -10, 10, 30), labels = c("left", "middle", "right")),
    y_zone = cut(plate_z_cm, breaks = c(50, 70, 90, 110), labels = c("low", "middle", "high")),
    zone = paste(x_zone, y_zone, sep = "_")
  )

# コース毎に投球数を集計
zone_data <- data_grid %>%
  group_by(zone) %>%
  summarise(count = n()) %>%
  mutate(percentage = count / sum(count)) %>%  # 投球割合を計算
  ungroup()

# ヒートマップ用のゾーン位置データを作成
heatmap_data <- expand.grid(x = c(-20, 0, 20), y = c(60, 80, 100))
heatmap_data$zone <- c("left_low", "middle_low", "right_low",
                       "left_middle", "middle_middle", "right_middle",
                       "left_high", "middle_high", "right_high")

# 集計データとヒートマップ用の位置データを結合
heatmap_data <- merge(heatmap_data, zone_data, by = "zone", all.x = TRUE)
heatmap_data$count[is.na(heatmap_data$count)] <- 0  # NA値を0に変換

# ヒートマップを作成
ggplot(heatmap_data, aes(x = x, y = y)) +
  geom_tile(aes(fill = percentage), color = "white") +
  scale_fill_gradient(low = "white", high = "red",labels = scales::percent_format()) +
  coord_fixed() +
  labs(title = "ストレートのコース別投球割合",x = "",y = "",
       fill = "投球割合") +
  theme_minimal()+
  scale_x_continuous(breaks = c(-20, 0, 20),   # 任意のx軸の目盛り
                     labels = c("三塁側", "真ん中", "一塁側")) +  # x軸のラベル
  scale_y_continuous(breaks = c(60, 80, 100),    # 任意のy軸の目盛り
                     labels = c("低め", "真ん中", "高め"))   # y軸のラベル
```

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/024f3dc4-1e16-ab31-3cfd-300c16b96920.png)


いろいろなデータに対応できるよう関数化します。
```
# 投球割合をヒートマップとして表示する関数
plot_pitch_heatmap <- function(data,title) {
  
  # ストライクゾーンの範囲を定義
  strike_zone_data <- data %>%
    filter(plate_x_cm >= -30 & plate_x_cm<= 30,   # x軸方向の範囲（-30 ~ 30）
           plate_z_cm >= 50 & plate_z_cm <= 110)   # y軸方向の範囲（50 ~ 110）
  
  # ゾーン別に集計して投球割合を計算
  zone_data <- strike_zone_data %>%
    filter(pitch_type=="ストレート") %>% 
    mutate(
      x_zone = cut(plate_x_cm, breaks = c(-30, -10, 10, 30), labels = c("left", "middle", "right")),
      y_zone = cut(plate_z_cm, breaks = c(50, 70, 90, 110), labels = c("low", "middle", "high")),
      zone = paste(x_zone, y_zone, sep = "_")
    ) %>%
    group_by(zone) %>%
    summarise(count = n()) %>%
    mutate(percentage = count / sum(count))  # 投球割合を計算
  
  # ヒートマップ用のゾーン位置データを作成
  heatmap_data <- expand.grid(x = c(-20, 0, 20), y = c(60, 80, 100))
  heatmap_data$zone <- c("left_low", "middle_low", "right_low",
                         "left_middle", "middle_middle", "right_middle",
                         "left_high", "middle_high", "right_high")
  
  # 集計データとヒートマップ用の位置データを結合
  heatmap_data <- merge(heatmap_data, zone_data, by = "zone", all.x = TRUE)
  heatmap_data$count[is.na(heatmap_data$count)] <- 0  # NA値を0に変換
  
  # 投球割合のヒートマップを作成
  ggplot(heatmap_data, aes(x = x, y = y)) +
    geom_tile(aes(fill = percentage), color = "white") +
    scale_fill_gradient(low = "white", high = "red", labels = scales::percent_format()) +
    coord_fixed() +
    labs(title = title,x = "",y = "",
         fill = "投球割合") +
    theme_minimal()+
    scale_x_continuous(breaks = c(-20, 0, 20),   # 任意のx軸の目盛り
                       labels = c("三塁側", "真ん中", "一塁側")) +  # x軸のラベル
    scale_y_continuous(breaks = c(60, 80, 100),    # 任意のy軸の目盛り
                       labels = c("低め", "真ん中", "高め"))   # y軸のラベル
}
```

作成した関数を使って右打者と左打者でわけてみてみます。
```
#右打者への投球データ
Ohtani_p_r <- Ohtani_p %>%
  filter(pitch_type=="ストレート") %>% 
  filter(stand=="R") 

Ohtani_p_l <- Ohtani_p %>%
  filter(pitch_type=="ストレート") %>% 
  filter(stand=="L")  

# 関数を使用してデータをヒートマップにする
library(patchwork)
plotR<-plot_pitch_heatmap(Ohtani_p_r,"ストレートのコース別投球割合(右打者)")
plotL<-plot_pitch_heatmap(Ohtani_p_l,"ストレートのコース別投球割合(左打者)")

combined_plot <- plotL + plotR

# グラフを表示
print(combined_plot)
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/9fc6b45f-5655-37e5-2000-8754971b9e51.png)

右打者のインコ－ス高めと低めはデッドボールの危険があるからかやはりほとんどないですね。
アウトコース高めも少ないのは右方向のホームランの危険があるからかもですね。
左打者もインコース高めはほとんどないですね。
一方で低めはアウトコースよりインコースがかなり多くなってます。



今度はリリースの位置を球種別に見てみます。

```
#リリース位置のデータをcmに変換
Ohtani_p %>% 
  mutate(release_pos_x_cm=release_pos_x*30.48) %>% 
  mutate(release_pos_z_cm=release_pos_z*30.48)->
  Ohtani_p

#球種別のリリース位置の箱ひげ図
Ohtani_p %>% 
  ggplot(aes(x = pitch_type, y =release_pos_x_cm )) +
  geom_boxplot() +
  labs(title = "球種別のリリース位置(左右)", x = "球種", y = "左右リリース位置(cm)") +
  theme_bw()+
  theme(legend.position = "none")+ 
  coord_flip()

Ohtani_p %>% 
  ggplot(aes(x = pitch_type, y =release_pos_z_cm )) +
  geom_boxplot() +
  labs(title = "球種別のリリース位置(高さ)", x = "球種", y = "上下リリース位置(cm)") +
  theme_bw()+
  theme(legend.position = "none")
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/fac4ebcc-33d0-c71d-bfbd-7405e94d45e5.png)
マイナスが三塁側、プラスが一塁側なので注意です。
スイーパーやカットボールは三塁側よりで、カーブはホームベースに近い位置からリリースしています。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3635830/1fb1c515-8b8c-d7a2-a67b-067216bc640e.png)