試験に合格するためにぎりぎりを目指すのもいいけどどれくらいがんばればいいかわからない人に

MikuHatsune2013-08-21

昔試験に合格するにはどれくらいがんばればいいかというのをやったわけだが、今回もそのネタ。
とある試験は500問で構成されているが、複数の合格基準がある。
細かいことは面倒なので省略するが、モデルの構築上必要なのが、
 
1:とあるセクションは100問で構成されているが、内訳は1点問題50問と3点問題50問である。つまり最高点は200点である。しかも毎年合格点は変わらず、160点以上を合格とする。
2:とあるセクションは200問で構成されているが、内訳は1点問題200問である。つまり最高点は200点である。合格点は毎年変わり、65%前後である。
3:とあるセクションは200問で構成されているが、内訳は3点問題200問である。つまり最高点は600点である。合格点は毎年変わり、65%前後である。
 
結局2と3は同じことになるのでこれらは同じとして、1を考える。
1の問題は3点問題のほうが比重が大きいのでこれはしっかり答えたほうがいいのはそれはそうだとして、1点問題も選択肢が5つなら50問をランダムに答えたときの最尤推定値は10問正解なので、3点問題の理解度が100%でも1点問題がノーマークなら合格できるかはちょっと厳しい。
鳥瞰図からは合格可能性が指数関数的に増加していることがわかる。
どれくらいがんばればいいかという問に対しては1点問題も3点問題も各々8割くらいしっかり答えられるようにしたらどうでしょうか。というか合格基準が8割なのでそのまんまな結果になってしまったが。

library(gplots)
cols <- bluered(100)
x1 <- x2 <- seq(0, 1, by=0.01) # 1点問題と3点問題の各々の絶対正答率
q1 <- 50 # 1点問題の問題数
q2 <- 50 # 3点問題の問題数
Cn <- 5 # 多肢選択式の選択肢数
score1 <- matrix(0, length(x1), length(x2))
for(i in seq(x1)){
	for(j in seq(x2)){
		s0 <- floor(x1[i]*q1) + floor(x2[j]*q2)*3 + outer(0:floor((1-x1[i])*q1), (0:floor((1-x2[j])*q2))*3, "+") # 絶対に正答した問題と、偶然に正答した問題の数の和
		idx <- s0 >= 160 # 合格基準を満たしている場合
		p1 <- dbinom(0:floor((1-x1[i])*q1), floor((1-x1[i])*q1), 1/Cn) # 1点問題を偶然に解いて n問 正答している確率
		p3 <- dbinom(0:floor((1-x2[j])*q2), floor((1-x2[j])*q2), 1/Cn) # 3点問題を偶然に解いて n問 正答している確率
		score1[i, j] <- sum(outer(p1, p3, "*")[idx]) # 合格基準を超えている確率
	}
}

# ヒートマップ
par(mar=c(5, 5, 4, 1))
layout(t(c(rep(1, 12), 2)))
image(score1, col=cols, xlab="一般問題の絶対正答率(1点)", ylab="長文問題の絶対正答率(3点)", main="必修問題における合格確率(絶対基準80%)", cex.lab=2, cex.main=2)
par(mar=c(5, 0, 4, 2))
image(t(as.matrix(seq(0, 1, length=length(cols)))), col=cols, axes=FALSE, ylab="") # カラースケールを描く
axis(4, las=2, tick=0, line=-0.8)

# 鳥瞰図
persp(score1, theta=60, phi=30, xlab="一般問題の絶対正答率", ylab="長文問題の絶対正答率", zlab="合格確率")

# 3D
library(rgl)
plot3d(rep(x1, length(x2)), rep(x2, each=length(x1)), c(score1))



2と3の問題のほうは、6割くらいしっかり答えることができれば落ちることはなさそうなのでこちらは実はそんなに心配しなくてもいいような気がする。

Qs <- 200 #試験問題数
Cn <- 5 #1問あたりの選択肢数
alpha <- 0.95 #有意水準
pass <- 0.68 #試験合格基準
passQn <- floor(Qs * pass) #試験合格基準を満たす問題数

An_alpha <- rep(0, Qs + 1)
for(An in 0:Qs){
	An_alpha[An] <- qbinom(alpha, size = Qs - An, prob = 1/Cn)
}

plot((0:Qs) / Qs, (An_alpha + 0:Qs) / Qs, xlim=c(0, 1), ylim=c(0, 1), xlab="% correct answers", ylab=paste("maximum answers on exam, probability <", alpha))
abline(h = pass, lty=2)