M-1グランプリの審査結果データを作った(新しい審査方法の提案・検証）

はじめに

今年のM-1グランプリも面白かったですね。分析したくなったので、審査結果の詳細データを作ってみました。自由に使ってください。実際に使ってみました(主成分分析)。

M-1グランプリ審査の課題

審査員の点数の付け方に基準がありません。そのため、審査員の１人が、極端に分散が大きな評価点の付け方をすると、その人の評価で順位が決まってしまいます。

簡単のために、出場者が2組で、審査員5名とします。審査員Aが1組目に90点、2組目に10点、審査員B,C,D,Eが1組目に90点、2組目に91点だった場合を考えます。

コンビ名	合計	審査員A	審査員B	審査員C	審査員D	審査員E
コンビX	450	90	90	90	90	90
コンビY	374	10	91	91	91	91

5人中4人がコンビYを高く評価しているのに、審査員Aが極端な点数の付け方をしているため、総合得点で評価した場合の優勝は、コンビXになってしまいます。

課題への対応案：「審査員ごとの順位点」による順位づけ

点数をそのまま利用すると、こうなります。対応策はいろいろありますが、例えば審査員ごとの順位ベースで集計することで、分散の影響を消すことができます。 先の例だと、審査員Aの点数だと、1組目が1位で2組目が2位。他の4人それぞれ点数だと、1組目が2位で2組目が1位です。順位を利用して総合得点をつけることで、審査員ごとの点数の幅を補正することができます。

コンビ名	順位合計点	審査員A順位	審査員B順位	審査員C順位	審査員D順位	審査員E順位
コンビX	9	1	2	2	2	2
コンビY	6	2	1	1	1	1

順位の数値は低い方が嬉しいことに注意しつつ計算してみると、1組目が9点(=1+2+2+2+2)で2組目が6点(=2+1+1+1+1)となり、2組目が優勝になります。

数値が低い方が嬉しいことが気持ち悪い場合は、例えば「下から何番目か」などの数値を利用すれば、高い方が嬉しくなります。この辺はなんとでもなります。

実験：過去データの再集計

実際に過去のM1グランプリのデータを利用して、総合得点と提案手法とで、ファイナルラウンド進出者(上位3名)の変化を見てみます。 審査員ごとの評価点はWikipediaにありました。これを前処理して、所望のデータを作成します。

M-1データの前処理・集計

とりあえずspreadsheetに、wikipediaに書いてあった審査結果の生データを配置しました。

集計できるように、(年,コンビ名,出番順,審査員,点数)というデータに変形しています。

準備

# install.packages('googlesheets4')
library("googlesheets4")
library("dplyr")
library("tidyr")
library("readr")
library("xtable")

各回データの整形(初回のみ)

## これは実行しない
sheet_nums = seq(1:18)

dat_all = data.frame(NULL)
for(sheet_num in sheet_nums){
  dat = read_sheet(ss="12JcpUWepZ6qqvxiT_-6eswfHO4pbxc_HvThU2P2ztNY", sheet = paste("シート", sheet_num, sep=""))
  dat = dat %>% pivot_longer(cols = -c(コンビ名,出番順), names_to = "Judge", values_to = "Score")
  dat$No = sheet_num
  dat = dat %>% select(No, Name=コンビ名, Order=出番順,Judge, Score)
  dat %>%
    mutate(Year = if_else(No <= 10, No + 2000, No + 2004)) -> dat
  dat_all = rbind(dat_all, dat)
}

dat_all %>% 
  select(No, Year, Order, Name, Judge, Score) %>% 
  arrange(No, Year, Order) %>% 
  write.csv("../data/m1_score_detail.csv", row.names = FALSE, quote=FALSE)

既に作成したものをgistに配置していますので、それを読み込みます。

dat_all = read_csv("https://gist.githubusercontent.com/gghatano/092a9f7089451de743f39a53dda24423/raw/d86c1af1dce74ff4afe879e22852f96601ffec51/m1_score.detail.csv")


dat_all %>% select(-No) -> dat_all
dat_all %>% head() %>% 
  knitr::kable(format="markdown")

Year	Order	Name	Judge	Score
2001	1	中川家	きよし	91
2001	1	中川家	青島	90
2001	1	中川家	小朝	90
2001	1	中川家	石井	90
2001	1	中川家	鴻上	85
2001	1	中川家	松本	70

所望の形式のデータができました。

「順位点」を利用した順位付け

では、集計していきます。普通の合計点と、順位点での合計点を算出していきます。

## 審査員ごとの順位を算出：「順位点」とする
dat_all %>% 
  group_by(Year, Judge) %>% 
  mutate(Rank_Score = rank(-Score, ties.method = "min")) %>% 
  select(-Score) %>% 
  ungroup() -> dat_rank


## 順位点をマージ
dat_all_rank = 
  dat_all %>% merge(dat_rank, by = c("Year", "Name", "Judge", "Order"))

## 総合得点と総合順位点を算出
dat_all_rank %>% 
  group_by(Year, Name) %>% 
  summarise(Score_Sum = sum(Score),
            Rank_Score_Sum = sum(Rank_Score)) %>% 
  ungroup() -> dat_all_summarized

## 総合得点と総合順位点で、それぞれ順位を算出
dat_all_summarized %>% 
  group_by(Year) %>% 
  mutate(Normal_Rank = rank(-Score_Sum, ties.method = "min")) %>% 
  mutate(Rank_Score_Rank = rank(Rank_Score_Sum, ties.method = "min")) %>% 
  ungroup() -> dat_all_summarized


## ファイナルラウンド進出者を、2つの点数の両方で抽出する
dat_finalround = 
  dat_all_summarized %>% 
  filter((Normal_Rank <= 3) | (Rank_Score_Rank <= 3))

dat_finalround %>% select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  arrange(Year, Normal_Rank) -> dat_finalround
dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  head() %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2001	中川家	1	1
2001	ハリガネロック	2	2
2001	アメリカザリガニ	3	3
2002	フットボールアワー	1	1
2002	ますだおかだ	2	2
2002	笑い飯	3	3

できました。

結果の確認

さて、結果を見てみましょう。

普通の得点での順位(normal_rank)と、順位点での順位(rank_score_rank)で、 ファイナルラウンド進出者の顔ぶれを確認してみます。 顔ぶれが大きく変わっていると面白そうですが、どうでしょう。

3回ごとに見ていきます

第1-3回

dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  filter((Year >= 2001) & (2003 >= Year)) %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2001	中川家	1	1
2001	ハリガネロック	2	2
2001	アメリカザリガニ	3	3
2002	フットボールアワー	1	1
2002	ますだおかだ	2	2
2002	笑い飯	3	3
2003	フットボールアワー	1	1
2003	笑い飯	2	2
2003	アンタッチャブル	3	3

そういえば、第1回は2組でファイナルラウンドをやっていましたね。忘れていました。とはいえ、顔ぶれは変わらず。

第4-6回

dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  filter((Year >= 2004) & (2006 >= Year)) %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2004	アンタッチャブル	1	1
2004	南海キャンディーズ	2	2
2004	麒麟	3	3
2005	ブラックマヨネーズ	1	1
2005	麒麟	2	2
2005	笑い飯	3	3
2006	チュートリアル	1	1
2006	フットボールアワー	2	2
2006	麒麟	3	3

変わっていません。

第7-9回

dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  filter((Year >= 2007) & (2009 >= Year)) %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2007	サンドウィッチマン	1	1
2007	キングコング	2	2
2007	トータルテンボス	3	2
2008	オードリー	1	1
2008	NON STYLE	2	2
2008	ナイツ	3	3
2009	笑い飯	1	1
2009	パンクブーブー	2	2
2009	NON STYLE	3	3

はい

第10-12回

dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  filter((Year >= 2010) & (2016 >= Year)) %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2010	パンクブーブー	1	1
2010	笑い飯	1	2
2010	スリムクラブ	3	3
2015	ジャルジャル	1	1
2015	トレンディエンジェル	2	2
2015	銀シャリ	3	5
2015	スーパーマラドーナ	5	3
2016	銀シャリ	1	1
2016	和牛	2	2
2016	スーパーマラドーナ	3	3

お？第11回は、スーパーマラドーナと銀シャリの順位が変わっていますね。 順位点ベースだったら、銀シャリよりもスーパーマラドーナが高評価です。 最終的にはトレンディエンジェルが優勝しました。

第13-15回

dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  filter((Year >= 2017) & (2019 >= Year)) %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2017	和牛	1	1
2017	ミキ	2	2
2017	とろサーモン	3	3
2018	霜降り明星	1	1
2018	和牛	2	2
2018	ジャルジャル	3	3
2019	ミルクボーイ	1	1
2019	かまいたち	2	2
2019	ぺこぱ	3	3

変わらず

第16-18回

dat_finalround %>% 
  select(Year, Name, Normal_Rank, Rank_Score_Rank) %>% 
  filter((Year >= 2020) & (2022 >= Year)) %>% 
  knitr::kable(format="markdown")

Year	Name	Normal_Rank	Rank_Score_Rank
2020	おいでやすこが	1	1
2020	マヂカルラブリー	2	2
2020	見取り図	3	3
2021	オズワルド	1	1
2021	インディアンス	2	3
2021	錦鯉	2	2
2022	さや香	1	1
2022	ロングコートダディ	2	3
2022	ウエストランド	3	2

顔ぶれは変わらず、でした。

考察・まとめ

考察

第11回のM1グランプリ2015では、順位に変動がありました。銀シャリ(3位)とスーパーマラドーナ(5位)の順位が入れ替わります。 得点の詳細を見てみると、 多くの審査員が1点程度の差をつけている中、チュートリアル徳井さんが6点差をつけています。

dat_all_rank %>% 
  filter(Judge=="徳井" & Year == 2015) %>% 
  arrange(Rank_Score) %>% 
  knitr::kable(format="markdown")

Year	Name	Judge	Order	Score	Rank_Score
2015	ジャルジャル	徳井	5	96	1
2015	銀シャリ	徳井	6	95	2
2015	メイプル超合金	徳井	1	91	3
2015	和牛	徳井	4	90	4
2015	スーパーマラドーナ	徳井	3	89	5
2015	ハライチ	徳井	7	89	5
2015	馬鹿よ貴方は	徳井	2	89	5
2015	タイムマシーン3号	徳井	8	88	8
2015	トレンディエンジェル	徳井	9	88	8

ジャルジャルと銀シャリを特に高く評価していました。…こういう評価も面白いですね。

まとめ

点数をそのまま使うと不公平かも？と思い、順位で正規化した新しい評価点を提案してみました。 過去の審査結果に適用してみましたが、結果は現状と殆ど変わりませんでした。

審査員の方々はすごいですね…。

次は出番順のデータも使った分析をしてみようと思います。

以上です。