風俗嬢ですが再起して頑張り医学部に合格しました [転載禁止]©2ch.net

**卵の名無しさん** · 2015/04/06(月) 10:00:54.93

風俗板にて

風俗辞めた後に医学部に合格したと嘘をついて袋叩きにされてる様子
http://aoi.bbspink.com/test/read.cgi/club/1424999821/724
760 ：名無しさん＠ピンキー：2015/04/03(金) 17:34:23.58 ID:hEZXryQ10
>>724
アホか、お前
＞医者になった嬢も居る、
そんなの絶対いないわ、ボケ。
お前は医者と看護師の区別もつかんのか(大笑)

**卵の名無しさん** · 2016/10/28(金) 16:59:34.14

外来で検査結果待ちの待機時間にRをいじっていたら同世代の看護婦から何をするソフトなのかと問われたので統計ソフトだけどフィーリングカップル５対５とかのシミュレーションもできる、カップル成立の期待値は１だと教えたら５対１５だとどうなるの？と問われた。
順列組合せでの解析的解答は現役宮廷合格の秀才に委ねることにして、Rでシミュレーションのスクリプトを組んでみた。おかげで検食のうどんが伸びた。

#フィーリングカップルm対f
fcmf=function(m,f){
Boys=1:m
Girls=1:f
Selected.Boys=replicate(f,sample(Boys,1))
Selected.Girls=replicate(m,sample(Girls,1))
n=min(m,f)
hit=numeric(n)
for(i in 1:n){
j=Selected.Girls[i]　#男性iが女性jを選んだ
hit[i]=(Selected.Boys[j]==i)
}
return(sum(hit)) #成立したカップル数を返す
}

m=5 ; f=15 # 各性の人数
k=1000 # 繰り返し数
couples=replicate(k,fcmf(m,f))
mean(couples) # 成立カップルの期待値
mean(couples>0) # 番組内でカップル成立の確率

FCfm=function(k,m=5,f=15){
couples=replicate(k,fcmf(m,f))
mean(couples)
}

summary(replicate(1000,FCfm(100)))

**卵の名無しさん** · 2016/10/30(日) 13:40:08.77

#フィーリングカップルm対f
fcmf=function(m,f){
Boys=1:m
Girls=1:f
Selected.Boys=sample(Boys,f,replace=TRUE)
Selected.Girls=sample(Girls,m,replace=TRUE)
n=min(m,f)
hit=numeric(n)
for(i in 1:n){
j=Selected.Girls[i]　#男性iが女性jを選んだ
hit[i]=(Selected.Boys[j]==i)
}
return(sum(hit)) #成立したカップル数を返す
}

m=5 ; f=15 # 各性の人数
k=10^6 # 繰り返し数
couples=replicate(k,fcmf(m,f))
mean(couples) # 成立カップルの期待値 =1
mean(couples>0) # 番組内でカップル成立の確率
hist(couples) ;table(couples) #成立したカップルの分布

**卵の名無しさん** · 2016/10/30(日) 19:50:15.85

# A < N
# Ax < Nx
# -Nx < -Ax
# NA-Nx < NA-Ax
# N(A-x)< A(N-x)
# (A-x)/(N-x) < A/N

**卵の名無しさん** · 2016/10/30(日) 22:23:20.81

# 表４－２
# 死亡率が1000人-年に対して11である1000人の集団で
# 20年間にわたって期待される死亡数

# 最初の死亡が発生するとすぐに追跡対象人数は1000人未満となり、
# 最初の年の期待死亡数に影響する

r=11/1000
k=10^4 # Δt=1/k Δt→0 k→∞ #interval year between deaths
nt=numeric(20*k)
nt[1]=1000
for(i in 1:(20*k)){
nt[i+1]=(1-r/k)*nt[i]
}
surviors=nt[k*(0:19)+1]
culm.deaths=(1000-nt[k*(0:20)+1])[-1]
expected.deaths=c(culm.deaths[1],diff(culm.deaths,1))
round(cbind(surviors,expected.deaths,culm.deaths),3)

plot(1:20,nt[k*(0:19)+1])
plot(nt,type="l")
plot(1:20,culm.deaths, type="l",lwd=2)
lines(1:20,(1:20)*r*1000, lty=2)

**卵の名無しさん** · 2016/10/30(日) 22:23:45.91

> round(cbind(surviors,expected.deaths,culm.deaths),3)
surviors expected.deaths culm.deaths
[1,] 1000.000 10.940 10.940
[2,] 989.060 10.820 21.760
[3,] 978.240 10.702 32.461
[4,] 967.539 10.585 43.046
[5,] 956.954 10.469 53.515
[6,] 946.485 10.354 63.869
[7,] 936.131 10.241 74.110
[8,] 925.890 10.129 84.239
[9,] 915.761 10.018 94.257
[10,] 905.743 9.909 104.166
[11,] 895.834 9.800 113.966
[12,] 886.034 9.693 123.659
[13,] 876.341 9.587 133.246
[14,] 866.754 9.482 142.728
[15,] 857.272 9.378 152.106
[16,] 847.894 9.276 161.382
[17,] 838.618 9.174 170.556
[18,] 829.444 9.074 179.630
[19,] 820.370 8.975 188.605
[20,] 811.395 8.876 197.481

**卵の名無しさん** · 2016/10/31(月) 12:05:06.59

>>535
## N=N0*exp(-λt) dN/dt=-λN

F4.3=function(Y=20,lmd=11/1000,N0=1000){
NEXP=function(t) N0*exp(-lmd*(t-1))
Survivors=NEXP(1:Y)
DeathsE=-diff(NEXP(1:(Y+1)),1)
DeathsCu=cumsum(DeathsE)
data.frame(生存者数=Survivors,年間死亡数=DeathsE,累積死亡数=DeathsCu)
}
round(F4.3(),3)

**卵の名無しさん** · 2016/10/31(月) 12:09:53.28

## N=N0*exp(-λt) dN/dt=-λN

F4.3=function(Y=20,lmd=11/1000,N0=1000){
NEXP=function(t) N0*exp(-lmd*(t-1))
Survivors=NEXP(1:Y)
DeathsE=-diff(NEXP(1:(Y+1)),1)
DeathsCu=cumsum(DeathsE)
data.frame(生存者数=Survivors,年間死亡数=DeathsE,累積死亡数=DeathsCu)
}

round(F4.3(20),3)

plotF4.3=function(Y=1000){
plot(F4.3(Y)[,1],ylim=c(0,1000),type="l",xlab="年",ylab="人",lwd=2)
lines(F4.3(Y)[,2],col="gray",lty=2,lwd=2)
lines(F4.3(Y)[,3],col="black",lty=3,lwd=2)
legend("topright",bty="n",cex=0.75,legend=c("生存数","年間死亡数","累積死亡"),lty=1:3,lwd=2,col=c(1,"gray",1))
}

dev.off()
layout(matrix(1:4,2,byrow=TRUE))
plotF4.3(20)
plotF4.3(64)
plotF4.3(630)
plotF4.3(1000)

**卵の名無しさん** · 2016/11/01(火) 06:16:53.19

現実的な設定ではないが、この死亡率(11/1000)が常に一定としてn歳時の平均余命average life expectancyを計算してみる。

ALE=function(n,lmd=11/1000){
C=integrate(f=function(x) exp(-lmd*x),0,Inf)$value
f=function(x) x*exp(-lmd*x)/C
integrate(f,n,Inf)$value
}
ALE(0)が平均寿命。
> ALE(0)
[1] 90.90909
これは当然、死亡率の逆数と一致する。

問題
上記設定で余命半年、10年になる年齢はそれぞれ何歳か?

LEy=function(y){
g=function(x,u)ALE(x)-u
uniroot(g,u=y,c(0,1000))$root
}

> LEy(0.5)
[1] 665.6297
> LEy(10)
[1] 342.6837

現実に反する数値が出るのは死亡率が年齢や時代に依らず常に一定という設定が間違っているからだろう。

**卵の名無しさん** · 2016/11/01(火) 06:24:46.59

崩壊確率が定数なのかどうかは知らない。
量子の世界の理論にはついていけないから。

**卵の名無しさん** · 2016/11/01(火) 18:27:11.32

Taxi=function(x,hatsunori.meter=1500,hatsunori.charge=630,kyori=352,kasan=90){
if(x<=hatsunori.meter) charge=hatsunori.charge
else{
charge=hatsunori.charge+(x-hatsunori.meter)%/%kyori*kasan + kasan*((x-hatsunori.meter)%%kyori!=0)
}
return(charge)
}

**卵の名無しさん** · 2016/11/02(水) 07:00:05.23

シリツ卒でも手先の器用な外科医はいる。天皇の執刀医とか。

ところが、ビタミンの長期欠乏は病気を招くという小学生の知識を欠いて
術後患者に脳症をつくるのがシリツのクオリティ。

藤田保健衛生大学病院に1億2000万円の賠償命令
http://anago.2ch.エスシー/test/read.cgi/hosp/1468629859/

養護しているシリツ卒の馬鹿さが際立っている。
40のレスには爆笑した。

39 名前：卵の名無しさん[sage] 投稿日：2016/07/17(日) 18:15:58.08 ID:KHLpXCgx.net [2/10]
>>35
医師免許以前の問題。
小学生でも知っていること。

小学校で習うらしいね。
＞ビタミンやミネラルは、毎日は取る必要がないが、長い間、まったく取らないと、病気になる。

40 名前：卵の名無しさん[age] 投稿日：2016/07/17(日) 18:17:12.18 ID:v3qJLb1E.net [9/20]
なら小学生に罪を押しつけるの？

**卵の名無しさん** · 2016/11/03(木) 02:38:50.44

贈賄を告白？
http://imagizer.imageshack.com/img921/1213/KrhR1a.jpg

**卵の名無しさん** · 2016/11/03(木) 09:13:32.15

pickup=function(M,n){
Len=1:length(M)
SampleNum=sample(Len,n)
Sampled=M[SampleNum]
Leftover=M[-SampleNum]
result=list(Sampled=Sampled,Leftover=Leftover)
return(result)
}

ad.hoc.sample=function(N=100,k=100,alpha=0.05,func=rnorm){
A=B=func(N)
P=numeric(k)+1
a=pickup(A,5) ; aSampled=a$Sampled ; aLeftover=a$Leftover
b=pickup(B,5) ; bSampled=b$Sampled ; bLeftover=b$Leftover
for(i in 5:k){
P[i]=t.test(aSampled,bSampled,var=TRUE)$p.value
if(P[i]<alpha) break # 有意差でれば終了
aa=pickup(aLeftover,1)
a=c(aSampled,aa$Sampled)
aSampled=a
aLeftover=aa$Leftover

bb=pickup(bLeftover,1)
b=c(bSampled,bb$Sampled)
bSampled=b
bLeftover=bb$Leftover
}
return(sum(P<alpha)) # 有意差がでた個数
}

mean(replicate(100,ad.hoc.sample(10000,100)))

**卵の名無しさん** · 2016/11/03(木) 09:17:43.44

# func（デフォルトは正規分布）に従う分布N個の乱数からなる同一母集団から
# 各々5~k個の標本を追加抽出してt検定で有意差をみる
seq.sample=function(N=100,k=100,func=rnorm){
A=B=func(N)
P=numeric(k) ; P[1:4]=1
Q=numeric(k)
a=pickup(A,5) ; aSampled=a$Sampled ; aLeftover=a$Leftover　# 最初の5個
b=pickup(B,5) ; bSampled=b$Sampled ; bLeftover=b$Leftover
for(i in 5:k){
P[i]=t.test(aSampled,bSampled,var=TRUE)$p.value　#追加抽出のp値
aa=pickup(aLeftover,1)　# 残りから1個追加抽出(aa$Sampled)
a=c(aSampled,aa$Sampled) # それを加えて
aSampled=a # 新標本aに
aLeftover=aa$Leftover # 抽出後の残りを新たな残りに

bb=pickup(bLeftover,1)
b=c(bSampled,bb$Sampled)
bSampled=b
bLeftover=bb$Leftover

Q[i]=t.test(sample(A,i),sample(B,i),var=TRUE)$p.value #追加でなく新たに母集団から5~k個の標本抽出
}
plot(log(Q),type="l",col="tomato",xlab="sample size",ylab="log(p.value)") # 新規抽出
lines(log(P),lwd=2)　# 追加抽出
abline(h=log(0.05),col="grey") # 有意水準 log(0.05)=-2.995732
}

par(mfrow=c(3,3))
dummy=replicate(9,seq.sample(10000,100)) #1/3くらいは有意差捏造できるのがわかる

**卵の名無しさん** · 2016/11/03(木) 10:30:51.00

##sampleと残りの標本を返す
pickup=function(M,n){
Len=1:length(M)
SampleNum=sample(Len,n)
Sampled=M[SampleNum]
Leftover=M[-SampleNum]
result=list(Sampled=Sampled,Leftover=Leftover)
return(result)
}
### 何回目に有意差が出たかを返す
ad.hoc.sample.End=function(N=100,k=100,alpha=0.05,func=rnorm){
A=B=func(N)
P=numeric(k)+1
a=pickup(A,5) ; aSampled=a$Sampled ; aLeftover=a$Leftover
b=pickup(B,5) ; bSampled=b$Sampled ; bLeftover=b$Leftover
End=0
for(i in 5:k){
P[i]=t.test(aSampled,bSampled,var=TRUE)$p.value
if(P[i]<alpha) {End=i ;break} # 有意差でれば終了
aa=pickup(aLeftover,1)
a=c(aSampled,aa$Sampled)
aSampled=a
aLeftover=aa$Leftover

bb=pickup(bLeftover,1)
b=c(bSampled,bb$Sampled)
bSampled=b
bLeftover=bb$Leftover
}
return(End)
}

**卵の名無しさん** · 2016/11/03(木) 10:43:08.18

mean.End=function(){
End=replicate(100,ad.hoc.sample.End(10^4,100))
Success.Rate=mean(End>0)
EndSig=End[End!=0]
mean.EndSig=mean(EndSig)
c(Success.Rate,mean.EndSig)
}

dat=replicate(100,mean.End())
quantile(dat[1,],c(0.025,0.5,0.975)
quantile(dat[2,],c(0.025,0.5,0.975)

**卵の名無しさん** · 2016/11/03(木) 12:57:52.90

dat=replicate(100,mean.End())
quantile(dat[1,],c(0.025,0.5,0.975))
quantile(dat[2,],c(0.025,0.5,0.975))
summary(dat[1,]) ; meanCI(dat[1,]) ; plot(density(dat[1,]))
summary(dat[2,]) ; meanCI(dat[2,]) ; plot(density(dat[2,]))

dat[,1:4]
test=numeric(100)
for(i in 1:100){
test[i]=((1-dat[1,i])*100+dat[2,i])/dat[1,i]
}

quantile(test,c(0.025,0.5,0.975))
summary(test) ; meanCI(test) ; plot(density(test))

**卵の名無しさん** · 2016/11/03(木) 14:42:25.09

Statistics are like bikinis. What they reveal is suggestive, but what they conceal is vital.

**卵の名無しさん** · 2016/11/03(木) 16:48:31.31

MeanCI=function(x,...){
lower=t.test(x,...)$conf.int[1]
m=mean(x)
upper=t.test(x,...)$conf.int[2]
CI=data.frame(lower=lower,mean=m,upper=upper)
return(CI)
}

MeanCI(rnorm(100),conf=0.90)

**卵の名無しさん** · 2016/11/04(金) 14:54:41.91

>>65
そのスレにこのような正論が

11 卵の名無しさん 2016/11/03(木) 12:04:35.28 ID:7lSXKLb8
>>9
日本だけじゃないです、アメリカも完全な学歴社会です
アメリカ人上司も、親の執刀医が若くて心配だったから、ググって出身校調べたって
そして日本の場合は、入った大学がある程度の知的能力とどれだけ努力できたかを示してしまうのは事実
医師という職業が、あるレベル以上の知的能力と、一生勉強できる勤勉さが必要なのがわかったからこそ、自分より下だといっぱいいっぱいなんでは？と思うのです

>入った大学がある程度の知的能力とどれだけ努力できたかを示してしまうのは事実

>入った大学がある程度の知的能力とどれだけ努力できたかを示してしまうのは事実　

>入った大学がある程度の知的能力とどれだけ努力できたかを示してしまうのは事実　　　　　　　　　　　

**卵の名無しさん** · 2016/11/04(金) 21:12:16.53

平成の御代の名言

医学部医学科を格付けしてみたぞ！！！！！！！！！！！！！！！ [無断転載禁止]©2ch.net
http://potato.2ch.net/test/read.cgi/hosp/1477828500/11

11 名前：卵の名無しさん[] 投稿日：2016/11/03(木) 12:04:35.28 ID:7lSXKLb8
>>9
日本だけじゃないです、アメリカも完全な学歴社会です
アメリカ人上司も、親の執刀医が若くて心配だったから、ググって出身校調べたって
そして日本の場合は、入った大学がある程度の知的能力とどれだけ努力できたかを示してしまうのは事実
医師という職業が、あるレベル以上の知的能力と、一生勉強できる勤勉さが必要なのがわかったからこそ、自分より下だといっぱいいっぱいなんでは？と思うのです

**卵の名無しさん** · 2016/11/05(土) 07:03:34.78

>>565
朝飯前に
10人に１人
100人に１人
1000人に１人
...
10,000,000人に１人
の副作用を確率95%でみつけるのに必要な人数をRでスクリプトを組んで計算してみた。

> NND2=function(person,ci=0.95)log(1-ci)/log(1-1/person)
> nn=10^(1:7)
> (NN=round(NND2(nn))+1)
[1] 29 299 2995 29957 299573 2995732 29957322

Rules of threeの誤差をパーセントで表すと
> (3*nn-NN)/NN*100
[1] 3.4482759 0.3344482 0.1669449 0.1435391 0.1425362 0.1424694 0.1424627

いい近似をしているのがわかる。

**卵の名無しさん** · 2016/11/05(土) 12:04:54.19

## 発生率比とリスク比の差
lambda=0.001
DRR=function(IRR,t) IRR - (1-exp(-IRR*lambda*t))/(1-exp(-lambda*t))
DRR(1,t=10)
curve(DRR(x,t=10),0,2,xlab="x(発生率比IRR")
points(1,0,pch=19)
segments(0,0,1,0,lty=3)
segments(1,0,1,-1,lty=3)

IRR=seq(0,1.5,le=20)
t=101:120
drr=outer(IRR,t,DRR)
persp(IRR,t,drr, theta=10, col="lightgreen",shade=0.75,phi=0,ltheta=-10,border=TRUE,
ticktype = "detailed",xlab="IRR",ylab="time",zlab="IRR - RR",main="発生率比とリスク比の差")
rgl::persp3d(IRR,t,drr, theta=35, col="lightgreen",shade=0.25,border=TRUE,
xlab="IRR",ylab="time",zlab="IRR - RR", ticktype = "detailed")
##

**卵の名無しさん** · 2016/11/06(日) 11:36:25.43

# RR = OR(1-P1) + P1
# P1=(OR-RR)/(OR-1) ; # P1:暴露群でのイベント発生率=a/(a+b)

# RR = OR/(OR*P0 + 1- P0)
# P0=(OR-RR)/((OR-1)*OR) ; # P0:非暴露群でのイベント発生率=c/(c+d)

**卵の名無しさん** · 2016/11/07(月) 06:40:14.65

#prop.test(S,n)$conf.int # S:success, n:number of trial
prop=function(S,n,cl=0.95)prop.test(S,n,conf.level=cl)$conf.int[1:2]

#binom.test(S,n)$conf.int # S:success, n:number of trial
binom=function(S,n,cl=0.95) binom.test(S,n,conf.level=cl)$conf.int[1:2]

## S:success, n:number of trial
binomCI=function(S,n,cl=0.95){
upper=uniroot(f=function(x)pbinom(S,n,x)-(1-cl)/2,c(0,1))$root
lower=uniroot(f=function(x)pbinom(S,n,x,lower.tail=FALSE)-(1-cl)/2,c(0,1))$root
CI=c(lower,upper)
return(CI)
}

##
wCI=function(S,n,cl=0.95){ #modified Wald CI for Proportion
z=qnorm(1-(1-cl)/2)
p.=(S+0.5*z^2)/(n+z^2)
W=z*sqrt((p.*(1-p.))/(n+z^2))
C.I.=c(p.-W,p.+W)
return(C.I.)
}

## Rothman Ch.9
SER=function(a,N,cl=0.95){
SE=sqrt(a*(N-a)/(N^3))
z=qnorm(1-(1-cl)/2)
W=z*SE
p.=a/N
C.I.=c(p.-W,p.+W)
return(C.I.)
}

**卵の名無しさん** · 2016/11/07(月) 07:02:41.26

Rothman（Epidemiology introduction)
の信頼区間の計算式
__________________
f(a,N) = a/N ±Z √ a(N-a)/N3　　　　Z=1.96(95%信頼区間のとき）

数が小さいと正しくない。[0,1]に収まらなかったりしている。

> f(1,3)
[1] -0.2001013 0.8667680
> f(2,3)
[1] 0.133232 1.200101

χ二乗検定やmodified Waldと比べても信頼区間を広く返す。

> Sn.test(20,100,0.95)
[1] 0.1292482 0.2943230 # prop.test
[1] 0.1266556 0.2918427 # binom.test
[1] 0.1326077 0.2895884 # Wald
[1] 0.1216014 0.2783986 # uniroot
[1] 0.1349440 0.2918242 # Rothman

**卵の名無しさん** · 2016/11/07(月) 07:57:57.20

> PropCIs::exactci(20,100,0.95)

data:

95 percent confidence interval:
0.1266556 0.2918427

**卵の名無しさん** · 2016/11/08(火) 08:39:26.27

CP=function(S,n,cl=0.95,prob=0.5){
L=binom.test(S,n,alt="less",conf=cl,p=prob)
T=binom.test(S,n,alt="two",conf=cl,p=prob)
G=binom.test(S,n,alt="greater",conf=cl,p=prob)
d=matrix(c(G$conf[1],G$conf[2],T$conf[1],T$conf[2],L$conf[1],L$conf[2]),byrow=TRUE,3,2)
p=c(G$p.value,T$p.value,G$p.value)
d=cbind(d,p)
colnames(d)=c("lower","upper",paste("H0:p=",round(prob,3)))
rownames(d)=c("lower.sided","two.sided","greater.sided")
return(d)
}

**卵の名無しさん** · 2016/11/09(水) 01:58:51.48

http://epitools.ausvet.com.au/content.php?page=CIProportion

**卵の名無しさん** · 2016/11/09(水) 07:09:27.28

国立大学卒医師の学力を反映した投稿:
http://potato.2ch.net/test/read.cgi/hosp/1435294075/908

裏口入学底辺私立医大卒医師の下劣な投稿:
http://potato.2ch.net/test/read.cgi/hosp/1435294075/909

**卵の名無しさん** · 2016/11/09(水) 08:17:01.57

http://www.cognoptix.com/video/corpvideo.htm

**卵の名無しさん** · 2016/11/09(水) 08:18:29.49

https://cran.r-project.org/package=binom

**卵の名無しさん** · 2016/11/10(木) 14:09:08.26

二項モデルでの信頼区間

bCIs=function(x,n,...){
PEci=binom::binom.confint(x,n)
plot(PEci$upper,1:length(PEci$method),xlim=c(min(PEci$lower)*0.9,max(PEci$upper)*1.1),type="n",
yaxt="n",ylab="",xlab="Confidence Interval",main=paste("C.I. for", x,"out of",n))
points(PEci$upper,PEci$method,pch="|")
points(PEci$lower,PEci$method,pch="|")
segments(PEci$lower,1:length(PEci$method),PEci$upper,1:length(PEci$method),
lwd=3,col="gray")
abline(v=PEci$mean[1],lty=3)
text(PEci$mean,PEci$method,as.vector(PEci$method),cex=1.1)
return(PEci)
}

http://i.imgur.com/LuMi8Hg.jpg

**卵の名無しさん** · 2016/11/10(木) 15:21:35.71

最尤法での信頼区間追加

bCIs=function(x,n,cl=0.95){
PEci=binom::binom.confint(x,n,conf.level=cl)
MLEu=uniroot(f=function(p)pbinom(x,n,p)-(1-cl)/2,c(0,1))$root
MLEl=uniroot(f=function(p)pbinom(x,n,p,lower.tail=FALSE)-(1-cl)/2,c(0,1))$root
mle=data.frame(method="mle",x=x,n=n,mean=x/n,lower=MLEl,upper=MLEu)
PEci=rbind(PEci,mle)
plot(PEci$upper,1:length(PEci$method),xlim=c(min(PEci$lower),max(PEci$upper)),type="n",
yaxt="n",ylab="",xlab="Confidence Interval",main=paste("C.I. for", x,"out of",n))
points(PEci$upper,PEci$method,pch="|")
points(PEci$lower,PEci$method,pch="|")
segments(PEci$lower,1:length(PEci$method),PEci$upper,1:length(PEci$method),
lwd=3,col="gray")
abline(v=PEci$mean[1],lty=3)
text(PEci$mean,PEci$method,as.vector(PEci$method),cex=1.1)
# axis(2, at=1:nrow(PEci), labels=PEci$method,as.vector,las=1,cex=0.9)
return(PEci)
}

**卵の名無しさん** · 2016/11/10(木) 17:07:04.50

http://imagizer.imageshack.com/img924/5035/4bc8Sq.jpg

http://imagizer.imageshack.com/img923/1595/lQ6UZc.jpg

**卵の名無しさん** · 2016/11/10(木) 17:08:08.89

国立大学卒医師の学力を反映した投稿:
http://potato.2ch.net/test/read.cgi/hosp/1435294075/908

裏口入学底辺私立医大卒医師の下劣な投稿:
http://potato.2ch.net/test/read.cgi/hosp/1435294075/909

http://imagizer.imageshack.com/img924/5035/4bc8Sq.jpg

http://imagizer.imageshack.com/img923/1595/lQ6UZc.jpg

**卵の名無しさん** · 2016/11/11(金) 18:00:41.10

ド底辺シリツ医大卒の第一法則：
　ド底辺シリツ医大が悪いのではない、本人の頭が悪いんだ。

ド底辺シリツ医大卒の第二法則：
　底辺シリツ医大卒は恥ずかしくて、学校名を皆さま言いません。

ド底辺シリツ医大卒の第三法則
　底辺シリツ医大に入学すると馬鹿になる。

第三法則の参考資料
http://i.imgur.com/XBFnEcU.jpg

**卵の名無しさん** · 2016/11/11(金) 18:04:29.03

ド底辺シリツ医大卒の第一法則：
　ド底辺シリツ医大が悪いのではない、本人の頭が悪いんだ。

ド底辺シリツ医大卒の第二法則：
　底辺シリツ医大卒は恥ずかしくて、学校名を皆さま言いません。

ド底辺シリツ医大卒の第三法則
　底辺シリツ医大に入学すると馬鹿になる。

第三法則の参考資料
http://i.imgur.com/XBFnEcU.jpg
三法則を川柳にしてみました。

第一法則　
　　本人の　頭がわるくて　ド底辺

第二法則　
　　いつまでも　大学名乗れぬ　ド底辺

第三法則　
　　裏口は　卒業しても　ド底辺

参考句
　ド底辺　生きているのが　恥ずかしい
　ド底辺　馬鹿は死ななきゃ　治らない
　医者だけど　平気で嘘つく　ド底辺
http://i.imgur.com/xpEEgUB.jpg

**卵の名無しさん** · 2016/11/11(金) 18:05:02.25

ド底辺シリツ医大卒の第一法則：
　ド底辺シリツ医大が悪いのではない、本人の頭が悪いんだ。

ド底辺シリツ医大卒の第二法則：
　底辺シリツ医大卒は恥ずかしくて、学校名を皆さま言いません。

ド底辺シリツ医大卒の第三法則
　底辺シリツ医大に入学すると馬鹿になる。

第三法則の参考資料
http://i.imgur.com/XBFnEcU.jpg

三法則を川柳にしてみました。

第一法則　
　　本人の　頭がわるくて　ド底辺

第二法則　
　　いつまでも　大学名乗れぬ　ド底辺

第三法則　
　　裏口は　卒業しても　ド底辺

参考句
　ド底辺　生きているのが　恥ずかしい
　ド底辺　馬鹿は死ななきゃ　治らない
　医者だけど　平気で嘘つく　ド底辺
http://i.imgur.com/xpEEgUB.jpg

**卵の名無しさん** · 2016/11/11(金) 18:10:19.54

ド底辺シリツ医大卒の第一法則：
　ド底辺シリツ医大が悪いのではない、本人の頭が悪いんだ。

ド底辺シリツ医大卒の第二法則：
　ド底辺シリツ医大卒は恥ずかしくて、学校名を皆さま言いません。

ド底辺シリツ医大卒の第三法則
　ド底辺シリツ医大に入学すると馬鹿になる。

第三法則の参考資料
http://i.imgur.com/XBFnEcU.jpg

三法則を川柳にしてみました。

第一法則　
　　本人の　頭がわるくて　ド底辺

第二法則　
　　いつまでも　大学名乗れぬ　ド底辺

第三法則　
　　裏口は　卒業しても　ド底辺

参考句
　ド底辺　生きているのが　恥ずかしい
　ド底辺　馬鹿は死ななきゃ　治らない
　医者だけど　平気で嘘つく　ド底辺
http://i.imgur.com/xpEEgUB.jpg

**卵の名無しさん** · 2016/11/12(土) 06:34:54.71

『私立大学医学部医学科』歩留率ワースト順

052位：日本医科(32.0％、242人）
062位：愛知医科(34.0％、419人）
117位：東京慈恵会医科(40.4％、252人）
156位：自治医科(43.9％、291人）
235位：聖マリアンナ医科(50.7％、112人）
243位：東京医科(51.0％、214人）
248位：大阪医科(51.3％、188人）
282位：岩手医科(53.7％、209人）
287位：金沢医科(54.0％、156人）
289位：兵庫医科(54.0％、97人）
310位：獨協医科(56.2％、173人）
381位：埼玉医科(62.7％、76人）
383位：東京女子医科(62.9％、119人）
410位：川崎医科(65.7％、58人）
488位：産業医科(74.3％、67人）

http://utsunomiyasoh.blog.fc2.com/blog-entry-105.html

http://i.imgur.com/4wHOfpa.jpg

ここで一句

ド底辺　進学するのは　残りカス

**卵の名無しさん** · 2016/11/12(土) 14:18:50.68

# ケースコントロール研究における累積標本抽出
# RR = OR(1-P1) + P1
# OR=(RR-P1)/(1-P1)
# P1=(OR-RR)/(OR-1) ; # P1:暴露群でのイベント発生率=a/(a+b)

# RR = OR/(OR*P0 + 1- P0)
# OR= (1-P0)*RR/(1-P0*RR)
# P0=(OR-RR)/((OR-1)*OR) ; # P0:非暴露群でのイベント発生率=c/(c+d)

OR1=function(RR,P1) (RR-P1)/(1-P1)
OR1(4,0.4)
OR1(4,0.04)

OR0=function(RR,P0) (1-P0)*RR/(1-P0*RR)
OR0(4,0.1)
OR0(4,0.01)

f1=function(x)OR1(4,x)
xx=0.5^(1:10)
plot(log10(xx),sapply(xx,f1),ylab="Odds Ratio",xlab="log10(P1)",pch=19)

f0=function(x)OR0(4,x)
xx=0.5^(2:10)
plot(log10(xx),sapply(xx,f0),ylab="Odds Ratio",xlab="log10(P0)",pch=19)

**卵の名無しさん** · 2016/11/12(土) 17:09:03.35

#　症例コホールト研究では
#　対照が曝露と無関係に抽出されている限りオッズ比はリスク比の妥当な推定値となる
#　対照群は原集団全体から標本抽出されるので稀少疾患であるという前提は必要ない

k=25 #　サンプル数曝露　：非曝露=　k*r : k
r=0.1 #　曝露人口比曝露：非曝露= r : 1
#　リスク比 = 4
(d5=matrix(c(r*40,r*k,10,k),2,byrow=TRUE))
Epi::twoby2(d5)

**卵の名無しさん** · 2016/11/12(土) 17:28:13.56

　　ド底辺　生きているのが　恥ずかしい

　　ド底辺　馬鹿は死ななきゃ　治らない

　　本人の　頭がわるくて　ド底辺

　　裏口は　卒業できても　ド底辺

　　統計も使えぬ馬鹿はド底辺

　　老人もみんな嫌がるド底辺　　

　　グーグルも　裏口バカは　ド底辺

　　医者だけど　平気で嘘つく　ド底辺

　　ド底辺　幼児相手の　変質者
　　
　　ド底辺　卒業大学　ひた隠し

　　ウンコより　汚らわしいのが　ド底辺　

第一法則　
　　本人の　頭がわるくて　ド底辺

第二法則　
　　いつまでも　大学名乗れぬ　ド底辺

第三法則　
　　裏口は　卒業しても　ド底辺

**卵の名無しさん** · 2016/11/12(土) 17:29:25.04

　　ド底辺　大学名を　ひた隠し　　学位をとるも　恥の上塗り

　　今日もまた　コピペで誤魔化す　ド底辺　アボーン設定の筈なのに

　　統計も　対偶すらも　わからない　生きて恥ずかし　裏口シリツ

　　裏口は悲しからずや馬鹿でアホ、屈辱ゆえに大学名乗らず

　　患者から　言われなければ　わからない　何を抜かすか　　裏口バカが

　　他所いけや　対偶わからぬ　ド底辺　出身校は嘘つかない

　　ド底辺　当直室で　エロサイト　ウイルス残して　帰宅する

　　バカゆえに　統計でると　レスできず　お気の毒だね、底辺シリツ

　　ド底辺　卒業大学　ひた隠し　同期といわれ　他人を装う

**卵の名無しさん** · 2016/11/12(土) 21:50:41.93

# case ctrl
# exposure a b
# no exposure c d

# OR = ad/bc
# q1 = a/(a+c) 疾病群での暴露リスク
# q0 = b/(b+d) 対照群での暴露リスク
# RR = q1/q0
# RR =a/(a+c) ÷ b/(b+d)=a(b+d)÷b(a+c)=(ab+ad)/(ab+bc)
# =(ab+bc*OR)/(ab+bc)　∵ ad=bc*OR
#　　=(c*OR+a)/(a+c)
#　　=OR*c/(a+c)+a/(a+c)
#　　=OR*( 1-a/(a+c) ) + a/(a+c)
# =OR*(1-q1) + q1

# RR = a/(a+c) ÷ b/(b+d)=a(b+d)÷b(a+c)=(ab+ad)/(ab+bc)
# = (ab+ad)/(ab+ad/OR) ∵ bc=ad/OR
# = (b+d) /(b + d/OR) # (b+d) で割る
# =1 / {b/(b+d) + d/[(b+d)/OR]}
# =OR/{OR*b/(b+d) + d/(b+d)} # ORを掛ける
# =OR/{OR*b/(b+d) + (b+d)/(b+d)-b/(b+d)}
# =OR/(OR*q0 + 1-q0)

**卵の名無しさん** · 2016/11/12(土) 21:55:06.31

# RR = OR(1-q1) + q1
# OR=(RR-q1)/(1-q1)
# q1=(OR-RR)/(OR-1) ; # q1:疾病群での暴露リスク=a/(a+c)

# RR = OR/(OR*q0 + 1- q0)
# OR= (1-q0)*RR/(1-q0*RR)
# q0=(OR-RR)/((OR-1)*OR) ; # q0:対照群での暴露リスク=b/(b+d)

**卵の名無しさん** · 2016/11/13(日) 06:45:03.03

>>593
(revised)
# RR = OR(1-q1) + q1
# OR=(RR-q1)/(1-q1)
# q1=(OR-RR)/(OR-1) ; # q1:疾病群での暴露リスク=a/(a+c)

# RR = OR/(OR*q0 + 1- q0)
# OR= (1-q0)*RR/(1-q0*RR)
# q0=(OR-RR)/((OR-1)*RR) ; # q0:対照群での暴露リスク=b/(b+d)

**卵の名無しさん** · 2016/11/13(日) 06:45:40.48

>>588
(revised)

# ケースコントロール研究における累積標本抽出
# RR = OR(1-P1) + P1
# OR=(RR-P1)/(1-P1)
# P1=(OR-RR)/(OR-1) ; # P1:暴露群でのイベント発生率=a/(a+b)

# RR = OR/(OR*P0 + 1- P0)
# OR= (1-P0)*RR/(1-P0*RR)
# P0=(OR-RR)/((OR-1)*RR) ; # P0:非暴露群でのイベント発生率=c/(c+d)

**卵の名無しさん** · 2016/11/13(日) 08:52:34.42

題材は、喫煙・ピロリ菌・胃がんでもいいのだが、

　論理演算ができないなど高校卒業の学力がない（蔑称：バカ）という因子　と
　任意の寄付金を支払う（蔑称：裏金）という因子を

ド底辺シリツ医大進学というスティグマを背負うリスク（略称：ド底辺リスク）で検討しよう。

ド底辺シリツ受験生の偏差値によりバカ因子の有無を判定、
裏金因子については本人の申告により得られた数字としよう（数字は仮想データ）。

　　　　　　裏金なし　　裏金あり
バカでない　　　１　　　　　３
バカである　　１０　　　　２０

バカ因子でド底辺リスクが１→１０（９の増加、１０倍の増加）、３→２０（１７の増加、６．７倍の増加）
裏金因子でド底辺リスクが１→３（２の増加、３倍の増加）、１０→２０（１０の増加、２倍の増加）
と変化している。

ド底辺リスクにバカ因子と裏金因子の交互作用が存在するか？

**卵の名無しさん** · 2016/11/13(日) 12:12:45.23

ye=c(13,20,15,2,10,20,18,20,11,20)
ev=c(1,0,0,1,1,0,0,0,1,0)
ex=c(1,1,1,1,1,0,0,0,0,0)
(dat5.2=data.frame(years=ye,event=ev,exposure=ex))
attach(dat5.2)
(N=sum(event))　#全発症数
(Y=sum(years)) # 全人年
N/Y # 全発症率 4/149= 0.0268
i.time=3 # 誘導期間
(Ypost=years[years>i.time]) # 誘導期間を超えて追跡された人の全長年数
(PostPeriod=sum(Ypost-i.time)) # 誘導期間を超える年数の総和
(post.dat=subset(dat5.2,years>i.time & event==1)) # 誘導期間後に発症した症例
(Npost=nrow(post.dat)) # 誘導期間発症症例数
Npost/PostPeriod #　誘導期間後発症率 3/120 0.025

**卵の名無しさん** · 2016/11/13(日) 12:12:51.66

# 誘導期間を考えない暴露群発症率 3/60 = 0.05
(ev.exp.all=subset(dat5.2,event==1 & exposure==1))
(ye.exp.all=subset(dat5.2,exposure==1))
(Nexp.all=nrow(ev.exp.all))
(Yexp.all=sum(ye.exp.all$years))

# 誘導期間を考えない非暴露群発症率 1/89 = 0.0112
(ev.nex.all=subset(dat5.2,event==1 & exposure==0))
(ye.nex.all=subset(dat5.2,exposure==0))
(Nnex.all=nrow(ev.nex.all))
(Yn.all=sum(ye.nex.all$years))

fmsb::rateratio(3,1,60,89)

# 誘導期間を考えた暴露群発症率 2/46= 0.0435
(ev.exp.post=subset(dat5.2,event==1 & exposure==1 & years>i.time))
(ye.exp.post=subset(dat5.2,exposure==1 & years>i.time))
(Nexp.post=nrow(ev.exp.post))
(Yexp.post=sum(ye.exp.post$years-i.time))

# 誘導期間を考えた非暴露群発症率 1/74 = 0.0135
(ev.nex.post=subset(dat5.2,event==1 & exposure==0 & years>i.time))
(ye.nex.post=subset(dat5.2,exposure==0 & years>i.time))
(Nnex.post=nrow(ev.nex.post))
(Ynex.post=sum(ye.nex.post$years-i.time))

fmsb::rateratio(2,1,46,74)

**卵の名無しさん** · 2016/11/13(日) 14:11:15.71

# 誘導期間i.timeを考えた曝露群発症率 vs 3/59 = 5.08%
IExp=function(i.time=3){
(ev.exp.post=subset(dat5.2,event==1 & exposure==1 & years>i.time))
(ye.exp.post=subset(dat5.2,exposure==1 & years>i.time))
(Nexp.post=nrow(ev.exp.post))
(Yexp.post=sum(ye.exp.post$years-i.time))
Nexp.post/Yexp.post
}
xx=seq(0.5,13,le=1000)
plot(xx,sapply(xx,IExp),pch=19,xlab="Induction Period(Years)",ylab="Incidence Ratio")
abline(h=3/59,lty=3)
legend("topleft",bty="n",legend="No Induction Period",lty=3)

f=function(x,u)IExp(x)-u
uniroot(f,u=3/59,c(2,6))$root

**卵の名無しさん** · 2016/11/13(日) 14:11:54.88

>>598
# 非曝露群に誘導期間の考慮は不要である非曝露群発症率 1/89 = 1.12%
(ev.nex.post=subset(dat5.2,event==1 & exposure==0 & years>i.time))
(ye.nex.post=subset(dat5.2,exposure==0 & years>i.time))
(Nnex.post=nrow(ev.nex.post))
(Ynex.post=sum(ye.nex.post$years))
1/(20+18+20+11+20)

**卵の名無しさん** · 2016/11/13(日) 17:41:47.39

#Reed-Frost Model
ReedFrost=function(
p=0.04,
N=100,
T=40)
{
q=1-p
I=numeric(T)
S=numeric(T)
I[1]=1
S[1]=N-I[1]
for(t in 1:(T-1)){
I[t+1]=S[t]*(1-q^I[t])
S[t+1]=S[t]-I[t+1]
}

plot(1:T,I,type="l",lwd=2, ylim=c(0,N),xlab="time",ylab="persons",main=paste("Reed-Frost Model p= ",p))
lines(S,lty=2,col=2,lwd=2)
lines(N-S,lty=3,col=3,lwd=2)
legend("topright",bty="n",legend=c("Infected","Sensitive","Immunized"),lty=1:3,col=1:3,lwd=2)
}

par(mfrow=c(1,2))
ReedFrost(0.04)
ReedFrost(0.015)

**卵の名無しさん** · 2016/11/13(日) 17:43:06.41

http://i.imgur.com/OTwfvKR.png

**卵の名無しさん** · 2016/11/14(月) 07:34:08.42

ド底辺シリツ医大卒の輝かしい業績

勉強すれば、叱られる
http://i.imgur.com/XBFnEcU.jpg

バカが治ったのならば死んでいる
http://i.imgur.com/EqONeez.jpg

**卵の名無しさん** · 2016/11/14(月) 21:36:58.49

桃関数

# p値関数 vcd::oddsratio, confintで信頼区間境界からグラフ化
CIfunc=function(A,B,C,D){
DO=matrix(c(A,B,C,D),2,byrow=TRUE)
oDO=vcd::oddsratio(DO,log=FALSE)
# confint(oDO,level=0.95)
f1=function(x)confint(oDO,level=1-x)[1]
f2=function(x)confint(oDO,level=1-x)[2]
xx=seq(0,1,by=0.01)
y1=sapply(xx,f1)
y2=sapply(xx,f2)
plot(log10(y1),xx,xlim=c(-1,2),type="l",xlab="Rate Ratio(log scale)",ylab="p.value",lwd=1,main="P.value function")
lines(log10(y2),xx,lwd=1)
abline(v=log10(1),lty=3)
abline(h=0.05,lty=3,col="gray")
return(DO)
}

DO=CIfunc(4,386,4,1250)
Epi::twoby2(DO)
chisq.test(DO,correct=FALSE)
par(new=TRUE)
DO1=CIfunc(1090,14910,1000,15000)
Epi::twoby2(DO1)
chisq.test(DO1,correct=FALSE)

**卵の名無しさん** · 2016/11/15(火) 10:42:17.30

SJW=function(A,B,C,D){ # Relative Risk cohort study
DR=matrix(c(A,B,C,D),2,byrow=TRUE)
fl=function(x)Epi::twoby2(DR,alpha=x,print=FALSE)$measures[1,2]
fu=function(x)Epi::twoby2(DR,alpha=x,print=FALSE)$measures[1,3]
le=100
xx=seq(0,1,length=le) ; xx=xx[c(-1,-le)]
y1=sapply(xx,fl)
y2=sapply(xx,fu)
xlim=c(min(y1),max(y2))
plot(y1,xx,log="x",xlim=xlim,type="l",lwd=2,xlab="Relative Risk(log scale)",ylab="p.value",main="P.value function(Cohort Study)")
lines(y2,xx,lwd=2)
abline(v=1,lty=3)
abline(h=0.05,lty=3,col="gray")
Epi::twoby2(DR)
return(DR)
}

Subjects CVD events % HR p value 95%CI
Placebo 2333 282 12.1
Empagliflozin 10mg 2345 243 10.4 0.85 0.07 0.72-1.01
Empagliflozin 25mg 2342 247 10.5 0.86 0.09 0.73-1.02
Empagliflozin 10mg+25mg 4687 490 10.5 0.86 0.04 0.74-0.99

dev.off()
layout(matrix(c(1,2,3,3),2,byrow=TRUE))
E10=SJW(243,2345-243,282,2333-282) ; chisq.test(E10,correct = FALSE) ; prop.test(c(243,282),c(2345,2333))
E25=SJW(247,2342-247,282,2333-282) ; chisq.test(E25,correct = FALSE) ; prop.test(c(247,282),c(2342,2333))
E1025=SJW(490,4687-490,282,2333-282) ; chisq.test(E1025,correct=FALSE) ; prop.test(c(490,282),c(4687,2333))

**卵の名無しさん** · 2016/11/15(火) 10:42:53.47

# p値関数 vcd::oddsratio, confintで信頼区間境界からグラフ化
CIfunc=function(A,B,C,D){ # Oddsratio 症例対照study
DO=matrix(c(A,B,C,D),2,byrow=TRUE)
oDO=vcd::oddsratio(DO,log=FALSE)
# confint(oDO,level=0.95)
f1=function(x)confint(oDO,level=1-x)[1]
f2=function(x)confint(oDO,level=1-x)[2]
xx=seq(0,1,by=0.01) ; xx=xx[-1]
y1=sapply(xx,f1)
y2=sapply(xx,f2)
xlim=c(min(y1),max(y2))
plot(y1,xx,xlim=xlim,log="x",type="l",lwd=2,xlab="Odds Ratio(log scale)",ylab="p.value",main="P.value function(Case-Control)")
lines(y2,xx,lwd=2)
abline(v=1,lty=3)
abline(h=0.05,lty=3,col="gray")
Epi::twoby2(DO)
return(DO)
}

DO=CIfunc(4,386,4,1250)
chisq.test(DO,correct=FALSE)

**卵の名無しさん** · 2016/11/15(火) 13:10:10.93

「くじ引きが無作為である」という帰無仮説のもとで宝くじに当選する確率はとても低い（０．０５未満)。
宝くじに当選者がでたということはp<0.05のことが起こったので「くじ引きが無作為」という帰無仮説は棄却される。
正しい議論か？

**卵の名無しさん** · 2016/11/15(火) 13:11:45.79

# p値関数 vcd::oddsratio, confintで信頼区間境界からグラフ化
CIfunc=function(A,B,C,D){ # Oddsratio 症例対照study
DO=matrix(c(A,B,C,D),2,byrow=TRUE)
oDO=vcd::oddsratio(DO,log=FALSE)
# confint(oDO,level=0.95)
f1=function(x)confint(oDO,level=1-x)[1]
f2=function(x)confint(oDO,level=1-x)[2]
xx=seq(0,1,by=0.01) ; xx=xx[-1]
y1=sapply(xx,f1)
y2=sapply(xx,f2)
xlim=c(min(y1),max(y2))
plot(y1,xx,xlim=xlim,log="x",type="l",lwd=2,xlab="Odds Ratio(log scale)",ylab="p.value",main="P.value function(Case-Control)")
lines(y2,xx,lwd=2)
abline(v=1,lty=3)
abline(h=0.05,lty=3,col="gray")
Epi::twoby2(DO)
return(DO)
}

DO=CIfunc(4,386,4,1250)
chisq.test(DO,correct=FALSE)

**卵の名無しさん** · 2016/11/16(水) 20:55:39.97

# Hazard Rate 95% C.I. to p.value with graph
CI2P=function(L,U,cl=0.95,from=0.01,to=20){
RR=sqrt(L*U)
SE=log(L/RR)/(-qnorm(1-(1-cl)/2))
RL=function(p) RR*exp(-qnorm(1-p/2)*SE)
RU=function(p) RR*exp(+qnorm(1-p/2)*SE)
pl=(1-pnorm(log(RR)/SE))*2
pu=(1-pnorm(-log(RR)/SE))*2
p.value=ifelse(pl<=1,pl,pu)
yy=seq(0,1,le=10^5)
xlim=c(from,to)
plot(sapply(yy,RU),yy,log="x",type="l",xlim=xlim,lwd=2,xlab="RR(log scale)",ylab="p.value",
main=paste(cl*100,"%RR Conf.Int = [",L,"-",U,"] p.value=",round(p.value,4)))
lines(sapply(yy,RL),yy,lwd=2)
abline(h=0.05,lty=3,col=2)
abline(v=1,lty=2,col=4)
legend("topleft",bty="n",legend=c("p=0.05","RR=1"),col=c(2,4),lty=3)
return(p.value)
}

**卵の名無しさん** · 2016/11/17(木) 06:33:04.35

RR2P=function(a,N1,b,N0,...){
SE=sqrt(1/a-1/N1+1/b-1/N0)
RR=(a/N1)/(b/N0)
f=function(x){
pl=(1-pnorm(log(x)/SE))*2
pu=(1-pnorm(-log(x)/SE))*2
p.value=ifelse(pl<=1,pl,pu)
return(p.value)
}
xx=seq(0,10,by=0.01)
xx=xx[-1]
plot(xx,sapply(xx,f),type="l",lwd=2,xlab="RR",ylab="p.value",...)
abline(h=0.05,lty=3,col=2)
abline(v=RR,lty=2,col=4)
legend("topleft",bty="n",legend=c("p=0.05","estimated RR"),col=c(2,4),lty=3)
names(RR)="Estimated RR"
return(RR)
}

RR2P(4,386,4,1250,xlim=c(0.01,10))
RR2P(4,386,4,1250,xlim=c(0.01,10),log="x")
RR2P(4,386,4,1250,xlim=c(0.01,10),ylim=c(0.001,1),log="y")
RR2P(4,386,4,1250,xlim=c(0.01,10),ylim=c(0.001,1),log="xy")

**卵の名無しさん** · 2016/11/17(木) 06:33:51.90

par(mfrow=c(2,2))
#Subjects CVD events % HR p value 95%CI
#Placebo 2333 282 12.1
#Empagliflozin 10mg　　　2345 243 10.4 0.85 0.07 0.72-1.01
#Empagliflozin 25mg 2342 247 10.5 0.86 0.09 0.73-1.02
#Empagliflozin 10mg+25mg 4687 490 10.5 0.86 0.04 0.74-0.99
RR2P(243,2345,282,2333,xlim=c(0.5,1.5))
RR2P(243,2345,282,2333,xlim=c(0.5,1.5),log="x")
RR2P(243,2345,282,2333,xlim=c(0.5,1.5),ylim=c(0.001,1),log="y")
RR2P(243,2345,282,2333,xlim=c(0.5,1.5),ylim=c(0.001,1),log="xy")

http://i.imgur.com/Ne3hXgl.jpg

**卵の名無しさん** · 2016/11/18(金) 12:03:04.69

>>610
# debugged

RR2P=function(a,N1,b,N0,...){
SE=sqrt(1/a-1/N1+1/b-1/N0)
RR=(a/N1)/(b/N0)
f=function(x){
pl=(1-pnorm(log(x/RR)/SE))*2
pu=(1-pnorm(-log(x/RR)/SE))*2
p.value=ifelse(pl<=1,pl,pu)
return(p.value)
}
xx=seq(0,10,by=0.01)
xx=xx[-1]
plot(xx,sapply(xx,f),type="l",lwd=2,xlab="RR",ylab="p.value",...)
abline(h=0.05,lty=3,col=2)
abline(v=RR,lty=2,col=4)
legend("topleft",bty="n",legend=c("p=0.05","estimated RR"),col=c(2,4),lty=3)
names(RR)="Estimated RR"
return(RR)
}

RR2P(4,386,4,1250,xlim=c(0.01,10))
RR2P(4,386,4,1250,xlim=c(0.01,10),log="x")
RR2P(4,386,4,1250,xlim=c(0.01,10),ylim=c(0.001,1),log="y")
RR2P(4,386,4,1250,xlim=c(0.01,10),ylim=c(0.001,1),log="xy")

**卵の名無しさん** · 2016/11/18(金) 15:24:51.18

シリツ医大に行くと国立コンプでこんな投稿して憂さ晴らしらしいね。
日頃から患者からも同業者からも　裏口バカ　と罵られる毎日なんだろうな。

http://imagizer.imageshack.com/img922/7258/5MPPu5.jpg

**卵の名無しさん** · 2016/11/19(土) 22:31:01.03

# Exact法(Clopper-Pearson)信頼区間のconf.levelを変更した信頼区間を返す
# RR:Risk Ratio, l0,u0: conf.level=cl0での信頼区間をcl1の区間に変更
ConvExactCI=function(RR,l0,u0,cl0=0.95,cl1=0.90){ # 95%→90%に
L0 = function(n,RR,cl0) 1/(1+(n-n*RR+1)/(n*RR*qf((1-cl0)/2, 2*n*RR,2*(n-n*RR+1))))
fl = function(x,u)L0(x,RR,cl0)-u
(nL=uniroot(fl,u=l0,c(1,10^4))$root)
(rL=RR*nL)
(L1=L0(nL,RR,cl1))

U0 = function(n,RR,cl0) 1/(1+(n-n*RR)/((n*RR+1)*qf(1-(1-cl0)/2, 2*(n*RR+1), 2*(n-n*RR))))
fu = function(x,u)U0(x,RR,cl0)-u
(nU=uniroot(fu,u=u0,c(1,10^4))$root)
(nU=RR*nU)
(U1=U0(nU,RR,cl1))

CI=c(L1,U1,cl1)
names(CI)=c("lower","upper","conf.level")
return(round(CI,4))
}

**卵の名無しさん** · 2016/11/19(土) 23:07:40.35

debugged

# Exact法(Clopper-Pearson)信頼区間のconf.levelを変更した信頼区間を返す
# RR:Risk Ratio, l0,u0: conf.level=cl0での信頼区間をcl1の区間に変更
ConvExactCI=function(RR,l0,u0,cl0=0.95,cl1=0.90){ # 95%→90%に
L0 = function(n,rr,cl) 1/(1+(n-n*rr+1)/(n*rr*qf((1-cl)/2, 2*n*rr,2*(n-n*rr+1))))
fl = function(x,u)L0(x,rr=RR,cl=cl0)-u
(nL=uniroot(fl,u=l0,c(1,10^4))$root)
(L1=L0(nL,RR,cl1))

U0 = function(n,rr,cl) 1/(1+(n-n*rr)/((n*rr+1)*qf(1-(1-cl)/2, 2*(n*rr+1), 2*(n-n*rr))))
fu = function(x,u)U0(x,rr=RR,cl=cl0)-u
(nU=uniroot(fu,u=u0,c(1,10^4))$root)
(U1=U0(nU,RR,cl1))

CI=c(L1,U1,cl1)
names(CI)=c("lower","upper","conf.level")
return(round(CI,4))
}

**卵の名無しさん** · 2016/11/20(日) 08:20:37.59

http://i.imgur.com/GXZxSwF.jpg

**卵の名無しさん** · 2016/11/23(水) 19:53:06.28

neet is coined from the english "not in education, employment or training."

**卵の名無しさん** · 2016/11/23(水) 21:51:35.31

医科歯科君のヵ栗

**卵の名無しさん** · 2016/11/26(土) 12:50:44.67

http://i.imgur.com/k0EGF18.jpg

**卵の名無しさん** · 2016/11/26(土) 23:41:07.09

# RR = OR(1-q1) + q1
# OR=(RR-q1)/(1-q1)
# q1=(OR-RR)/(OR-1) ; # q1:疾病群での暴露リスク=a/(a+c)

# RR = OR/(OR*q0 + 1- q0)
# OR= (1-q0)*RR/(1-q0*RR)
# q0=(OR-RR)/((OR-1)*RR) ; # q0:対照群での暴露リスク=b/(b+d)

# ケースコントロール研究における累積標本抽出
# RR = OR(1-P1) + P1
# OR=(RR-P1)/(1-P1)
# P1=(OR-RR)/(OR-1) ; # P1:暴露群でのイベント発生率=a/(a+b)

# RR = OR/(OR*P0 + 1- P0)
# OR= (1-P0)*RR/(1-P0*RR)
# P0=(OR-RR)/((OR-1)*RR) ; # P0:非暴露群でのイベント発生率=c/(c+d)

**卵の名無しさん** · 2016/11/26(土) 23:42:30.51

p1=RR*p0
p0=p1/RR

RR=p1/p0
OR=(p1/(1-p1))/(p0/(1-p0))

=(p1*(1-p0)) / (p0*(1-p1))
=RR*(1-p0)/(1-RR*p0)

= p1*(1-p1/RR) / (p1/RR)*(1-p1)
= (RR-p1)/(1-p1)

**卵の名無しさん** · 2016/11/27(日) 17:03:59.90

##
Rp2ci=function(R,p,cl=0.95){
Z=qnorm(p/2,lower=FALSE)
SE=log(R)/Z
w=qnorm(1-(1-cl)/2)*SE
ci=(c(lower=R-w,upper=R+w))
return(ci)
}
Rp2ci(1.5,0.1)
##
HR=1.5
fl=function(x) Rp2ci(HR,x)["lower"]
fu=function(x) Rp2ci(HR,x)["upper"]
le=300
xx=seq(0,0.2,length=le)
xx=xx[-c(1,le)]
ll=sapply(xx,fl)
uu=sapply(xx,fu)
ylim=range(ll,uu)
par(mfrow=c(2,1))
plot(xx,ll,type="n",ylim=ylim,xlab="p.value",ylab="conf.interval")
segments(xx,ll,xx,uu,col="royalblue")

plot(xx,ll,type="n",ylim=ylim,xlab="p.value",ylab="conf.interval",log="x")
segments(xx,ll,xx,uu,col="maroon")

**卵の名無しさん** · 2016/11/28(月) 20:42:41.97

exact法(Clopper-Pearson法)で関数を書いて
信頼区間が点推定の値を中心とした対称幅でないことをグラフ化してみた。
n=20打席でr安打での信頼区間と中点、および点推定値(r/n)で描いた。

Clopper=function(r,n,cl=0.90){
alpha=1-cl
lower = 1/(1+(n-r+1)/(r*qf(alpha/2, 2*r,2*(n-r+1))))
upper = 1/(1+(n-r)/((r+1)*qf(1-alpha/2, 2*(r+1), 2*(n-r))))
mid=(lower+upper)/2
est=r/n
res=c(lower,upper,mid,est)
names(res)=c("lower","upper","mid","estimate")
return(res)
}

http://i.imgur.com/WrBUNRQ.jpg

**卵の名無しさん** · 2016/11/28(月) 21:12:04.86

#逆正規法片側検定p値
inm=function(pp)pnorm(sum(qnorm(pp,lower=FALSE))/sqrt(length(pp)),lower=FALSE)
# Fisherの方法
fm=function(pp)pchisq(-2*sum(log(pp)),2*length(pp),lower=FALSE)/2

pp=c(0.302,0.14,0.290,0.504,0.105,0.220)
inm(pp)
fm(pp)

peach=function(p1,p2,p3){
pp=c(p1,p2,p3)
res=c(inm(pp),fm(pp))
return(res)
}

p3=function(p1=0.05,p2=0.05){
le=100
xx=seq(0,1,length=le+1)
xx=xx[-c(1,le+1)]
inv=function(x)peach(p1,p2,x)[1]
fis=function(x)peach(p1,p2,x)[2]
plot(xx,sapply(xx,inv),type="l",ylab="integrated p.value",xlab="p3",
main=paste("p1=",p1,", p2=",p2))
lines(xx,sapply(xx,fis),lty=3)
abline(h=0.05,lty=2,col="steelblue")
legend("topleft",bty="n",legend=c("Inverse Normal Method","Fisher's Method"),lty=c(1,3))
}

p3(0.1,0.1)
p3(0.25,0.25)

**卵の名無しさん** · 2016/11/28(月) 21:12:42.89

repinm=function(n,p0)inm(rep(p0,n))

f=function(p0){
g=function(x)repinm(x,p0)
return(g)
}
nn=2:100
h=f(0.4)
plot(nn,sapply(nn,h),type="l",xlab="繰り返し",ylab="統合p値",
main="同一p値の繰り返しと逆正規法統合p値の関係")
abline(h=0.05,col="royalblue",lty=3)
h=f(0.30)
lines(nn,sapply(nn,h),lty=2)
h=f(0.20)
lines(nn,sapply(nn,h),lty=4)
legend("topright",bty="n",legend=c("p=0.4","p=0.30","p=0.20"),lty=c(1,2,4))

inm(rep(0.4,43))
inm(rep(0.3,10))
inm(rep(0.2,4))

**卵の名無しさん** · 2016/11/28(月) 21:13:01.23

##
repfm=function(n,p0)fm(rep(p0,n))

f=function(p0){
g=function(x)repfm(x,p0)
return(g)
}
nn=2:100
h=f(0.40)
plot(nn,sapply(nn,h),type="l",xlab="繰り返し",ylab="統合p値",
main="同一p値の繰り返しとFisher法統合p値の関係",ylim=c(0,0.5))
abline(h=0.05,col="royalblue",lty=3)
h=f(0.30)
lines(nn,sapply(nn,h),lty=2)
h=f(0.20)
lines(nn,sapply(nn,h),lty=4)
legend("topright",bty="n",legend=c("p=0.4","p=0.30","p=0.20"),lty=c(1,2,4))

fm(rep(0.30,42))
fm(rep(0.2,5))

**卵の名無しさん** · 2016/11/29(火) 17:36:57.98

Rp2ci=function(R,p,cl=0.95){
Z=qnorm(p/2,lower=FALSE)
SE=log(R)/Z
w=qnorm(1-(1-cl)/2)*SE
ci=(c(lower=R-w,upper=R+w))
return(ci)
}

##
Rp2ci(1.5,0.1)
le=101
R=seq(1.45,1.55,length=le)
p=seq(0.05,0.15,length=le)
L=function(R,p,cl=0.95){
Z=qnorm(p/2,lower=FALSE)
SE=log(R)/Z
w=qnorm(1-(1-cl)/2)*SE
lower=R-w
return(lower)
}
U=function(R,p,cl=0.95){
Z=qnorm(p/2,lower=FALSE)
SE=log(R)/Z
w=qnorm(1-(1-cl)/2)*SE
upper=R+w
return(upper)
}

dev.off()
zL=outer(R,p,L) ; min(zL)
zU=outer(R,p,U) ; max(zU)

**卵の名無しさん** · 2016/11/29(火) 17:37:22.77

par(mfrow=c(2,2))
contour(R,p,zL,col="blue",lwd=2,xlab="Hazard Ratio",ylab="p.value",xlim=c(1.4,1.6),ylim=c(0.05,0.15),main="lower border")
contour(R,p,zU,col="red", lwd=2,xlab="Hazard Ratio",ylab="p.value",xlim=c(1.4,1.6),ylim=c(0.05,0.15),main="upper border")

persp(R,p,zL,theta=35, col="lightblue",shade=0.5,phi=30,ltheta=-10,border=TRUE,zlab="Lower")
rgl::persp3d(R,p,zL, theta=35, col="lightgreen",shade=0.5,border=TRUE,xlab="HR",ylab="p",zlab="Lower", ticktype = "detailed")
rgl::plot3d(R,p,zL, col="blue")

persp(R,p,zU,theta=35, col="lightblue",shade=0.5,phi=30,ltheta=-10,border=TRUE,zlab="Upper")
rgl::persp3d(R,p,zU, theta=35, col="lightgreen",shade=0.5,border=TRUE,xlab="HR",ylab="p",zlab="Upper", ticktype = "detailed")
rgl::plot3d(R,p,zU, col="blue")

**卵の名無しさん** · 2016/11/30(水) 06:05:55.88

http://s.webry.info/sp/tanuki-no-suji.at.webry.info/201607/article_1.html

**卵の名無しさん** · 2016/11/30(水) 07:35:20.36

金メダルは競争の結果だし、希少価値があるのは当然。
希少価値といえば、これもそうだよな。

まず、これを復習しよう。
(昭和世代の証言より)
私は昭和の時代に大学受験したけど、昔は今よりも差別感が凄く、慶応以外の私立医は特殊民のための特殊学校というイメージで開業医のバカ息子以外は誰も受験しようとすらしなかった。
常識的に考えて、数千万という法外な金を払って、しかも同業者からも患者からもバカだの裏口だのと散々罵られるのをわかって好き好んで私立医に行く同級生は一人もいませんでした。
本人には面と向かっては言わないけれど、俺くらいの年代の人間は、おそらくは８－９割は私立卒を今でも「何偉そうなこと抜かしてるんだ、この裏口バカが」と心の底で軽蔑し、嘲笑しているよ。当の本人には面と向かっては絶対にそんなことは言わないけどね。

＞一人もいませんでした
＞一人もいませんでした　　　　

つまり、
患者からも同業者からも馬鹿だの裏口だの言われるのをわかっていて底辺シリツ医大に進学したのは実に希少価値があるではありませんか。

どうして、自慢しないのでしょうか？
博士号よりも専門医よりもよほど希少価値があるはずなのに？
不思議ですよね。

**卵の名無しさん** · 2016/12/01(木) 03:11:40.08

有病 pN 無病(1-p)N
検査陽性 a TP se b FP 1-sp
検査陰性 c FN 1-se d TN sp

v=1/a + 1/b + 1/c + 1/d

se=a/(a+c)
sp=d/(b+d)

pLH=TP/FP=se/(1-sp)
nLH=FN/TN=(1-se)/sp

OR=pLH/nLH
S=(se/(1-se)) / (sp/(1-sp))

# log(OR) = alpha + beta*log(S) + error
y=log(OR)
x=log(S)

res.lm = lm(y~x,weights=1/v)
summary(res.lm)

**卵の名無しさん** · 2016/12/02(金) 14:49:58.92

https://archive.org/details/encore-what-doctors-feel-how-emotions-affect-the.rEl3uj.popuparchive.org

**卵の名無しさん** · 2016/12/02(金) 16:44:12.74

ド底辺特殊シリツ医大の伝説的英語力再掲。
anago.2ch.エスシー/test/read.cgi/hosp/1441603966/522

(quote)
522 卵の名無しさん 2015/11/09(月) 17:44:36.26 ID:g6z/uK4C0.net
>>505
Your thing that you should do now is it is study or to earn money
おまえが今すべきは勉強、もしくは、お金を稼ぐこと？？

なんも間違ってなくね？

おまえがいっつも、医大入学をカネで買うか、医師免許をカネで買うとか、
ＳＦ小説みたいな妄想書いてるから、
「だったらおまえ、勉強しながら、カネ稼げ」って
バカにされてるってわからねえのか？

おまえ、ここ数日は医科歯科の先生に叱られて、
医科歯科までも底辺医大って言い出すからな

ってかおまえ、今日はいつもよりしつこいな、難敵現るってとこ？

おまえの敵は、自分自身だよ、予備校生なんだからな、おまえは

**卵の名無しさん** · 2016/12/02(金) 16:55:53.69

http://imagizer.imageshack.com/img924/2411/sYBNlI.jpg

**卵の名無しさん** · 2016/12/03(土) 08:53:32.09

ﾄﾞ底辺シリツ医大卒の恥ずかし英作文

673 ：卵の名無しさん：2015/11/24(火) 11:42:45.76 ID:jcbe8aon0
Hey!Self-styled Tokyo Medicaland Dental University graduation !
A cram school student is not conceited

おいこら自称医科大卒業クン、
予備校生が思い上がるなよ
な

http://anago.2ch.net/test/read.cgi/hosp/1441603966/673

**卵の名無しさん** · 2016/12/03(土) 10:06:55.44

ﾄﾞ底辺シリツ医大卒の恥ずかしい英作文
こんなのでよく大学入学できるよな。
裏口なんだろね？

673 ：卵の名無しさん：2015/11/24(火) 11:42:45.76 ID:jcbe8aon0
Hey!Self-styled Tokyo Medicaland Dental University graduation !
A cram school student is not conceited

おいこら自称医科大卒業クン、
予備校生が思い上がるなよ
な

http://anago.2ch.net/test/read.cgi/hosp/1441603966/673

**卵の名無しさん** · 2016/12/03(土) 15:54:16.74

>>44

マジでやばい開業医Ⅸ(静かに静かな夏にまず3人目) [無断転載禁止]©2ch.net
http://potato.2ch.net/test/read.cgi/hosp/1478929571/438

438 名前：卵の名無しさん[] 投稿日：2016/12/03(土) 14:12:13.45 ID:lcNff1W7
不時他や皮裂きに入ったら一生ウマシカのレッテルがつく

つまり、こういうこと

ド底辺シリツ医大卒＝

　あらゆる医療系資格の中で最も恥ずかしい資格
　あらゆる日本の資格の中で最も恥ずかしい資格
　あらゆる資格の中で最も恥ずかしい資格
　資格をもっているのが恥ずかしい資格

運転免許も専門医資格も更新しなければ資格を失うけれどド底辺私立医大卒の資格は一生つきまとう。

それゆえ

ド底辺シリツ医大卒の第二法則：

　ド底辺シリツ医大卒は恥ずかしくて、学校名を皆さま言いません。

**卵の名無しさん** · 2016/12/04(日) 06:39:36.96

integrate(f=function(x,mu=50,sig=10) 1/(sqrt(2*pi)*sig)*exp(-(x-mu)^2/(2*sig^2)),-Inf,36.5)

**卵の名無しさん** · 2016/12/04(日) 14:42:25.24

N=100
p=1/N
conf.level=0.99
choose(x,0)*p^0*(1-p)^x < 1-conf.level
# (1-p)^x < 1-conf.level
log(1-conf.level)/log(1-p)

**卵の名無しさん** · 2016/12/04(日) 14:50:53.10

# Rule of Three

NN=seq(100,10000,by=100)
pp=1/NN
conf.level=0.95
f=function(p) log(1-conf.level)/log(1-p)
plot(NN,sapply(pp,f),type="p")
lines(NN,3*NN,col=2)

**卵の名無しさん** · 2016/12/08(木) 21:24:26.83

##　標本分散の分布はχ２乗分布　(n-1)s2/σ2 ～ χ2 ν=n-1
mu=0 ; sig=1
k=10000
n=10
m=1
s2=NULL
for(i in 1:k){
s2[i]=var(replicate(n,rnorm(m,mu,sig)))
}
x=(n-1)*s2/(sig^2)
hist(x,freq=FALSE,ann=FALSE)
curve(dchisq(x,n-1),0,40,add=TRUE,lwd=2)

http://i.imgur.com/dcOKWTe.jpg

**卵の名無しさん** · 2016/12/09(金) 07:10:05.69

Your thingは入試の学力考査が適正に行われていない証であり、
国試に関係ない分野での大学教育も健全に行われていないことの反映だろうな。

http://imagizer.imageshack.com/img924/2411/sYBNlI.jpg

**卵の名無しさん** · 2016/12/09(金) 13:45:18.71

### t = N(0,1)/sqrt(χ2/ν)
### t分布

TT=function(n=12,mu=0,func=rnorm,...){
# x=replicate(n,func(1,...))
x=func(n,...)
dev=mean(x)-mu
se=sd(x)/sqrt(n)
.t=dev/se
return(.t)
}

#　一様分布からの標本 T=(標本平均-母平均)/標準誤差
k=10000
n=12
.T=NULL
for(i in 1:k){
.T[i]=TT(func=runif,mu=0.5)
}
summary(.T)
hist(.T,freq=FALSE, ylim=c(0,0.4),ann=FALSE,breaks=30,col="lavender")
curve(dt(x,n-1),lwd=2,add=TRUE)
legend("topleft",bty="n",legend=c(paste("一様分布 ",n, " 個のｔ値の分布"),"t 値＝(標本平均-母平均)/標準誤差"))

**卵の名無しさん** · 2016/12/09(金) 15:04:24.64

製薬会社の営業マンから、

統計もわからん馬鹿医者がタダ弁当に釣られて新薬説明に参加して勉強した気になっている

と思われるのは不快だからね。

**卵の名無しさん** · 2016/12/10(土) 08:17:31.48

Your thingは入試の学力考査が適正に行われていない証であり、
国試に関係ない分野での大学教育も健全に行われていないことの反映だろうな。

http://imagizer.imageshack.com/img924/2411/sYBNlI.jpg

医大入学を金で買う、　医師免許を金で買う　という現実の結果だろう。

**卵の名無しさん** · 2016/12/10(土) 11:05:43.08

Your thingは入試の学力考査が適正に行われていない証であり、
国試に関係ない分野での大学教育も健全に行われていないことの反映。

http://imagizer.imageshack.com/img924/2411/sYBNlI.jpg

医大入学を金で買う　をベイズ推計してみよう。

帰無仮説H0:学力考査は公正に行われている
対立仮設H1:縁故加点など不正が行われている

H0の成り立つ事前確率をP0
H1の成り立つ事前確率をP1

p　:　学力考査が公正であった場合にYour thing英作文をする確率P(Y|H0)
q　:　学力考査が不正であった場合にYour thing英作文をする確率P(Y|H1)

現実にド底辺特殊シリツ医大卒は
　Your thing that you should do now is it is study or to earn money.
と書いている。

ゆえにH1の事後確率（裏口入試存在確率）はP1q/(P0p＋P1q)である。

　P(H1|Y)=P(Y|H1)P(H1)/P(Y)=P(H1)P(Y|H1)/P(H0)(P(Y|H0)+P(H1)P(Y|H1)　(ベイズの公式)

情報がないという前提でP0=P1=0.5と仮定しよう。（縁故加点合格の証言もあるが）
公正な学力考査で選抜された学生がYour thing英作文をする確率を0.01としてみる（実際はもっと低いはず）

ド底辺特殊シリツ医大卒にYour thing英作文をする底抜けバカの占める割合を存じ上げないのでグラフにしてみた。
http://i.imgur.com/5vesmwb.jpg

**卵の名無しさん** · 2016/12/10(土) 11:09:02.61

この誤った英作文Your thing～は入試の学力考査が適正に行われていない証であり、
誤っていることすらわからないののは、国試に関係ない分野での大学教育も健全に行われていないことの反映である。

http://imagizer.imageshack.com/img924/2411/sYBNlI.jpg

医大入学を金で買う　をベイズ推計してみよう。

帰無仮説H0:学力考査は公正に行われている
対立仮設H1:縁故加点など不正が行われている

H0の成り立つ事前確率をP0
H1の成り立つ事前確率をP1

p　:　学力考査が公正であった場合にYour thing英作文をする確率P(Y|H0)
q　:　学力考査が不正であった場合にYour thing英作文をする確率P(Y|H1)

　P(H1|Y)=P(Y|H1)P(H1)/P(Y)=P(H1)P(Y|H1)/P(H0)(P(Y|H0)+P(H1)P(Y|H1)　(ベイズの公式)から

H1の事後確率（裏口入試存在確率）は　P1q/(P0p＋P1q)　である。

情報がないという前提でP0=P1=0.5と仮定しよう。（縁故加点合格の証言もあるが）
公正な学力考査で選抜された学生がYour thing英作文をする確率を0.01としてみる（実際はもっと低いはず）

ド底辺特殊シリツ医大卒にYour thing英作文をする底抜けバカの占める割合を存じ上げないのでグラフにしてみた。

http://i.imgur.com/5vesmwb.jpg