Untuk membuat bagan ini, saya membuat sampel acak dengan ukuran berbeda dari distribusi normal dengan mean = 0 dan sd = 1. Interval kepercayaan kemudian dihitung menggunakan cutoff alfa mulai dari 0,001 hingga 0,999 (garis merah) dengan fungsi t.test (), kemungkinan profil dihitung menggunakan kode di bawah ini yang saya temukan dalam catatan kuliah yang dimasukkan ke baris (saya bisa ' t menemukan tautan saat ini Edit: Ditemukan ), ini ditunjukkan oleh garis biru. Garis hijau menunjukkan kerapatan yang dinormalisasi menggunakan fungsi R kerapatan () dan data ditampilkan oleh plot kotak di bagian bawah setiap bagan. Di sebelah kanan adalah plot ulat dari interval kepercayaan 95% (merah) dan 1/20 dari interval kemungkinan maksimal (biru).

Kode R yang digunakan untuk kemungkinan profil:

  #mn=mean(dat)
  muVals <- seq(low,high, length = 1000)
  likVals <- sapply(muVals,
                    function(mu){
                      (sum((dat - mu)^2) /
                         sum((dat - mn)^2)) ^ (-n/2)
                    }
  )

Pertanyaan khusus saya adalah apakah ada hubungan yang diketahui antara kedua jenis interval ini dan mengapa interval kepercayaan tampaknya lebih konservatif untuk semua kasus kecuali ketika n = 3. Komentar / jawaban tentang apakah perhitungan saya valid (dan cara yang lebih baik untuk melakukan ini) dan hubungan umum antara kedua jenis interval ini juga diinginkan.

Kode R:

samp.size=c(3,4,5,10,20,1000)
cnt2<-1
ints=matrix(nrow=length(samp.size),ncol=4)
layout(matrix(c(1,2,7,3,4,7,5,6,7),nrow=3,ncol=3, byrow=T))
par(mar=c(5.1,4.1,4.1,4.1))
for(j in samp.size){


  #set.seed(200)
  dat<-rnorm(j,0,1)
  vals<-seq(.001,.999, by=.001)
  cis<-matrix(nrow=length(vals),ncol=3)
  cnt<-1
  for(ci in vals){
    x<-t.test(dat,conf.level=ci)$conf.int[1:2]
    cis[cnt,]<-cbind(ci,x[1],x[2])
    cnt<-cnt+1
  }


  mn=mean(dat)
  n=length(dat)
  high<-max(c(dat,cis[970,3]), na.rm=T)
  low<-min(c(dat,cis[970,2]), na.rm=T)
  #high<-max(abs(c(dat,cis[970,2],cis[970,3])), na.rm=T)
  #low<--high


  muVals <- seq(low,high, length = 1000)
  likVals <- sapply(muVals,
                    function(mu){
                      (sum((dat - mu)^2) /
                         sum((dat - mn)^2)) ^ (-n/2)
                    }
  )


  plot(muVals, likVals, type = "l", lwd=3, col="Blue", xlim=c(low,high),
       ylim=c(-.1,1), ylab="Likelihood/Alpha", xlab="Values",
       main=c(paste("n=",n), 
              "True Mean=0 True sd=1", 
              paste("Sample Mean=", round(mn,2), "Sample sd=", round(sd(dat),2)))
  )
  axis(side=4,at=seq(0,1,length=6),
       labels=round(seq(0,max(density(dat)$y),length=6),2))
  mtext(4, text="Density", line=2.2,cex=.8)

  lines(density(dat)$x,density(dat)$y/max(density(dat)$y), lwd=2, col="Green")
  lines(range(muVals[likVals>1/20]), c(1/20,1/20), col="Blue", lwd=4)
  lines(cis[,2],1-cis[,1], lwd=3, col="Red")
  lines(cis[,3],1-cis[,1], lwd=3, col="Red")
  lines(cis[which(round(cis[,1],3)==.95),2:3],rep(.05,2), 
        lty=3, lwd=4, col="Red")
  abline(v=mn, lty=2, lwd=2)
  #abline(h=.05, lty=3, lwd=4, col="Red")
  abline(h=0, lty=1, lwd=3)
  abline(v=0, lty=3, lwd=1)

  boxplot(dat,at=-.1,add=T, horizontal=T, boxwex=.1, col="Green")
  stripchart(dat,at=-.1,add=T, pch=16, cex=1.1)

  legend("topleft", legend=c("Likelihood"," Confidence Interval", "Sample Density"),
         col=c("Blue","Red", "Green"), lwd=3,bty="n")

  ints[cnt2,]<-cbind(range(muVals[likVals>1/20])[1],range(muVals[likVals>1/20])[2],
                     cis[which(round(cis[,1],3)==.95),2],cis[which(round(cis[,1],3)==.95),3])
  cnt2<-cnt2+1
}
par(mar=c(5.1,4.1,4.1,2.1))


plot(0,0, type="n", ylim=c(1,nrow(ints)+.5), xlim=c(min(ints),max(ints)), 
     yaxt="n", ylab="Sample Size", xlab="Values")
for(i in 1:nrow(ints)){
  segments(ints[i,1],i+.2,ints[i,2],i+.2, lwd=3, col="Blue")
  segments(ints[i,3],i+.3,ints[i,4],i+.3, lwd=3, col="Red")
}
axis(side=2, at=seq(1.25,nrow(ints)+.25,by=1), samp.size)

Saya tidak akan memberikan jawaban yang lengkap (saya kesulitan memahami apa yang sebenarnya Anda lakukan), tetapi saya akan mencoba menjelaskan bagaimana kemungkinan profil dibuat. Saya dapat menyelesaikan jawaban saya nanti.

Kemungkinan penuh untuk sampel ukuran normal $n$ adalah

Jika adalah parameter yang Anda minati, dan σ 2 adalah parameter gangguan, solusi untuk membuat kesimpulan hanya pada μ adalah untuk menentukan profil kemungkinan L P ( μ ) = L ( μ $\mu$$\sigma^2$$\mu$ di mana ^ σ 2 (μ)adalah MLE untukμtetap: ^ σ 2 (μ)=argmaxσ2L(μ

$\exp(-n/2)$

> data(sleep)
> difference <- sleep$extra[11:20]-sleep$extra[1:10]
> Lp <- function(mu, x) {n <- length(x); mean( (x-mu)**2 )**(-n/2) }
> mu <- seq(0,3, length=501)
> plot(mu, sapply(mu, Lp, x = difference), type="l")

Tautkan dengan kemungkinan Saya akan mencoba menyorot tautan dengan kemungkinan dengan grafik berikut.

Pertama-tama tentukan kemungkinan:

L <- function(mu,s2,x) {n <- length(x); s2**(-n/2)*exp( -sum((x-mu)**2)/2/s2 )}

Kemudian lakukan plot kontur:

sigma <- seq(0.5,4, length=501)
mu <- seq(0,3, length=501)

z <- matrix( nrow=length(mu), ncol=length(sigma))
for(i in 1:length(mu))
  for(j in 1:length(sigma))
    z[i,j] <- L(mu[i], sigma[j], difference)

# shorter version
# z <- outer(mu, sigma, Vectorize(function(a,b) L(a,b,difference)))

contour(mu, sigma, z, levels=c(1e-10,1e-6,2e-5,1e-4,2e-4,4e-4,6e-4,8e-4,1e-3,1.2e-3,1.4e-3))

$\widehat{\sigma^2}(\mu)$

hats2mu <- sapply(mu, function(mu0) mean( (difference-mu0)**2 ))
lines(mu, hats2mu, col="red", lwd=2)

Nilai-nilai kemungkinan profil adalah nilai yang diambil oleh kemungkinan sepanjang parabola merah.

$\hat\mu$ adalah sama.

$\widehat{\sigma^2}(\mu)$ , tetapi selama Anda hanya berurusan dengan segmen pendek itu, itu hampir linier, dan perbedaannya akan sangat kecil .

Anda juga dapat menggunakan kemungkinan profil untuk membuat tes skor, misalnya.

$\chi^2_k$

$0.147$$95\%$

Ini adalah hasil klasik dan oleh karena itu saya hanya akan memberikan beberapa referensi tentang ini:

http://www.jstor.org/stable/2347496

http://www.stata-journal.com/sjpdf.html?articlenum=st0132

http://www.unc.edu/courses/2010fall/ecol/563/001/docs/lectures/lecture11.htm

http://en.wikipedia.org/wiki/Likelihood-ratio_test

http://en.wikipedia.org/wiki/Likelihood_function#Profile_likelihood

Kode R berikut menunjukkan bahwa, bahkan untuk sampel kecil, interval yang diperoleh dengan kedua pendekatan serupa (saya menggunakan kembali contoh Elvis):

Perhatikan bahwa Anda harus menggunakan kemungkinan profil yang dinormalisasi.

data(sleep)
x <- sleep$extra[11:20]-sleep$extra[1:10]
n <- length(x)
Rp <- function(mu) {mean( (x-mean(x))^2 )^(n/2)/mean( (x-mu)^2 )^(n/2) }
Rp(mean(x))

mu <- seq(0,3, length=501)
plot(mu, sapply(mu, Rp), type="l")


Rpt<- function(mu) Rp(mu)-0.147 # Just an instrumental function

# Likelihood-confidence interval of 95% level

c(uniroot(Rpt,c(0.5,1.5))$root,uniroot(Rpt,c(1.51,3))$root)

# t confidence interval

t.test(x,conf.level=0.95)$conf.int

Jika kami menggunakan ukuran sampel yang lebih besar, interval kepercayaan lebih dekat:

set.seed(123)
x <- rnorm(100)
n <- length(x)
Rp <- function(mu) {mean( (x-mean(x))^2 )^(n/2)/mean( (x-mu)^2 )^(n/2) }
Rp(mean(x))

mu <- seq(-0.5,0.5, length=501)
plot(mu, sapply(mu, Rp), type="l")


Rpt<- function(mu) Rp(mu)-0.147 # Just an instrumental function

# Likelihood-confidence interval of 95% level

c(uniroot(Rpt,c(-0.4,0))$root,uniroot(Rpt,c(0,0.4))$root)

# t confidence interval

t.test(x,conf.level=0.95)$conf.int

TITIK PENTING:

Perhatikan bahwa untuk sampel tertentu, berbagai interval kepercayaan yang berbeda mungkin berbeda dalam hal panjang atau lokasi, yang sebenarnya penting adalah cakupannya. Dalam jangka panjang, mereka semua harus memberikan cakupan yang sama, secara independen pada seberapa besar perbedaan mereka untuk sampel tertentu.

$\chi^2$$normalized$

1. Log-kemungkinan profil adalah aproksimasi kuadratik
2. Ada transformasi parameter yang membuat kemungkinan log profil lebih kurang kuadrat.

Kuadratik penting karena mendefinisikan distribusi normal dalam skala log. Semakin kuadratik, semakin baik perkiraan dan CI yang dihasilkan. Pilihan Anda untuk 1/20 cutoff untuk interval kemungkinan setara dengan lebih dari 95% CI dalam batas asimptotik, yang mengapa interval biru umumnya lebih lama daripada yang merah.

Sekarang, ada masalah lain dengan kemungkinan profil yang perlu mendapat perhatian. Jika Anda memiliki banyak variabel yang Anda profilingkan, maka jika jumlah titik data per dimensi rendah, kemungkinan profil bisa sangat bias dan optimis. Kemungkinan profil marjinal, bersyarat, dan dimodifikasi kemudian digunakan untuk mengurangi bias ini.

Jadi, jawaban untuk pertanyaan Anda adalah YA ... hubungannya adalah normalitas asimptotik dari kebanyakan penduga kemungkinan maksimum, seperti yang dimanifestasikan dalam distribusi chi-kuadrat dari rasio kemungkinan.