###################################################### #南風原朝和・芝祐順（1987） #相関係数および平均値差の解釈のための確率的な指標 #教育心理学研究, 35(3),259-265 ###################################################### #--------------------------------------# #同順率 #--------------------------------------# rho <- .5 1/2 + (1/pi) * asin(rho) #2式 ##関数の定義 rho2conc <- function(rho){ 1/2 + (1/pi) * asin(rho) #2式 } rho <- seq(0, .95, by=.05) rho2conc(rho=rho) #Table 1 rho2conc(rho=-.5) #--------------------------------------# #独立な比較の場合 #--------------------------------------# delta <- .5 pnorm(delta/sqrt(2), lower.tail=T) #4式 ##関数の定義 delta2domi.ind <- function(delta){ pnorm(delta/sqrt(2), lower.tail=T) #4式 } delta <- seq(0, 1.9, by=.1) delta2domi.ind(delta=delta) #Table 2 #--------------------------------------# #対比較 #--------------------------------------# delta <- .5 pnorm(delta, lower.tail=T) #6式 ##関数の定義 delta2domi.dep <- function(delta){ pnorm(delta, lower.tail=T) #6式 } delta <- seq(0, 1.9, by=.1) delta2domi.dep(delta=delta) #Table 3 #--------------------------------------# #同順率の推定 #--------------------------------------# r <- .5; n <- 100; sig.level <- .05 atanh(r) #z変換 upper.z <- atanh(r) + qnorm(sig.level/2,lower.tail=F) / sqrt(n-3) lower.z <- atanh(r) + qnorm(sig.level/2,lower.tail=T) / sqrt(n-3) upper.r <- tanh(upper.z) lower.r <- tanh(lower.z) upper.conc <- rho2conc(upper.r) lower.conc <- rho2conc(lower.r) unbiased <- rho2conc(r) ##関数の定義 prop.conc <- function(r, n, sig.level=.05){ upper.z <- atanh(r) + qnorm(sig.level/2,lower.tail=F) / sqrt(n-3) lower.z <- atanh(r) + qnorm(sig.level/2,lower.tail=T) / sqrt(n-3) upper.r <- tanh(upper.z) lower.r <- tanh(lower.z) upper.conc <- rho2conc(upper.r) lower.conc <- rho2conc(lower.r) unbiased <- rho2conc(r) result <- data.frame("lower"=lower.conc, "statistics"=unbiased, "upper"=upper.conc) return(result) } ##図を描画 r <- seq(-1, 1, by=.02) conc <- seq(-1, 1, by=.02) plot(conc~r, xlim=c(-1,1), ylim=c(0,1), xlab="標本相関係数", ylab="母集団同順率", type="n") lines(prop.conc(r, n=10)$lower~r,col=1) lines(prop.conc(r, n=10)$upper~r,col=1) lines(prop.conc(r, n=12)$lower~r,col=2) lines(prop.conc(r, n=12)$upper~r,col=2) lines(prop.conc(r, n=15)$lower~r,col=3) lines(prop.conc(r, n=15)$upper~r,col=3) lines(prop.conc(r, n=20)$lower~r,col=4) lines(prop.conc(r, n=20)$upper~r,col=4) lines(prop.conc(r, n=25)$lower~r,col=5) lines(prop.conc(r, n=25)$upper~r,col=5) lines(prop.conc(r, n=50)$lower~r,col=6) lines(prop.conc(r, n=50)$upper~r,col=6) lines(prop.conc(r, n=100)$lower~r,col=7) lines(prop.conc(r, n=100)$upper~r,col=7) lines(prop.conc(r, n=200)$lower~r,col=8) lines(prop.conc(r, n=200)$upper~r,col=8) lines(prop.conc(r, n=400)$lower~r,col=9) lines(prop.conc(r, n=400)$upper~r,col=9) legend(x=-.8,y=1,legend=c(10,12,15,20,25,50,100,200,400),lty=1, col=1:9) graphics.off() #--------------------------------------# #独立な比較の場合 #--------------------------------------# d <- .5; N <- 100; sig.level <- .05 du <- d * (4 * N - 12)/ (4 * N -9) nh <- N/2 upper.du <- du + qnorm(sig.level/2,lower.tail=F) * sqrt(2/nh + du^2/(2*N)) lower.du <- du + qnorm(sig.level/2,lower.tail=T) * sqrt(2/nh + du^2/(2*N)) upper.domi.ind <- delta2domi.ind(upper.du) lower.domi.ind <- delta2domi.ind(lower.du) unbiased.domi.ind <- delta2domi.ind(du) ##関数の定義 prop.domi.ind <- function(d, N, sig.level=.05){ du <- d * (4 * N - 12)/ (4 * N -9) nh <- N/2 upper.du <- du + qnorm(sig.level/2,lower.tail=F) * sqrt(2/nh + du^2/(2*N)) lower.du <- du + qnorm(sig.level/2,lower.tail=T) * sqrt(2/nh + du^2/(2*N)) upper.domi.ind <- delta2domi.ind(upper.du) lower.domi.ind <- delta2domi.ind(lower.du) unbiased.domi.ind <- delta2domi.ind(du) result <- data.frame("lower"=lower.domi.ind, "statistics"=unbiased.domi.ind, "upper"=upper.domi.ind) return(result) } ##図を描画 d <- domi <- seq(-1.5, 1.5, by=.02) plot(domi~d, xlim=c(-1.5, 1.5), ylim=c(0, 1), xlab="標本効果量", ylab="母集団優越率", type="n") lines(prop.domi.ind(d, N=10)$lower~d,col=1) lines(prop.domi.ind(d, N=10)$upper~d,col=1) lines(prop.domi.ind(d, N=12)$lower~d,col=2) lines(prop.domi.ind(d, N=12)$upper~d,col=2) lines(prop.domi.ind(d, N=15)$lower~d,col=3) lines(prop.domi.ind(d, N=15)$upper~d,col=3) lines(prop.domi.ind(d, N=20)$lower~d,col=4) lines(prop.domi.ind(d, N=20)$upper~d,col=4) lines(prop.domi.ind(d, N=25)$lower~d,col=5) lines(prop.domi.ind(d, N=25)$upper~d,col=5) lines(prop.domi.ind(d, N=50)$lower~d,col=6) lines(prop.domi.ind(d, N=50)$upper~d,col=6) lines(prop.domi.ind(d, N=100)$lower~d,col=7) lines(prop.domi.ind(d, N=100)$upper~d,col=7) lines(prop.domi.ind(d, N=200)$lower~d,col=8) lines(prop.domi.ind(d, N=200)$upper~d,col=8) lines(prop.domi.ind(d, N=400)$lower~d,col=9) lines(prop.domi.ind(d, N=400)$upper~d,col=9) legend(x=-.8,y=1,legend=c(10,12,15,20,25,50,100,200,400),lty=1, col=1:9) graphics.off() #--------------------------------------# #対比較 #--------------------------------------# d <- .5; n <- 50; sig.level <- .05 du <- d * (4*n-8)/ (4*n-5) upper.du <- du + qnorm(sig.level/2, lower.tail=F) * sqrt(1/n + du^2/(2*n+2)) lower.du <- du + qnorm(sig.level/2, lower.tail=T) * sqrt(1/n + du^2/(2*n+2)) upper.domi.dep <- delta2domi.dep(upper.du) lower.domi.dep <- delta2domi.dep(lower.du) unbiased.domi.dep <- delta2domi.dep(du) ##関数の定義 prop.domi.dep <- function(d, n, sig.level=.05){ du <- d * (4*n-8)/ (4*n-5) upper.du <- du + qnorm(sig.level/2, lower.tail=F) * sqrt(1/n + du^2/(2*n+2)) lower.du <- du + qnorm(sig.level/2, lower.tail=T) * sqrt(1/n + du^2/(2*n+2)) upper.domi.dep <- delta2domi.dep(upper.du) lower.domi.dep <- delta2domi.dep(lower.du) unbiased.domi.dep <- delta2domi.dep(du) result <- data.frame("lower"=lower.domi.dep, "statistics"=unbiased.domi.dep, "upper"=upper.domi.dep) return(result) } ##図を描画 d <- domi <- seq(-1.5, 1.5, by=.02) plot(domi~d, xlim=c(-1.5, 1.5), ylim=c(0, 1), xlab="標本効果量", ylab="母集団優越率", type="n") lines(prop.domi.dep(d, n=10)$lower~d,col=1) lines(prop.domi.dep(d, n=10)$upper~d,col=1) lines(prop.domi.dep(d, n=12)$lower~d,col=2) lines(prop.domi.dep(d, n=12)$upper~d,col=2) lines(prop.domi.dep(d, n=15)$lower~d,col=3) lines(prop.domi.dep(d, n=15)$upper~d,col=3) lines(prop.domi.dep(d, n=20)$lower~d,col=4) lines(prop.domi.dep(d, n=20)$upper~d,col=4) lines(prop.domi.dep(d, n=25)$lower~d,col=5) lines(prop.domi.dep(d, n=25)$upper~d,col=5) lines(prop.domi.dep(d, n=50)$lower~d,col=6) lines(prop.domi.dep(d, n=50)$upper~d,col=6) lines(prop.domi.dep(d, n=100)$lower~d,col=7) lines(prop.domi.dep(d, n=100)$upper~d,col=7) lines(prop.domi.dep(d, n=200)$lower~d,col=8) lines(prop.domi.dep(d, n=200)$upper~d,col=8) lines(prop.domi.dep(d, n=400)$lower~d,col=9) lines(prop.domi.dep(d, n=400)$upper~d,col=9) legend(x=-.8,y=1,legend=c(10,12,15,20,25,50,100,200,400),lty=1, col=1:9) graphics.off()