이 차트를 만들기 위해 mean = 0 및 sd = 1 인 정규 분포와 다른 크기의 랜덤 표본을 생성했습니다. 그런 다음 t.test () 함수를 사용하여 .001에서 .999 (빨간색 선) 범위의 알파 컷오프를 사용하여 신뢰 구간을 계산 한 후, 강의 노트에서 찾은 아래 코드를 사용하여 프로파일 가능성을 계산했습니다. 편집 : 발견 한 시점에서 링크를 찾을 수없는 경우 파란색 선으로 표시됩니다. 녹색 선은 R density () 함수를 사용하여 정규화 된 밀도를 나타내고 데이터는 각 차트의 맨 아래에 상자 그림으로 표시됩니다. 오른쪽에는 95 % 신뢰 구간 (빨간색)과 최대 우도 구간의 1/20 (파란색)의 애벌레 도표가 있습니다.

프로파일 가능성에 사용되는 R 코드 :

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

내 구체적인 질문은이 두 유형의 구간 사이에 알려진 관계가 있는지 여부와 n = 3 일 때를 제외하고 모든 경우에 신뢰 구간이 더 보수적 인 것처럼 보이는 이유입니다. 내 계산이 유효한지 여부와 더 나은 방법에 대한 의견 / 답변 과이 두 유형의 간격 사이의 일반적인 관계도 필요합니다.

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)

나는 완전한 대답을하지 않을 것입니다 (나는 당신이 정확히 무엇을하고 있는지 이해하려고 노력하는 데 어려움을 겪고 있습니다), 그러나 나는 프로파일 가능성이 어떻게 구축되는지 명확히하려고 노력할 것입니다. 나중에 답변을 완료 할 수 있습니다.

크기의 정상 샘플에 대한 전체 확률은 이고 L ( μ , σ 2 ) = ( σ 2 ) - N / 2 EXP ( - Σ I ( X I - μ ) 2 / 2 σ 2 )$n$

$$L(\mu, \sigma^2) = \left( \sigma^2 \right)^{-n/2} \exp\left( - \sum_i (x_i-\mu)^2/2\sigma^2 \right).$$

경우 관심 파라미터이고, σ 2 귀찮은 파라미터 만에 메이크업 추론에 대한 해결책이고 μ는 프로파일 우도 정의하는 L의 P ( μ ) = L ( μ , ^ σ 2 ( μ를 ) ) ^ σ 2 ( μ ) 는 μ 고정에 대한 MLE입니다 : ^ σ 2 ( μ ) = argmax σ 2 L ( μ $\mu$$\sigma^2$$\mu$

$$L_P(\mu) = L\left(\mu, \widehat{\sigma^2}(\mu) \right)$$ $\widehat{\sigma^2}(\mu)$$\mu$ $$\widehat{\sigma^2}(\mu) = \text{argmax}_{\sigma^2} L(\mu, \sigma^2).$$

$$\widehat{\sigma^2}(\mu) = {1\over n} \sum_k (x_k - \mu)^2.$$

$$L_P(\mu) = \left( {1\over n} \sum_k (x_k - \mu)^2 \right)^{-n/2} \exp( -n/2 ).$$

$\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")

가능성과 링크 나는 다음과 같은 그래프 가능성과 함께 링크를 강조하려고합니다.

먼저 가능성을 정의하십시오.

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

그런 다음 등고선 플롯을 수행하십시오.

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)

프로파일 우도의 값은 적색 포물선을 따라 우도에 의해 취해진 값입니다.

$\hat\mu$

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

예를 들어, 프로필 가능성을 사용하여 점수 테스트를 구축 할 수도 있습니다.

$\chi^2_k$

$0.147$$95\%$

이것들은 고전적인 결과이므로 간단히 이것에 대한 참조를 제공 할 것입니다.

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

다음 R 코드는 작은 샘플의 경우에도 두 접근 방식으로 얻은 간격이 비슷하다는 것을 보여줍니다 (Elvis 예제를 다시 사용하고 있습니다).

정규화 된 프로필 가능성을 사용해야합니다.

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

더 큰 표본 크기를 사용하면 신뢰 구간이 훨씬 더 가깝습니다.

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

중요한 포인트 :

특정 표본의 경우 서로 다른 종류의 신뢰 구간은 길이나 위치에 따라 다를 수 있으며 실제로 중요한 것은 적용 범위입니다. 장기적으로, 그들 모두는 특정 샘플에 대해 얼마나 다른지 독립적으로 동일한 적용 범위를 제공해야합니다.

$\chi^2$$normalized$

1. 프로파일 로그 우도는 대략 2 차입니다
2. 프로파일 로그 가능성을 대략 2 차로 만드는 매개 변수 변환이 있습니다.

이차는 로그 스케일의 정규 분포를 정의하기 때문에 중요합니다. 이차가 클수록 근사와 결과 CI가 더 좋습니다. 가능성 구간에 대해 1/20 번째 컷오프를 선택하는 것은 점근 제한에서 95 % CI 이상에 해당하며, 파란색 간격이 일반적으로 빨간색 간격보다 긴 이유입니다.

이제 프로파일 가능성에주의를 기울여야 할 또 다른 문제가 있습니다. 프로파일 링 할 변수가 많은 경우 차원 당 데이터 포인트 수가 적 으면 프로파일 가능성이 매우 치우치고 낙관적 일 수 있습니다. 그런 다음 한계, 조건부 및 수정 된 프로파일 가능성을 사용하여이 편향을 줄입니다.

따라서 귀하의 질문에 대한 대답은 '예'입니다. 연결은 우도 비율의 카이 제곱 분포에 나타난 바와 같이 최대 가능성 추정기의 점근 적 정규성입니다.