［目次］

はじめに
本題
テストデータで検証
- 予測結果データの確認
  - セ・リーグ
    - 捕手
    - 一塁手
    - 二塁手
    - 三塁手
    - 遊撃手
    - 外野手
  - パ・リーグ
    - 捕手
    - 一塁手
    - 二塁手
    - 三塁手
    - 遊撃手
    - 外野手
    - 指名打者
    - 結果
- まとめ

はじめに

今年のプロ野球も終わり、先日、ベストナインが発表されましたね。

Ｑ. 突然ですが、ベストナインってどうやって選出されるかご存知でしょうか？　　

Ａ.
選出する人　・・・　全国の新聞、通信、放送各社に所属しており、5年以上プロ野球を担当している人

選出人数　・・・　19人　各リーグの守備位置から1人ずつ（パリーグは＋指名打者）

選出基準　・・・　規定打席、規定投球回数などの基準はなく、その年に好成績を収めた選手

プロ野球を見るプロの方々が選んでいるんですね。

トリプルスリーとか三冠王みたいに明確な基準がなく、

""“「記者」がその年に「好成績」を収めたと思う選手を選ぶ”""

ということで、記録にも記憶にも残る選手が選ばれそうですね。

でも、、、

この「好成績」って何を指してるんですかね。

うーん、気になる。。。

本題

ということで、

今回はこの「好成績」を定義していきたいと思います。

使用したデータ

NPBでは、ベストナインはゴールデングラブ賞があるせいか
打撃・走塁面で優秀な成績を残した選手が選ばれる傾向が強いそうです。

なので、

前回の記事でスクイレピングしてきたBaseball Referenceの打撃成績データ
ベストナインの投票結果データ

上記のデータからベストナインに選ばれるには
どれくらいの成績が必要なのかを見ていきたいと思います。

そして、さらに、15〜17年のデータから18年のベストナインが予測できるのかまでやってみます。

データの読み込み

※inputフォルダに諸々のデータが入ってる状態です

ここで使用するコードはgithubに公開していますので、必要に応じて参照してください。

> library("tidyverse")
> 
> # Baseball Referenceのデータの読み込み
> bat_files <- dir("input/", full.names = T) %>% str_subset("Batting201[5-8].csv")
> bat_tmp <- list()
> for(i in 1:length(bat_files)){
+   bat_tmp <- c(bat_tmp, list(
+     read_csv(bat_files[i], locale = locale(encoding = "cp932"))
+   ))
+ }
> batting <- bind_rows(bat_tmp)
> rm(i, bat_tmp, bat_files)
> glimpse(batting)

    ## Observations: 1,838
    ## Variables: 28
    ## $ Rk   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17...
    ## $ Name <chr> "Ryuichiro Akada*", "Kazuyuki Akasaka", "Masahiro Araki",...
    ## $ Age  <dbl> 27, 25, 37, 26, 26, 34, 26, 24, 20, 32, 27, 25, 24, 28, 2...
    ## $ G    <dbl> 1, 35, 97, 43, 41, 118, 79, 42, 4, 138, 130, 9, 2, 3, 107...
    ## $ PA   <dbl> 1, 49, 238, 43, 165, 315, 185, 1, 5, 547, 559, 7, 2, 2, 3...
    ## $ AB   <dbl> 1, 43, 211, 38, 140, 275, 169, 1, 5, 498, 491, 7, 2, 2, 3...
    ## $ R    <dbl> 0, 2, 23, 3, 16, 28, 12, 0, 0, 54, 76, 1, 0, 0, 30, 8, 0,...
    ## $ H    <dbl> 0, 14, 53, 6, 38, 81, 41, 0, 0, 135, 139, 0, 0, 0, 89, 24...
    ## $ `2B` <dbl> 0, 2, 10, 0, 4, 9, 6, 0, 0, 27, 27, 0, 0, 0, 6, 1, 0, 0, ...
    ## $ `3B` <dbl> 0, 0, 0, 0, 0, 3, 2, 0, 0, 2, 3, 0, 0, 0, 2, 1, 0, 0, 1, ...
    ## $ HR   <dbl> 0, 0, 0, 1, 4, 6, 6, 0, 0, 11, 13, 0, 0, 0, 0, 2, 0, 0, 8...
    ## $ RBI  <dbl> 0, 8, 13, 1, 14, 45, 23, 0, 0, 58, 53, 0, 0, 0, 12, 7, 0,...
    ## $ SB   <dbl> 0, 2, 9, 0, 3, 3, 0, 0, 0, 5, 11, 1, 0, 0, 9, 1, 0, 0, 11...
    ## $ CS   <dbl> 0, 0, 1, 0, 3, 0, 0, 0, 0, 3, 7, 0, 0, 0, 8, 0, 0, 0, 0, ...
    ## $ BB   <dbl> 0, 6, 20, 4, 11, 23, 14, 0, 0, 35, 64, 0, 0, 0, 15, 3, 0,...
    ## $ SO   <dbl> 0, 8, 31, 8, 25, 69, 62, 0, 2, 106, 86, 3, 1, 2, 44, 33, ...
    ## $ BA   <dbl> 0.000, 0.326, 0.251, 0.158, 0.271, 0.295, 0.243, 0.000, 0...
    ## $ OBP  <dbl> 0.000, 0.408, 0.315, 0.238, 0.348, 0.349, 0.297, 0.000, 0...
    ## $ SLG  <dbl> 0.000, 0.372, 0.299, 0.237, 0.386, 0.415, 0.408, 0.000, 0...
    ## $ OPS  <dbl> 0.000, 0.780, 0.613, 0.475, 0.734, 0.763, 0.706, 0.000, 0...
    ## $ TB   <dbl> 0, 16, 63, 9, 54, 114, 69, 0, 0, 199, 211, 0, 0, 0, 99, 3...
    ## $ GDP  <dbl> 0, 0, 1, 0, 1, 4, 7, 0, 0, 13, 5, 1, 0, 0, 3, 2, 0, 0, 13...
    ## $ HBP  <dbl> 0, 0, 0, 0, 7, 2, 0, 0, 0, 0, 3, 0, 0, 0, 2, 0, 0, 0, 5, ...
    ## $ SH   <dbl> 0, 0, 6, 1, 4, 11, 0, 0, 0, 10, 1, 0, 0, 0, 27, 5, 1, 0, ...
    ## $ SF   <dbl> 0, 0, 1, 0, 3, 4, 2, 0, 0, 4, 0, 0, 0, 0, 1, 0, 0, 0, 6, ...
    ## $ IBB  <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 2, ...
    ## $ Team <chr> "Chunichi Dragons", "Chunichi Dragons", "Chunichi Dragons...
    ## $ Year <dbl> 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 201...


> # ベストナインのデータの読み込み（英語名は頑張って手動でくっつけた）
> # 投手は対象外
> bestnine <- read_csv("input/bestnine.csv", locale = locale(encoding = "cp932")) %>% 
+   filter(position != "投手")
> glimpse(bestnine)

    ## Observations: 282
    ## Variables: 8
    ## $ year     <dbl> 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015,...
    ## $ league   <chr> "se", "se", "se", "se", "se", "se", "se", "se", "se",...
    ## $ position <chr> "捕手", "捕手", "捕手", "捕手", "一塁手", "一塁手", "一塁手", "一塁手", "...
    ## $ team     <chr> "ヤ", "巨", "広", "広", "ヤ", "ディ", "広", "巨", "神", "中", "ヤ...
    ## $ name     <chr> "中村 悠平", "阿部 慎之助", "會澤 翼", "石原 慶幸", "畠山 和洋", "Ｊ．ロペス",...
    ## $ name_en  <chr> "Yuhei Nakamura", "Shinnosuke Abe*", "Tsubasa Aizawa"...
    ## $ vote     <dbl> 258, 1, 1, 1, 242, 10, 6, 1, 1, 1, 258, 3, 257, 4, 17...
    ## $ flag     <dbl> 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0,...

データ傾向の確認

データを読み込めたので、次にどれくらい票を獲得できると受賞できるのか見てみます。

> # 15〜17年の分布を見てみる
> ggplot(bestnine %>% filter(year <= 2017),
+        aes(vote, group = flag, fill = factor(flag))) +
+   geom_density(alpha = .3) +
+   facet_wrap(~league)

f:id:tsuyu_pon:20181227153323p:plain

（´-`）.｡oO（もっと重なりが大きいかと思ったけど、思ったより票が割れてないみたい）

だいたい100票獲得（約3割）が一つの目安という感じですね

ベストナインに選ばれるかどうかを回帰モデルで考えるとすると、
例えば年×リーグ×ポジションごとに無理やり条件付きロジットに
落とし込むなどが考えられますが、今回はシンプルに

100票以上票を獲得するにはどれくらいの成績が必要か

という二値分類の問題にし、
これを二項ロジスティック回帰で解いてみたいと思います。

なお、年とリーグの影響は、
年×リーグごとに成績を偏差値に変換することで考慮することにしました。

> # 分析用データのベースを作成
> 
> bestnine_uni <- bestnine %>% 
+   mutate(flag = (vote>=100) * 1) %>%  # 100票以上獲得者にフラグ
+   select(name_en, league, year, flag) %>% 
+   group_by(name_en, league, year) %>% 
+   summarise(flag = max(flag)) %>% # 選手ごとにユニークなデータにする
+   ungroup
> 
> DV <- function(x) scale(x) * 10 + 50 # 偏差値変換
> dat <- batting %>% 
+   left_join(bestnine_uni, by = c("Name" = "name_en", "Year" = "year")) %>%
+   arrange(Team, league) %>% 
+   fill(league) %>% 
+   mutate(flag = if_else(is.na(flag), 0, flag)) %>% 
+   filter(PA >= 443 * 1/2) %>% 
+   group_by(Year, league) %>% 
+   mutate_at(vars(G:TB), DV) %>% 
+   as.data.frame
> # 出場機会が多かった選手の中での偏差値を出したいので
> # 規定打席1/2以上の選手にしぼった
> 
> # 分析用データを作成
> train <- dat %>% filter(Year != 2018)
> test <- dat %>% filter(Year == 2018)
> 
> # 何人いるか確認
> table(train$flag)
    ## 
    ##   0   1 
    ## 273  52
> table(test$flag)
    ## 
    ##   0   1 
    ## 100  18
> # だいたいベストナインの人数と一致している

ロジスティック回帰

今回は、打撃・走塁面で表現してみるということで三冠王・トリプルスリーに関連した

打率
本塁打数
打点
盗塁数

を使ってロジスティック回帰してみます。

> vari <- c("BA", "HR", "RBI", "SB")
> glm_res <- glm(data = train %>% select_(.dots = c("flag", vari)),
+                formula = flag~., family = "binomial")
> summary(glm_res)
    ## 
    ## Call:
    ## glm(formula = flag ~ ., family = "binomial", data = train %>% 
    ##     select_(.dots = c("flag", vari)))
    ## 
    ## Deviance Residuals: 
    ##     Min       1Q   Median       3Q      Max  
    ## -1.8293  -0.4674  -0.2589  -0.1128   3.4027  
    ## 
    ## Coefficients:
    ##              Estimate Std. Error z value Pr(>|z|)    
    ## (Intercept) -14.82369    1.98291  -7.476 7.68e-14 ***
    ## BA            0.07490    0.02199   3.406 0.000658 ***
    ## HR           -0.03272    0.03587  -0.912 0.361663    
    ## RBI           0.16080    0.04084   3.937 8.25e-05 ***
    ## SB            0.04223    0.01654   2.553 0.010688 *  
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## (Dispersion parameter for binomial family taken to be 1)
    ## 
    ##     Null deviance: 285.79  on 324  degrees of freedom
    ## Residual deviance: 188.88  on 320  degrees of freedom
    ## AIC: 198.88
    ## 
    ## Number of Fisher Scoring iterations: 6

（´-`）.｡oO（HRの偏回帰係数が有意にならない）

> # 相関係数を見てみる
> train %>% select_(.dots = vari) %>% cor %>% round(2)
    ##       BA    HR  RBI    SB
    ## BA  1.00  0.30 0.41  0.26
    ## HR  0.30  1.00 0.89 -0.02
    ## RBI 0.41  0.89 1.00  0.03
    ## SB  0.26 -0.02 0.03  1.00

HRを打てば打率も打点も上がるので、相関が高くなっており、これが影響しているようです。

試しにステップワイズ法で変数選択してみます。

> # ステップワイズ
> summary(step(glm_res))
    ## Start:  AIC=198.88
    ## (中略)
    ## Call:
    ## glm(formula = flag ~ BA + RBI + SB, family = "binomial", data = train %>% 
    ##     select_(.dots = c("flag", vari)))
    ## 
    ## Deviance Residuals: 
    ##     Min       1Q   Median       3Q      Max  
    ## -1.6650  -0.4736  -0.2551  -0.1152   3.4126  
    ## 
    ## Coefficients:
    ##              Estimate Std. Error z value Pr(>|z|)    
    ## (Intercept) -15.15149    1.97104  -7.687 1.51e-14 ***
    ## BA            0.07842    0.02162   3.628 0.000285 ***
    ## RBI           0.12936    0.02099   6.162 7.17e-10 ***
    ## SB            0.04430    0.01642   2.698 0.006976 ** 
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## (Dispersion parameter for binomial family taken to be 1)
    ## 
    ##     Null deviance: 285.79  on 324  degrees of freedom
    ## Residual deviance: 189.71  on 321  degrees of freedom
    ## AIC: 197.71
    ## 
    ## Number of Fisher Scoring iterations: 6

と本塁打数HRを抜いたモデルで偏回帰係数が全て有意になりました。

有意になった変数を使えばいいってものでもないし、ベストナインの分析をしたいのにHRの影響を除くのは気持ち悪いですよね…。

主成分分析

そこで、上記の変数を使って主成分分析をし、
新たな変数として打力・走力を表現してみたいと思います。

> rownames(train) <- with(train, paste(Year, Name, sep="_"))
> pca <- prcomp(train %>% select_(.dots = vari), center = T, scale. = T)
> summary(pca)
    ## Importance of components:
    ##                           PC1    PC2    PC3     PC4
    ## Standard deviation     1.4577 1.0684 0.7947 0.31985
    ## Proportion of Variance 0.5312 0.2854 0.1579 0.02558
    ## Cumulative Proportion  0.5312 0.8165 0.9744 1.00000
> round(pca$rotation, 2)
    ##     PC1   PC2   PC3   PC4
    ##BA  0.42 -0.46 -0.78  0.11
    ##HR  0.62  0.26  0.28  0.68
    ##RBI 0.65  0.17  0.16 -0.72
    ##SB  0.10 -0.83  0.54  0.01
# 一部を可視化してみる
> tmp_pca <- pca
> tmp_pca$x <- pca$x[sample(1:nrow(pca$x), 80),]
> (p <- factoextra::fviz_pca_biplot(X = tmp_pca, repel = T, 
>                                   col.var = "red", col.ind = "#696969"))

f:id:tsuyu_pon:20190112143627p:plain

rotationから
第1主成分が打力(大きいほど良い)、
第2主成分が走力(小さいほど良い)と
言えそうです。

累積寄与率も第2主成分までで81.7％あるので大きな情報の損失はなさそうです。

主成分分析の結果でロジスティック回帰

この結果を使って改めて回帰してみます。

> train_pca <- train %>% 
+   select(Year, league, Team, Name, flag, PA) %>% 
+   cbind(pca$x) %>% 
+   mutate(PC2 = -PC2) # わかりやすくするため走力は大きいほど良い値に変換
> 
> glm_res <- glm(data = train_pca, formula = flag~PC1+PC2, family = "binomial")
> summary(glm_res)
    ## 
    ## Call:
    ## glm(formula = flag ~ PC1 + PC2, family = "binomial", data = train_pca)
    ## 
    ## Deviance Residuals: 
    ##     Min       1Q   Median       3Q      Max  
    ## -1.3727  -0.4893  -0.2758  -0.1377   3.3106  
    ## 
    ## Coefficients:
    ##             Estimate Std. Error z value Pr(>|z|)    
    ## (Intercept)  -2.4394     0.2534  -9.628  < 2e-16 ***
    ## PC1           1.1453     0.1588   7.215 5.41e-13 ***
    ## PC2           0.5069     0.1498   3.384 0.000715 ***
    ## ---
    ## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
    ## 
    ## (Dispersion parameter for binomial family taken to be 1)
    ## 
    ##     Null deviance: 285.79  on 324  degrees of freedom
    ## Residual deviance: 196.12  on 322  degrees of freedom
    ## AIC: 202.12
    ## 
    ## Number of Fisher Scoring iterations: 6

選手 $i$ が100票以上得票する確率 $p_i$ は

$\displaystyle p_i = \frac{1}{1+e^{-(-2.44　+　1.15 PC1_i　+　0.51 PC2_i)}}$

の式で表現できることがわかりました。

次にこのモデルの精度を確認していきます。

> # 結果の可視化
> baseline <- sum(glm_res$y==1)/length(glm_res$y) # ベースライン
> tmp <- data.frame(x = glm_res$linear.predictors, 
+                   y = glm_res$y,
+                   pred = predict(glm_res, type = "response")) %>%  
+                mutate(pred_y = (pred >= baseline) * 1)
> ggplot(tmp, aes(x, y)) +
+   geom_point(aes(col = factor(pred_y))) +
+   geom_smooth(method = "glm", method.args = list(family = "binomial")) +
+   geom_hline(yintercept = baseline) +
+   geom_vline(xintercept = log(baseline/(1-baseline)))

f:id:tsuyu_pon:20181227155750p:plain

> # 精度確認
> (accuracy <- round(prop.table(table(tmp$y, tmp$pred_y), margin = 1), 2)) # 横比
    ##    
    ##           0      1
    ##   0 0.80 0.20
    ##   1 0.25 0.75
> sum(diag(accuracy))/sum(accuracy)
    ## [1] 0.775

まずまずの精度のモデルが得られました。

テストデータで検証

上記のモデルの結果を2018年のデータに適用してみます。

> test_pca <- test %>% 
+   select(Year, league, Team, Name) %>% 
+   cbind(predict(pca, test %>% select_(.dots = vari))) %>% 
+   mutate(PC2 = -PC2) %>% 
+   left_join(bestnine_uni, by = c("Name" = "name_en", "Year" = "year")) %>% 
+   mutate(flag = if_else(is.na(flag), 0, flag))
> 
> test_pred <- predict(glm_res, test_pca, type = "response") >= baseline
> (test_accuracy <- round(prop.table(table(test_pca$flag, test_pred), margin = 1), 2))
    ##   test_pred
    ##    FALSE TRUE
    ##  0  0.78 0.22
    ##  1  0.11 0.89
> sum(diag(test_accuracy))/sum(test_accuracy)
    ## [1] 0.835

だいぶ精度よく予測できました。使えそうです。

予測結果データの確認

上記で得られた結果を基に、手動で守備位置に割り振って実際の予測精度を見てみます。（大変だった）

> res <- test_pca %>% 
+   select(-PC3, -PC4) %>% 
+   mutate(pred = predict(glm_res, test_pca, type = "response"), 
+          pred_flag = (pred >= baseline) * 1)

セ・リーグ

捕手

Team	Name	打力	走力	正解	予測確率	予測値
Hiroshima Carp	Tsubasa Aizawa	0.10	-0.19	1	0.08	0

これはさすがに外れる（泣

一塁手

Team	Name	打力	走力	正解	予測確率	予測値
Chunichi Dragons	Dayan Viciedo	2.72	-0.03	1	0.66	1
Yomiuri Giants	Kazuma Okamoto	2.70	-0.78	0	0.56	1
Yokohama Bay Stars	Jose Lopez	1.49	-0.92	0	0.23	1
Hiroshima Carp	Ryuhei Matsuyama*	0.81	-0.19	0	0.17	1

岡本はファースト、サード、外野で票が割れてしまったのがもったいなかったですね。
2019年は丸、ビヤヌエバが来ましたし、岡本はサードですかね？

二塁手

Team	Name	打力	走力	正解	予測確率	予測値
Yakult Swallows	Tetsuto Yamada	2.96	2.67	1	0.91	1

文句なしですね。
攻撃は山田、守備は菊池といったところでしょうか。

三塁手

Team	Name	打力	走力	正解	予測確率	予測値
Yokohama Bay Stars	Toshiro Miyazaki	1.79	-0.58	1	0.34	1
Yomiuri Giants	Casey McGehee	1.37	-0.67	0	0.23	1

岡本がこっちに来たら、2019年は混戦になりそうですね。

遊撃手

Team	Name	打力	走力	正解	予測確率	予測値
Yomiuri Giants	Hayato Sakamoto	1.54	0.97	1	0.46	1
Hiroshima Carp	Kosuke Tanaka*	0.31	2.70	0	0.33	1

田中は走力が頭一つ抜けている分、上に来ました。
坂本はさすがの安定感です。

外野手

Team	Name	打力	走力	正解	予測確率	予測値
Hiroshima Carp	Yoshihiro Maru*	3.04	-0.08	1	0.73	1
Yakult Swallows	Wladimir Balentien	3.27	-1.68	0	0.61	1
Yokohama Bay Stars	Neftali Soto	3.02	-1.14	1	0.61	1
Hiroshima Carp	Seiya Suzuki	2.53	-0.32	1	0.57	1
Hanshin Tigers	Yoshio Itoi*	1.22	1.97	0	0.49	1
Yokohama Bay Stars	Yoshitomo Tsutsugo*	2.54	-1.21	0	0.46	1
Chunichi Dragons	Zoilo Almonte#	1.25	-0.16	0	0.25	1
Yakult Swallows	Yuhei Takai*	0.81	0.50	0	0.22	1
Chunichi Dragons	Ryosuke Hirata	0.55	0.97	0	0.21	1
Yakult Swallows	Nori Aoki*	0.81	0.31	0	0.21	1
Chunichi Dragons	Yohei Oshima*	0.05	1.75	0	0.18	1

大混戦です。バレンティン、2018年ダントツで打点王なんですけど選ばれませんでしたね。

パ・リーグ

捕手

Team	Name	打力	走力	正解	予測確率	予測値
Saitama Seibu Lions	Tomoya Mori*	1.16	-0.15	1	0.23	1

打力を考慮したら、甲斐キャノンでも無理だなぁ。

一塁手

Team	Name	打力	走力	正解	予測確率	予測値
Saitama Seibu Lions	Hotaka Yamakawa	4.08	-1.68	1	0.80	1
Chiba Lotte Marines	Seiya Inoue	2.25	-0.71	0	0.44	1
Hokkaido Nippon Ham Fighters	Sho Nakata	2.13	-1.22	0	0.35	1

アジャ、2019年は頼むぞ！

二塁手

Team	Name	打力	走力	正解	予測確率	予測値
Saitama Seibu Lions	Hideto Asamura	3.65	-0.63	1	0.81	1
Chiba Lotte Marines	Shogo Nakamura	0.53	2.81	0	0.40	1

浅村、この打力なら満票も納得です。

三塁手

Team	Name	打力	走力	正解	予測確率	予測値
Fukuoka Softbank Hawks	Nobuhiro Matsuda	1.79	-1.23	1	0.27	1
Saitama Seibu Lions	Takeya Nakamura	1.54	-1.01	0	0.23	1
Tohoku Rakuten Golden Eagles	Zelous Wheeler	0.45	-0.37	0	0.11	0
Hokkaido Nippon Ham Fighters	Brandon Laird	0.80	-1.40	0	0.10	0

若手の登場が待たれますね。
2019年はロッテ安田にとってほしいなあ。

遊撃手

Team	Name	打力	走力	正解	予測確率	予測値
Saitama Seibu Lions	Sosuke Genda*	0.17	2.44	1	0.27	1

源田たまらん。

外野手

Team	Name	打力	走力	正解	予測確率	予測値
Fukuoka Softbank Hawks	Yuki Yanagita*	3.96	1.31	1	0.94	1
Saitama Seibu Lions	Shogo Akiyama*	2.34	0.89	1	0.67	1
Orix Buffaloes	Masataka Yoshida*	2.42	-0.14	1	0.57	1
Saitama Seibu Lions	Shuta Tonosaki	1.27	1.44	0	0.44	1
Hokkaido Nippon Ham Fighters	Haruki Nishikawa*	0.40	3.13	0	0.40	1
Fukuoka Softbank Hawks	Seiji Uebayashi*	1.07	0.22	0	0.25	1
Tohoku Rakuten Golden Eagles	Kazuki Tanaka#	0.43	0.98	0	0.19	1
Tohoku Rakuten Golden Eagles	Hiroaki Shimauchi*	0.45	0.69	0	0.17	1
Fukuoka Softbank Hawks	Akira Nakamura*	0.63	-0.19	0	0.14	0
Hokkaido Nippon Ham Fighters	Taishi Ota	0.48	-0.29	0	0.12	0

打力を考えたら、納得の上位3人ですね。

指名打者

Team	Name	打力	走力	正解	予測確率	予測値
Hokkaido Nippon Ham Fighters	Kensuke Kondo*	1.04	0.58	1	0.28	1
Fukuoka Softbank Hawks	Alfredo Despaigne	1.26	-1.47	1	0.15	0
Orix Buffaloes	Stefen Romero	0.81	-0.77	0	0.13	0

走力で差がついて近藤になりましたが、「DHと言えばこの人！」という選手がいなかった年でもあったと思います。
セ・リーグでも近いうちにDH制が導入されるようですし、今後はDHのあり方が変わってくるかもしれないですね。

結果

今年のベストナイン100票以上獲得者のうち、デスパイネと會澤だけ外れてしまいました…。

まとめ

打力と走力（打率・本塁打数・打点・盗塁数）だけでベストナイン上位候補者を約8割当てられた
打力と走力では比較的打力の影響が大きい
ポジション抜きで打撃成績から會澤のベストナインを当てるのは難しい

誰ガ為ニ分析ヲスル

攻撃力からベストナインを予測する