การทดสอบแบบเบส์สองตัวอย่างที่เทียบเท่ากับแบบเบย์

ฉันไม่ได้กำลังมองหาวิธีแบบพลักแอนด์เพลย์อย่างดีที่สุดในอาร์ แต่เป็นคำอธิบายทางคณิตศาสตร์ของวิธีเบย์บางอย่างที่ฉันสามารถใช้เพื่อทดสอบความแตกต่างระหว่างค่าเฉลี่ยของตัวอย่างสองตัวอย่าง

นี่เป็นคำถามที่ดีที่ดูเหมือนว่าจะปรากฏขึ้นเป็นจำนวนมาก: การเชื่อมโยง 1 , เชื่อมโยง 2 การประมาณค่าแบบเบส์กระดาษยกระดับการทดสอบ Tที่ Cam.Davidson.Pilon ชี้ให้เห็นว่าเป็นทรัพยากรที่ดีเยี่ยมในเรื่องนี้ มันยังเผยแพร่ล่าสุดในปี 2012 ซึ่งฉันคิดว่าส่วนหนึ่งเป็นเพราะความสนใจในพื้นที่ในปัจจุบัน

ฉันจะพยายามสรุปคำอธิบายทางคณิตศาสตร์ของทางเลือกแบบเบย์กับการทดสอบตัวอย่างสองตัวอย่าง สรุปนี้คล้ายกับกระดาษที่ดีที่สุดซึ่งประเมินความแตกต่างในสองตัวอย่างโดยการเปรียบเทียบความแตกต่างในการแจกแจงหลัง (อธิบายด้านล่างใน R)

set.seed(7)

#create samples
sample.1 <- rnorm(8, 100, 3)
sample.2 <- rnorm(10, 103, 7)

#we need a pooled data set for estimating parameters in the prior.
pooled <- c(sample.1, sample.2)
par(mfrow=c(1, 2))

hist(sample.1)
hist(sample.2)

เพื่อที่จะเปรียบเทียบตัวอย่างหมายความว่าเราจำเป็นต้องประเมินว่ามันคืออะไร วิธีการแบบเบย์ใช้ทฤษฎีบทของเบย์: P (A | B) = P (B | A) * P (A) / P (B) (ไวยากรณ์ของ P (A | B) ถูกอ่านเป็นความน่าจะเป็นของ A ที่ได้รับ B)

$\propto$

$P(mean.1 | sample.1)$ $\propto$ $P(sample.1 | mean.1) * P(mean.1)$$P(sample.1 | mean.1)$$P(mean.1)$

มาวางไว้ในรหัส รหัสทำให้ทุกอย่างดีขึ้น

likelihood <- function(parameters){
  mu1=parameters[1]; sig1=parameters[2]; mu2=parameters[3]; sig2=parameters[4]
  prod(dnorm(sample.1, mu1, sig1)) * prod(dnorm(sample.2, mu2, sig2))
}

prior <- function(parameters){
  mu1=parameters[1]; sig1=parameters[2]; mu2=parameters[3]; sig2=parameters[4]
  dnorm(mu1, mean(pooled), 1000*sd(pooled)) * dnorm(mu2, mean(pooled), 1000*sd(pooled)) * dexp(sig1, rate=0.1) * dexp(sig2, 0.1)
}

ฉันทำข้อสันนิษฐานก่อนหน้านี้ว่าจำเป็นต้องได้รับการพิสูจน์ เพื่อป้องกันไม่ให้นักบวชใช้อคติโดยประมาณฉันต้องการทำให้พวกเขากว้างและมีค่าที่เป็นไปได้โดยมีจุดประสงค์เพื่อให้ข้อมูลสร้างคุณลักษณะของคนหลัง ฉันใช้การตั้งค่าที่แนะนำจากดีที่สุดและกระจาย mu ตามปกติด้วยค่าเฉลี่ย = เฉลี่ย (พูล) และส่วนเบี่ยงเบนมาตรฐานกว้าง = 1,000 * sd (รวมแล้ว) ค่าเบี่ยงเบนมาตรฐานที่ฉันตั้งไว้เพื่อการแจกแจงแบบกว้างเพราะฉันต้องการการกระจายแบบไม่ จำกัด

ตอนนี้เราสามารถทำให้ด้านหลัง

posterior <- function(parameters) {likelihood(parameters) * prior(parameters)}

เราจะสุ่มตัวอย่างการกระจายหลังโดยใช้markov chain monte carlo (MCMC) พร้อมการดัดแปลง Metropolis Hastings มันง่ายต่อการเข้าใจกับรหัส

#starting values
mu1 = 100; sig1 = 10; mu2 = 100; sig2 = 10
parameters <- c(mu1, sig1, mu2, sig2)

#this is the MCMC /w Metropolis method
n.iter <- 10000
results <- matrix(0, nrow=n.iter, ncol=4)
results[1, ] <- parameters
for (iteration in 2:n.iter){
  candidate <- parameters + rnorm(4, sd=0.5)
  ratio <- posterior(candidate)/posterior(parameters)
  if (runif(1) < ratio) parameters <- candidate #Metropolis modification
  results[iteration, ] <- parameters
}

เมทริกผลลัพธ์เป็นรายการตัวอย่างจากการแจกแจงหลังสำหรับแต่ละพารามิเตอร์ซึ่งเราสามารถใช้เพื่อตอบคำถามเดิมของเรา: ตัวอย่าง 1 แตกต่างจากตัวอย่าง 2 หรือไม่ แต่ก่อนอื่นเพื่อหลีกเลี่ยงผลกระทบจากค่าเริ่มต้นเราจะ "เบิร์นอิน" 500 ค่าแรกของห่วงโซ่

#burn-in
results <- results[500:n.iter,]

ตอนนี้ sample.1 แตกต่างจาก sample.2 หรือไม่

mu1 <- results[,1]
mu2 <- results[,3]

hist(mu1 - mu2)

mean(mu1 - mu2 < 0)
[1] 0.9953689

จากการวิเคราะห์นี้ฉันจะสรุปว่ามีโอกาส 99.5% ที่ค่าเฉลี่ยสำหรับตัวอย่าง 1 นั้นน้อยกว่าค่าเฉลี่ยสำหรับตัวอย่าง 2

ข้อดีของวิธีการแบบเบย์ดังที่ได้กล่าวไว้ในบทความดีที่สุดคือมันสามารถสร้างทฤษฎีที่แข็งแกร่งได้ EG ความน่าจะเป็นที่กลุ่มตัวอย่าง 2 มีขนาดใหญ่กว่าตัวอย่าง 5 5

mean(mu2 - mu1 > 5)
[1] 0.9321124

เราจะสรุปได้ว่ามีโอกาส 93% ที่ค่าเฉลี่ยของกลุ่มตัวอย่าง 2 คือ 5 หน่วยมากกว่ากลุ่มตัวอย่าง 1 ผู้สังเกตการณ์จะพบว่าน่าสนใจเพราะเรารู้ว่าประชากรที่แท้จริงมีค่าเท่ากับ 100 และ 103 ตามลำดับ นี่เป็นไปได้มากที่สุดเนื่องจากตัวอย่างขนาดเล็กและทางเลือกในการใช้การแจกแจงแบบปกติสำหรับโอกาส

ฉันจะจบคำตอบด้วยการเตือน: รหัสนี้มีวัตถุประสงค์เพื่อการสอน สำหรับการวิเคราะห์ที่แท้จริงให้ใช้ RJAGS และขึ้นอยู่กับขนาดตัวอย่างของคุณพอดีกับการแจกแจงแบบ t สำหรับโอกาสที่เหมาะสม หากมีความสนใจฉันจะโพสต์การทดสอบ t โดยใช้ RJAGS

แก้ไข: ตามที่ร้องขอที่นี่เป็นรูปแบบ JAGS

model.str <- 'model {
    for (i in 1:Ntotal) {
        y[i] ~ dt(mu[x[i]], tau[x[i]], nu)
    }
    for (j in 1:2) {
        mu[j] ~ dnorm(mu_pooled, tau_pooled)
        tau[j] <- 1 / pow(sigma[j], 2)
        sigma[j] ~ dunif(sigma_low, sigma_high)
    }
    nu <- nu_minus_one + 1
    nu_minus_one ~ dexp(1 / 29)
}'

# Indicator variable
x <- c(rep(1, length(sample.1)), rep(2, length(sample.2)))

cpd.model <- jags.model(textConnection(model.str),
                        data=list(y=pooled,
                                  x=x,
                                  mu_pooled=mean(pooled),
                                  tau_pooled=1/(1000 * sd(pooled))^2,
                                  sigma_low=sd(pooled) / 1000,
                                  sigma_high=sd(pooled) * 1000,
                                  Ntotal=length(pooled)))
update(cpd.model, 1000)
chain <- coda.samples(model = cpd.model, n.iter = 100000,
                      variable.names = c('mu', 'sigma'))
rchain <- as.matrix(chain)
hist(rchain[, 'mu[1]'] - rchain[, 'mu[2]'])
mean(rchain[, 'mu[1]'] - rchain[, 'mu[2]'] < 0)
mean(rchain[, 'mu[2]'] - rchain[, 'mu[1]'] > 5)

คำตอบที่ยอดเยี่ยมโดย user1068430 นำมาใช้ใน Python

import numpy as np
from pylab import plt

def dnorm(x, mu, sig):
    return 1/(sig * np.sqrt(2 * np.pi)) * np.exp(-(x - mu)**2 / (2 * sig**2))

def dexp(x, l):
    return l * np.exp(- l*x)

def like(parameters):
    [mu1, sig1, mu2, sig2] = parameters
    return dnorm(sample1, mu1, sig1).prod()*dnorm(sample2, mu2, sig2).prod()

def prior(parameters):
    [mu1, sig1, mu2, sig2] = parameters
    return dnorm(mu1, pooled.mean(), 1000*pooled.std()) * dnorm(mu2, pooled.mean(), 1000*pooled.std()) * dexp(sig1, 0.1) * dexp(sig2, 0.1)

def posterior(parameters):
    [mu1, sig1, mu2, sig2] = parameters
    return like([mu1, sig1, mu2, sig2])*prior([mu1, sig1, mu2, sig2])


#create samples
sample1 = np.random.normal(100, 3, 8)
sample2 = np.random.normal(100, 7, 10)

pooled= np.append(sample1, sample2)

plt.figure(0)
plt.hist(sample1)
plt.hold(True)
plt.hist(sample2)
plt.show(block=False)

mu1 = 100 
sig1 = 10
mu2 = 100
sig2 = 10
parameters = np.array([mu1, sig1, mu2, sig2])

niter = 10000

results = np.zeros([niter, 4])
results[1,:] = parameters

for iteration in np.arange(2,niter):
    candidate = parameters + np.random.normal(0,0.5,4)
    ratio = posterior(candidate)/posterior(parameters)
    if np.random.uniform() < ratio:
        parameters = candidate
    results[iteration,:] = parameters

#burn-in
results = results[499:niter-1,:]

mu1 = results[:,1]
mu2 = results[:,3]

d = (mu1 - mu2)
p_value = np.mean(d > 0)

plt.figure(1)
plt.hist(d,normed = 1)
plt.show()

ด้วยการวิเคราะห์แบบเบย์คุณมีสิ่งที่ต้องระบุเพิ่มเติม (นั่นคือสิ่งที่ดีเพราะมันให้ความยืดหยุ่นและความสามารถมากขึ้นในการจำลองสิ่งที่คุณเชื่อว่าเป็นความจริง) คุณคิดว่าเป็นเรื่องปกติสำหรับโอกาสหรือไม่? ทั้งสองกลุ่มจะมีความแปรปรวนเดียวกันหรือไม่

วิธีการหนึ่งที่ตรงไปตรงมาคือการสร้างแบบจำลองค่าเฉลี่ย 2 (และ 1 หรือ 2 ความแปรปรวน / การกระจาย) จากนั้นดูที่ด้านหลังเกี่ยวกับความแตกต่างของค่าเฉลี่ย 2 และ / หรือช่วงความน่าเชื่อถือในความแตกต่างของค่าเฉลี่ย 2

คำอธิบายทางคณิตศาสตร์ของวิธีการแบบเบย์บางอย่างที่ฉันสามารถใช้เพื่อทดสอบความแตกต่างระหว่างค่าเฉลี่ยของตัวอย่างสองตัวอย่าง

มีหลายวิธีในการ "ทดสอบ" นี้ ฉันจะพูดถึงคู่:

• หากคุณต้องการการตัดสินใจที่ชัดเจนคุณสามารถดูทฤษฎีการตัดสินใจ

• สิ่งที่เรียบง่ายน่ารักที่บางครั้งทำคือการหาช่วงเวลาสำหรับความแตกต่างในค่าเฉลี่ยและพิจารณาว่ามันมี 0 หรือไม่ นั่นจะเกี่ยวข้องกับการเริ่มต้นด้วยแบบจำลองสำหรับการสังเกต, priors ในพารามิเตอร์และการคำนวณของการแจกแจงหลังของความแตกต่างในวิธีการที่มีเงื่อนไขในข้อมูล

  คุณต้องบอกว่าแบบจำลองของคุณคืออะไร (เช่นปกติความแปรปรวนคงที่) จากนั้น (อย่างน้อย) ก่อนหน้านี้สำหรับความแตกต่างของค่าเฉลี่ยและค่าความแปรปรวนก่อนหน้า คุณอาจมีนักบวชในพารามิเตอร์ของนักบวชเหล่านั้น หรือคุณอาจจะไม่แปรปรวนคงที่ หรือคุณอาจคิดอย่างอื่นนอกจากความเป็นปกติ