慶応がベスト１()～何の雑誌だコレ
https://twitter.com/dankogai/status/522047534022156289
算数をなめてる> @kirik: うわ、なんだこれw 算数やんけ RT @fukusanity: 作った人間が統計をなめてることはわかった pic.twitter.com/mcDF5k3jzA
— Dan Kogai (@dankogai) October 14, 2014更に追記：
[Stan]「使える大学・使えない大学」の事例から考えるアンケートの解析方法
丁度本日Rstanをインストールしたところですが、beroberoさんの
読み応えのある分析が出ました。勉強になります。
自分で勝手に想定した各個人の使える使えないの評価ではなかったようです。
とりあえず簡単なRstanコードが書けるようになりたい。
10/16追記：週刊ダイヤモンドだったようです
全文表示 | 「使えない大学」特集1位に法政大学 本当か？「週刊ダイヤモンド」調査に反響 : J-CASTニュース
10/16更に追記
Haruhiko Okumura先生に、ツイッターで二項分布でもないよとご指摘いただいた。
って、昔からめちゃくちゃお世話になっているサイトの
先生ではないですか。先生のサイトでは本当に勉強させて
いただいております。
言うまでもないことですが、どのように調査したかわから
ないのに、分析するのは本来ご法度です。
この記事はお遊びと考えてね。
とりあえず、上位（）の部分だけ入力して、元の本知らないので前提が分かんないけど適当に解析してみた。
（良い子は真似しちゃダメですよ）
二項分布の比率の９５％信頼区間をplot
good = c( 2170,1838,1041,580,1596,496,374,520,250,256,209,231,163,144,230,113,140,103,217,110,65,123,57,50,24,68,22,16,21,18,139 ) bad = c( 536,684,328,115,1161,79,108,322,62,81,41,105,52,59,165,52,82,50,171,66,28,88,22,18,0,44,5,0,9,7,128 ) univ = as.character(c( "慶応大学","早稲田大学","京都大学","一橋大学","東京大学","東京工業大学","大阪大学","明治大学","東北大学","東京理科大学","国際基督教大学","同志社大学","神戸大学","北海道大学","上智大学","名古屋大学","関西学院大学","筑波大学","中央大学","九州大学","東京外国語大学","横浜国立大学","電気通信大学","津田塾大学","ハーバード大学","千葉大学","広島大学","国際教養大学","小樽商科大学","京都工芸繊維大","立教大学" )) data <- data.frame( univ = univ,good = good,bad = bad ) data$univ <- as.factor(data$univ) data$univ <- relevel(data$univ, ref="keio") library(binom) ci.calc <- function(x){ as.numeric(binom.confint(as.integer(x[2]), as.integer(x[2]+x[3]), conf.level=0.95, methods = "exact")[c(4,5,6)]) } res <- matrix(0, nrow = nrow(data), ncol = 3) for (i in 1:nrow(data)){ res[i,] <- ci.calc(data[i,]) } rownames(res) <- data$univ colnames(res) <- c("mean", "lower", "upper") windows() par(mar = c(5, 10, 4, 2)) plot(x = rev(res[,1]*100),y = seq_len(nrow(res)), xlim=c(40, 100), ylim = c(0, nrow(res)), ylab = "", xlab = "使える率(%)", yaxt = "n") axis(side=2, labels=rev(rownames(res)), at = seq_len(nrow(res)), las = 1) arrows(y0 = rev(seq_len(nrow(res))),x0 = res[,2]*100, y1 =rev(seq_len(nrow(res))), x1 = res[,3]*100,length=.05,angle=90,code=3) abline(v = c(res[1,2], res[1,3])*100, lty= 3) fit1 <- glm(cbind(good, bad) ~ factor(univ), data = data, family = binomial) summary(fit1) fisher.p.value <- NULL #numeric(nrow(data)) for (i in 2:nrow(data)){ fisher.p.value[i] <- fisher.test(rbind(data[1,-1], data[i,-1]))$p.value } data$good.rate <- (data$good / (data$bad + data$good)) data$p.value <- fisher.p.value data$fdr.adjust.p <- c(NA, p.adjust((data$p.value[-1]), method = "fdr")) data$holm.adjust.p <- c(NA, p.adjust((data$p.value[-1]), method = "holm")) data Call: glm(formula = cbind(good, bad) ~ factor(univ), family = binomial, data = data) Deviance Residuals: [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 1.39835 0.04823 28.99 < 2e-16 *** factor(univ)chiba -0.96303 0.19940 -4.83 0.0000013675077 *** factor(univ)chuo -1.16011 0.11306 -10.26 < 2e-16 *** factor(univ)denkitsushin -0.44634 0.25559 -1.75 0.08075 . factor(univ)doushisha -0.60989 0.12720 -4.79 0.0000016282277 *** factor(univ)harvard 24.52548 52727.17227 0.00 0.99963 factor(univ)hiroshima 0.08326 0.49778 0.17 0.86717 factor(univ)hitotsubashi 0.21975 0.11290 1.95 0.05161 . factor(univ)hokkaido -0.50607 0.16193 -3.13 0.00178 ** factor(univ)ICU 0.23041 0.17749 1.30 0.19422 factor(univ)jyouchi -1.06621 0.11285 -9.45 < 2e-16 *** factor(univ)kanseigakuin -0.86343 0.14719 -5.87 0.0000000044613 *** factor(univ)kobe -0.25584 0.16641 -1.54 0.12419 factor(univ)kokusaikyouyou 24.14549 53403.16642 0.00 0.99964 factor(univ)kyoto -0.24342 0.07960 -3.06 0.00223 ** factor(univ)kyoutokousen -0.45389 0.44804 -1.01 0.31104 factor(univ)kyushu -0.88752 0.16300 -5.44 0.0000000518252 *** factor(univ)meiji -0.91907 0.08576 -10.72 < 2e-16 *** factor(univ)nagoya -0.62220 0.17438 -3.57 0.00036 *** factor(univ)osaka -0.15622 0.11941 -1.31 0.19079 factor(univ)otarushouka -0.55105 0.40132 -1.37 0.16972 factor(univ)rikkyou -1.31590 0.13166 -10.00 < 2e-16 *** factor(univ)tokyo -1.08013 0.06176 -17.49 < 2e-16 *** factor(univ)tokyogaikoku -0.55617 0.23114 -2.41 0.01612 * factor(univ)touhoku -0.00402 0.14985 -0.03 0.97859 factor(univ)toukoudai 0.43878 0.13039 3.37 0.00076 *** factor(univ)toukyourika -0.24762 0.13630 -1.82 0.06926 . factor(univ)tsudajuku -0.37670 0.27907 -1.35 0.17708 factor(univ)tsukuba -0.67564 0.17898 -3.77 0.00016 *** factor(univ)waseda -0.40987 0.06582 -6.23 0.0000000004755 *** factor(univ)yokohamakokuritsu -1.06350 0.14772 -7.20 0.0000000000006 *** --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 (Dispersion parameter for binomial family taken to be 1) Null deviance: 751.30569842738942 on 30 degrees of freedom Residual deviance: 0.00000000052277 on 0 degrees of freedom AIC: 230 Number of Fisher Scoring iterations: 22 #fisher exact test, vs 慶応大学 > data univ good bad good.rate p.value fdr.adjust.p holm.adjust.p 1 慶応大学 2170 536 0.8019217 NA NA NA 2 早稲田大学 1838 684 0.7287867 4.784803e-10 2.050630e-09 1.148353e-08 3 京都大学 1041 328 0.7604091 2.344880e-03 4.689761e-03 3.751809e-02 4 一橋大学 580 115 0.8345324 5.179567e-02 8.076777e-02 6.215480e-01 5 東京大学 1596 1161 0.5788901 4.407055e-72 1.322116e-70 1.322116e-70 6 東京工業大学 496 79 0.8626087 6.265189e-04 1.412953e-03 1.127734e-02 7 大阪大学 374 108 0.7759336 1.961095e-01 2.262802e-01 1.000000e+00 8 明治大学 520 322 0.6175772 5.919734e-26 8.879601e-25 1.716723e-24 9 東北大学 250 62 0.8012821 1.000000e+00 1.000000e+00 1.000000e+00 10 東京理科大学 256 81 0.7596439 7.253240e-02 1.036177e-01 7.253240e-01 11 国際基督教大学 209 41 0.8360000 2.112273e-01 2.346970e-01 1.000000e+00 12 同志社大学 231 105 0.6875000 3.494767e-06 1.006661e-05 7.339011e-05 13 神戸大学 163 52 0.7581395 1.328087e-01 1.732288e-01 1.000000e+00 14 北海道大学 144 59 0.7093596 2.770101e-03 5.193939e-03 4.155151e-02 15 上智大学 230 165 0.5822785 5.673220e-20 3.403932e-19 1.475037e-18 16 名古屋大学 113 52 0.6848485 6.593782e-04 1.412953e-03 1.127734e-02 17 関西学院大学 140 82 0.6306306 1.659472e-08 6.223020e-08 3.816786e-07 18 筑波大学 103 50 0.6732026 2.794904e-04 6.987259e-04 5.310317e-03 19 中央大学 217 171 0.5592784 2.239980e-23 2.239980e-22 6.271943e-22 20 九州大学 110 66 0.6250000 1.575574e-07 5.251913e-07 3.466263e-06 21 東京外国語大学 65 28 0.6989247 1.802297e-02 3.003828e-02 2.342986e-01 22 横浜国立大学 123 88 0.5829384 5.699486e-12 2.849743e-11 1.424872e-10 23 電気通信大学 57 22 0.7215190 8.673398e-02 1.182736e-01 7.806058e-01 24 津田塾大学 50 18 0.7352941 1.695589e-01 2.034707e-01 1.000000e+00 25 ハーバード大学 24 0 1.0000000 8.260708e-03 1.457772e-02 1.156499e-01 26 千葉大学 68 44 0.6071429 3.691090e-06 1.006661e-05 7.382181e-05 27 広島大学 22 5 0.8148148 1.000000e+00 1.000000e+00 1.000000e+00 28 国際教養大学 16 0 1.0000000 5.384518e-02 8.076777e-02 6.215480e-01 29 小樽商科大学 21 9 0.7000000 1.692974e-01 2.034707e-01 1.000000e+00 30 京都工芸繊維大 18 7 0.7200000 3.141478e-01 3.365869e-01 1.000000e+00 31 立教大学 139 128 0.5205993 2.827325e-22 2.120494e-21 7.633779e-21
東京工業大学完全勝利って感じだった
