AKBの川栄李奈は、様々な発言や、九九の７のが出来ないこと、アナログ時計が読めないこと、めちゃイケのテスト結果
などから、おバカキャラが定着している。但し、学力不足なのであって、
短期記憶や動体視力が優れていることは認められている。さらには、
学力についても実はバカを装っている、「ビジネス馬鹿」「おバカ詐欺」
ではないかとの意見もある。
そこで、学力の面に注目して、確かに学力不足であるのか、「ビジネス馬鹿」であるのかを考察したい。このために、川栄李奈が「めちゃイケ」の試験に２度（2013, 2014年春）受験していることに注目する。意図的にバカを装っているならば、
これら２度の試験においてかなり異なった傾向が認められるであろうと期待される。もしも大変よく似た結果であれば、作為が無いと見做すべきであろう。
2013年の試験は、AKBグループからのメンバーであり、川栄が最低点となり、BKA選抜７人のセンターとなった。最高点は入山杏奈であった。2014年はフジテレビ55周年記念であり、AKBグループからは川栄一人が参加した。
他の参加者には東大、京大卒業者もおり、上層部はかなりの高得点であった。川栄は末尾から２番目であった。この２つの試験の参加者38名、川栄が2件であり総計39件について点数の調整は行わず、そのままで全体を考える。
全件の総得点の得点順の分布は、極めてきれいな直線状となる。念の為に、
回帰の診断用の４プロットも掲載する。吉川玲が標準より点数が高く、小嶋陽菜は逆に低い。しかしCook距離を見れば特に影響の大きすぎる人はいない。
ここでは、単純に5科目の成績のままで行うのが適切と認めるので、主成分分析（分散共分散）を行う。平行分析(これは相関行列方式の場合であるが参考資料として)によれば、有効なのは第1主成分のみである。第2主成分以上に過度な意味付けをしてはならない。寄与率は各々約70%, 12%である。
par(mar = c(4, 4, 2, 2))
library(psych)
sohten <- order(rowSums(mecha[, -1]), decreasing = TRUE)
tenjun <- mecha[sohten, -1]
lten <- cbind.data.frame(so = rowSums(tenjun), jun = 1:39)
lres <- lm(so ~ jun, lten)
par(mfrow = c(1, 2))
plot(rowSums(tenjun), type = "l", lwd = 2, col = 4, xlab = "順位", ylab = "総得点",
main = "総点数と順位の線形従属性")
abline(lres)
fa.parallel(mecha[, -1], main = "平行分析では１主成分(× の線)")
## Loading required package: parallel
## Loading required package: MASS
## Parallel analysis suggests that the number of factors = 1 and the number of components = 1
par(mfrow = c(2, 2))
for (cnt in c(1:3, 5)) plot(lres, which = cnt, cex.id = 1.5)
その結果の1-2次元散布図をみれば、2つの川栄李奈は全く同じ重なった位置にいる。青色の円を付した。これはかなり偶然の要素もあるが、
同一人物の成績として自然なことである。
これだけを理由として結論づけるのは早計かもしれないが、学力について川栄李奈は「ビジネス馬鹿」ではないと判断される。
各々の人名の前には、５教科の総点の順位を付している。また種別の因子\( code \)は、2014年の受験者には"55"(散布図では黒色), 2013年の受験者のうち下位７名「BKAセブン」は"bka7"（緑色）、その他は"ab"（赤色）とした。
par(mfrow = c(1, 1))
require(FactoMineR)
## Loading required package: FactoMineR
res <- PCA(mecha, scale.unit = FALSE, ncp = 3, quali.sup = 1, graph = FALSE)
plot.PCA(res, habillage = 1, label = c("ind", "quali"), title = " めちゃx2イケテルッ BKA ＆ フジテレビ開局５５周年 試験合併 主成分得点")
points(-45.275, -1.085, cex = 2.5, col = 4, lwd = 2)
legend("bottomleft", "川栄李奈に注目 ↑")
# require(knitr)
disp <- c(16:17, 1, 14:15, 38:39) #
score <- cbind.data.frame(res$ind$coord[, 1:2], mecha[, 2:6], Total = rowSums(mecha[,
-1]))
# require(xtable) print(xtable(score[disp,], digits=c(3,3,rep(0,6)),
# caption='Table 1. Sample Scores' ), comment=FALSE, include.rownames =
# TRUE, type='html')
kable(score[disp, ], align = c("l", rep("r", 8)))
| id | Dim.1 | Dim.2 | 国語 | 数学 | 社会 | 理科 | 英語 | Total |
|---|---|---|---|---|---|---|---|---|
| 1_吉川玲 | 52.57 | 15.451 | 97 | 89 | 88 | 97 | 88 | 459 |
| 2_ヒャダイン | 43.98 | -3.716 | 89 | 98 | 88 | 69 | 87 | 431 |
| 5_入山杏奈 | 38.37 | -2.633 | 89 | 98 | 69 | 80 | 86 | 422 |
| 33_高橋みなみ | -40.56 | 21.856 | 54 | 47 | 45 | 81 | 32 | 259 |
| 36_川栄李奈bka | -45.12 | -1.099 | 56 | 58 | 34 | 54 | 37 | 239 |
| 38_川栄李奈 | -45.43 | -1.073 | 55 | 50 | 45 | 48 | 38 | 236 |
| 39_濱口優 | -49.12 | 9.587 | 48 | 42 | 42 | 67 | 35 | 234 |
plot.PCA(res, choix = "var", label = "var")
川栄李奈は総選挙１６位となり、選抜に入った。その挨拶は率直なものであり、他のよりバカな挨拶に比べて恐らく好印象を与えたと思われる。
FactoMineR の変数ベクトルの図は Variables factor map （変数因子配置図）としている。これは、変数の負荷 Loadings とは異なる。後者はその変数の
標準偏差で割って、長さ１のベクトルとしたものである。FactoMineR の内部
ではそれを描くスクリプトは無いが、単純なことであって作るのは容易である
plot.COR(res, title = "主成分負荷")
