最近数量化III類を見直してましてね。やっぱあれ使い勝手いいなと思ったりして。 昨日放送されたキングオブコントの評定値を使って分析をしてみようと思っています。

まずはデータを。今回は実際の審査員に加えて，私や妻子が一緒に参加してくれたので，彼女らのデータも入っています。ただ，下の子は決勝を見てないので，欠損値になりました。

とりあえずデータはこんな感じ。

library(tidyverse)
## ─ Attaching packages ──────────────────── tidyverse 1.3.1 ─
## ✓ ggplot2 3.3.3     ✓ purrr   0.3.4
## ✓ tibble  3.1.2     ✓ dplyr   1.0.6
## ✓ tidyr   1.1.3     ✓ stringr 1.4.0
## ✓ readr   1.4.0     ✓ forcats 0.5.1
## ─ Conflicts ───────────────────── tidyverse_conflicts() ─
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(ggrepel)
library(MASS)
## 
##  次のパッケージを付け加えます: 'MASS'
##  以下のオブジェクトは 'package:dplyr' からマスクされています: 
## 
##      select
dat <- c(
  78, 75, 80, 90, 92, 80, 80, 93, 80, 92, 95, 83, 95,
  90, 88, 90, 94, 95, 92, 90, 92, 92, 92, 92, 95, 93,
  90, 90, 88, 93, 97, 91, 87, 91, 90, 91, 93, 95, 94,
  89, 91, 90, 92, 94, 91, 89, 92, 93, 92, 95, 91, 92,
  90, 91, 90, 89, 96, 91, 87, 86, 92, 88, 90, 90, 90,
  86, 85, 88, 90, 95, 92, 87, 93, 94, 91, 93, 92, 95,
  83, 86, 87, 95, 95, 84, 82, 89, 94, 95, 94, 84, 90,
  80, 87, 87, 93, 85, 83, 88, 93, 83, 95, 95, 86, 94,
  80, 90, 73, 95, 80, 80, 87, 95, 85, 98, NA, NA, NA
) %>%
  matrix(nrow = 13) %>%
  transform() %>%
  dplyr::mutate(player = c(
    "滝音", "GAG", "ロングコートダディ", "空気階段",
    "ジャルジャル", "ザ・ギース", "うるとらブギーズ",
    "ニッポンの社長", "ニューヨーク", "ジャングルポケット",
    "空気階段2nd", "ニューヨーク2nd", "ジャングルポケット2nd"
  )) %>%
  dplyr::rename(
    "kosugitti" = X1,
    "設楽" = X2,
    "日村" = X3,
    "大竹" = X4,
    "三村" = X5,
    "松本" = X6,
    "妻" = X7,
    "子1" = X8,
    "子2" = X9
  ) %>% na.omit %>% print
##    kosugitti 設楽 日村 大竹 三村 松本 妻 子1 子2             player
## 1         78   90   90   89   90   86 83  80  80               滝音
## 2         75   88   90   91   91   85 86  87  90                GAG
## 3         80   90   88   90   90   88 87  87  73 ロングコートダディ
## 4         90   94   93   92   89   90 95  93  95           空気階段
## 5         92   95   97   94   96   95 95  85  80       ジャルジャル
## 6         80   92   91   91   91   92 84  83  80         ザ・ギース
## 7         80   90   87   89   87   87 82  88  87   うるとらブギーズ
## 8         93   92   91   92   86   93 89  93  95     ニッポンの社長
## 9         80   92   90   93   92   94 94  83  85       ニューヨーク
## 10        92   92   91   92   88   91 95  95  98 ジャングルポケット

分析してみます。欠損値の入った決勝は除外しようかな。

dat %>% dplyr::select(-player)  %>% corresp(nf=2) -> result.cr
result.cr$cscore %>% as.data.frame %>% rownames_to_column("label") %>% dplyr::mutate(type=1) -> tmp1
result.cr$rscore %>% as.data.frame %>% dplyr::mutate(label = dat$player) %>% dplyr::mutate(type=2)-> tmp2
bind_rows(tmp1,tmp2) %>% 
  dplyr::mutate(type = factor(type,labels=c("rater","player"))) %>% print %>% 
  ggplot() + aes(x=V1,y=V2,color=type,label=label)+geom_point()+geom_text_repel(family="HiraKakuProN-W3")
##                   label          V1         V2   type
## ...1          kosugitti  0.70280861  2.4063981  rater
## ...2               設楽 -0.54407053 -0.1750142  rater
## ...3               日村 -0.62964105 -0.1875375  rater
## ...4               大竹 -0.52568653 -0.6168768  rater
## ...5               三村 -1.25948965 -0.8511602  rater
## ...6               松本 -0.62365438  0.3368169  rater
## ...7                 妻 -0.07019572  0.7395686  rater
## ...8                子1  0.94553364 -0.2378495  rater
## ...9                子2  2.19080214 -1.2925925  rater
## 1                  滝音 -0.82349794 -0.6097337 player
## 2                   GAG  0.25189532 -2.1128035 player
## 3    ロングコートダディ -1.15509936  0.5008517 player
## 4              空気階段  1.02563028  0.3847534 player
## 5          ジャルジャル -1.11980739  1.6861890 player
## 6            ザ・ギース -0.95300414 -0.2995271 player
## 7      うるとらブギーズ  0.41242144 -0.8426724 player
## 8        ニッポンの社長  1.30057086  0.8583184 player
## 9          ニューヨーク -0.63556131 -0.3123025 player
## 10   ジャングルポケット  1.52022528  0.5392712 player