【R參數估計】區間估計

估計量的優良性準則

無偏性

估計量是隨機變量，對於不同的樣本值就會得到不同的估計值，這樣，要確定一個估計量的好壞，就必須由多次抽樣結果決定。對此，一個自然而基本的衡量標準是要求估計量無系統偏差，即在大量重複抽樣（樣本容量相同）時，所得的估計值平均起來應與待估參數的真值相同，這就是所謂的無偏性要求。

有效性

在許多情況下，總體參數Θ的無偏估計量不是唯一的，要衡量一個參數的兩個無偏估計量哪一個更好，一個重要的標準就是觀察它們誰的取值更集中於待估參數的真值附近，即哪一個估計量的方差更小，這就是所謂的有效性要求。

相合性（一致性）

一個好的估計量，當樣本容量n越大時，由於關於總體的信息也隨之增加，該估計理應越精確越可靠，特別是當n→∞時，估計值將與參數真值幾乎完全一致，這就是估計量的相合性（一致性）。

區間估計（interval estimation）

對於前文提到的點估計方法，我們無法回答它的精確性如何？可信程度如何？爲了解決這些問題，需要討論參數的區間估計。

區間估計是用兩個統計量所構成的區間來估計一個未知的參數，並同時指明此區間可以覆蓋住這個參數的可靠程度（置信度）
缺點：不能直接地告訴人們“未知參數具體是多少”這一明確的概念

一個正態總體的情況

均值μ的方差估計

總體方差已知和方差未知兩種情況均值μ區間估計的R程序：

interval_estimate1<-function(x,sigma=-1,alpha=0.05){ 
   n<-length(x); xb<-mean(x)
   if (sigma>=0){
      tmp<-sigma/sqrt(n)*qnorm(1-alpha/2); df<-n
   }
   else{
      tmp<-sd(x)/sqrt(n)*qt(1-alpha/2,n-1); df<-n-1
   }
   data.frame(mean=xb, df=df, a=xb-tmp, b=xb+tmp)
}

得到觀測數據後，利用此函數對參數μ作區間估計：

source("interval_estimate1.R")
X<-c(14.6, 15.1,14.9, 14.8, 15.2,15.1)
interval_estimate1(X, sigma=0.2)

得到的結果如下

故該組觀測數據的置信係數爲0.95的置信區間爲[14.79,15.11]

R軟件中的t.test檢驗函數可以完成相應的區間估計工作

t.test(X)

結果如下：

方差σ²的區間估計

總體均值已知和均值未知兩種情況方差σ²區間估計的R程序：

interval_var1<-function(x,mu=Inf,alpha=0.05){ 
   n<-length(x) 
   if (mu<Inf){
      S2 <- sum((x-mu)^2)/n; df <- n
   }
   else{
      S2 <- var(x); df <- n-1
   }
   a<-df*S2/qchisq(1-alpha/2,df)
   b<-df*S2/qchisq(alpha/2,df)
   data.frame(var=S2, df=df, a=a, b=b)
}

輸入數據，調用程序

source("interval_var1.R")
X<-c(10.1,10,9.8,10.5,9.7,10.1,9.9,10.2,10.3,9.9)
interval_var1(X,mu=10)

得到結果如下

從計算結果可以看出，在均值已知的情況下，計算結果更好一些

兩個正態總體的情況

均值差μ1-μ2的區間估計

均值差μ1-μ2區間估計的R程序：

interval_estimate2<-function(x, y, 
   sigma=c(-1,-1),var.equal=FALSE, alpha=0.05){ 
   n1<-length(x); n2<-length(y)
   xb<-mean(x); yb<-mean(y)
   if (all(sigma>=0)){
      tmp<-qnorm(1-alpha/2)*sqrt(sigma[1]^2/n1+sigma[2]^2/n2)
      df<-n1+n2
   }
   else{
      if (var.equal ==  TRUE){
         Sw<-((n1-1)*var(x)+(n2-1)*var(y))/(n1+n2-2)
         tmp<-sqrt(Sw*(1/n1+1/n2))*qt(1-alpha/2,n1+n2-2)
         df<-n1+n2-2
      }
      else{
         S1<-var(x); S2<-var(y)
         nu<-(S1/n1+S2/n2)^2/(S1^2/n1^2/(n1-1)+S2^2/n2^2/(n2-1))
         tmp<-qt(1-alpha/2, nu)*sqrt(S1/n1+S2/n2)
         df<-nu
      }
   }
   data.frame(mean=xb-yb, df=df, a=xb-yb-tmp, b=xb-yb+tmp)
}

首先產生200個隨機數，再調用函數interval_estimate2()進行計算

source("interval_estimate2.R")
x<-rnorm(100, 5.32, 2.18)
y<-rnorm(100, 5.76, 1.76)
interval_estimate2(x,y, sigma=c(2.18,1.76))

得到結果如下：

故μ1-μ2的置信係數爲0.95的區間估計爲[-1.044,0.546]

R軟件中的t.test()函數也可以給出雙樣本差的區間估計

t.test(x,y)

得到的結果如下：

配對數據的區間估計

例如：

輸入數據，調入t.test()函數

X<-c(11.3,15.0,15.0,13.5,12.8,10.0,11.0,12.0,13.0,12.3)
Y<-c(14.0,13.8,14.0,13.5,13.5,12.0,14.7,11.4,13.8,12.0)
t.test(X-Y)

得到的結果如下：

由於0包含在區間估計的區間內，因此可以認爲：治療前後病人的血紅蛋白的含量無明顯差異。

方差比σ1²/σ2²的區間估計

方差比σ1²/σ2²區間估計的R程序：

interval_var2<-function(x,y, 
   mu=c(Inf, Inf), alpha=0.05){ 
   n1<-length(x); n2<-length(y) 
   if (all(mu<Inf)){
      Sx2<-1/n1*sum((x-mu[1])^2); Sy2<-1/n2*sum((y-mu[2])^2)
      df1<-n1; df2<-n2
   }
   else{
      Sx2<-var(x); Sy2<-var(y); df1<-n1-1; df2<-n2-1
   }
   r<-Sx2/Sy2
   a<-r/qf(1-alpha/2,df1,df2)
   b<-r/qf(alpha/2,df1,df2)
   data.frame(rate=r, df1=df1, df2=df2, a=a, b=b)
}

輸入數據，調用函數

A<-scan()
79.98 80.04 80.02 80.04 80.03 80.03 80.04 79.97
80.05 80.03 80.02 80.00 80.02

B<-scan()
80.02 79.94 79.98 79.97 79.97 80.03 79.95 79.97

source("interval_var2.R")
interval_var2(A,B, mu=c(80,80)) #均值已知

interval_var2(A,B) #均值未知

var.test(A,B)

得到的結果如下：

1包含在區間估計的區間中，即有理由認爲兩總體的方差比爲1，即可認爲兩總體的方差是相同的。

非正態總體的區間估計

當數據不服從正態分佈時，估計均值的一種有效的方法就是所謂的大樣本方法，即要求樣本的量比較大，利用中心極限定理進行分析。
非正態總體區間估計的R程序：

interval_estimate3<-function(x,sigma=-1,alpha=0.05){ 
   n<-length(x); xb<-mean(x)
   if (sigma>=0)
      tmp<-sigma/sqrt(n)*qnorm(1-alpha/2)
   else
      tmp<-sd(x)/sqrt(n)*qnorm(1-alpha/2)
   data.frame(mean=xb, a=xb-tmp, b=xb+tmp)
}

例如：

先產生隨機數，再調用函數

source("interval_estimate3.R")
> x<-rexp(50,1/2.266)
> interval_estimate3(x)

得到結果如下：

單側置信區間估計

對於某些問題，人們只關心在某一方向上的界限，這類區間估計問題就被稱爲單側區間估計。

一個總體求均值

根據計算公式及雙側置信區間的公式寫出R程序，並可控制求上、下置信區間或雙側置信區間。

interval_estimate4<-function(x, sigma=-1, side=0, alpha=0.05){ 
   n<-length(x); xb<-mean(x)
   if (sigma>=0){
      if (side<0){
         tmp<-sigma/sqrt(n)*qnorm(1-alpha)
         a <- -Inf; b <- xb+tmp
      }
      else if (side>0){
         tmp<-sigma/sqrt(n)*qnorm(1-alpha)
         a <- xb-tmp; b <- Inf
      }
      else{
         tmp <- sigma/sqrt(n)*qnorm(1-alpha/2)
         a <- xb-tmp; b <- xb+tmp
      }
      df<-n
   }
   else{
      if (side<0){
         tmp <- sd(x)/sqrt(n)*qt(1-alpha,n-1)
         a <- -Inf; b <- xb+tmp
      }
      else if (side>0){
         tmp <- sd(x)/sqrt(n)*qt(1-alpha,n-1)
         a <- xb-tmp; b <- Inf
      }
      else{
         tmp <- sd(x)/sqrt(n)*qt(1-alpha/2,n-1)
         a <- xb-tmp; b <- xb+tmp
      }
      df<-n-1
   }
   data.frame(mean=xb, df=df, a=a, b=b)
}

一個總體求方差

interval_var3<-function(x,mu=Inf,side=0,alpha=0.05){ 
   n<-length(x)
   if (mu<Inf){
      S2<-sum((x-mu)^2)/n; df<-n
   }
   else{
      S2<-var(x); df<-n-1
   }
   if (side<0){
      a <- 0
      b <- df*S2/qchisq(alpha,df)
   }
   else if (side>0){
      a <- df*S2/qchisq(1-alpha,df)
      b <- Inf
   }
   else{
      a<-df*S2/qchisq(1-alpha/2,df)
      b<-df*S2/qchisq(alpha/2,df)
   }
   data.frame(var=S2, df=df, a=a, b=b)
}

兩個總體求均值差

interval_estimate5<-function(x, y, 
   sigma=c(-1,-1), var.equal=FALSE, side=0, alpha=0.05){ 
   n1<-length(x); n2<-length(y)
   xb<-mean(x); yb<-mean(y); zb<-xb-yb
   if (all(sigma>=0)){
      if (side<0){
         tmp<-qnorm(1-alpha)*sqrt(sigma[1]^2/n1+sigma[2]^2/n2)
         a <- -Inf; b <- zb+tmp
      }
      else if (side>0){
         tmp<-qnorm(1-alpha)*sqrt(sigma[1]^2/n1+sigma[2]^2/n2)
         a <- zb-tmp; b <- Inf
      }
      else{
         tmp<-qnorm(1-alpha/2)*sqrt(sigma[1]^2/n1+sigma[2]^2/n2)
         a <- zb-tmp; b <- zb+tmp
      }
      df<-n1+n2
   }
   else{
      if (var.equal ==  TRUE){
         Sw<-((n1-1)*var(x)+(n2-1)*var(y))/(n1+n2-2)
         if (side<0){
            tmp<-sqrt(Sw*(1/n1+1/n2))*qt(1-alpha,n1+n2-2)
            a <- -Inf; b <- zb+tmp
         }
         else if (side>0){
            tmp<-sqrt(Sw*(1/n1+1/n2))*qt(1-alpha,n1+n2-2)
            a <- zb-tmp; b <- Inf
         }
         else{
            tmp<-sqrt(Sw*(1/n1+1/n2))*qt(1-alpha/2,n1+n2-2)
            a <- zb-tmp; b <- zb+tmp
         }
         df<-n1+n2-2
      }
      else{
         S1<-var(x); S2<-var(y)
         nu<-(S1/n1+S2/n2)^2/(S1^2/n1^2/(n1-1)+S2^2/n2^2/(n2-1))
         if (side<0){
            tmp<-qt(1-alpha, nu)*sqrt(S1/n1+S2/n2)
            a <- -Inf; b <- zb+tmp
         }
         else if (side>0){
            tmp<-qt(1-alpha, nu)*sqrt(S1/n1+S2/n2)
            a <- zb-tmp; b <- Inf
         }
         else{
            tmp<-qt(1-alpha/2, nu)*sqrt(S1/n1+S2/n2)
            a <- zb-tmp; b <- zb+tmp
         }
         df<-nu
      }
   }
   data.frame(mean=zb, df=df, a=a, b=b)
}

求兩個總體方差的情況

interval_var4<-function(x,y, 
   mu=c(Inf, Inf), side=0, alpha=0.05){ 
   n1<-length(x); n2<-length(y) 
   if (all(mu<Inf)) {
      Sx2<-1/n1*sum((x-mu[1])^2); df1<-n1
      Sy2<-1/n2*sum((y-mu[2])^2); df2<-n2
   }
   else{
      Sx2<-var(x); Sy2<-var(y); df1<-n1-1; df2<-n2-1
   }
   r<-Sx2/Sy2
   if (side<0) {
      a <- 0
      b <- r/qf(alpha,df1,df2)
   }
   else if (side>0) {
      a <- r/qf(1-alpha,df1,df2)
      b <- Inf
   }
   else{
      a<-r/qf(1-alpha/2,df1,df2)
      b<-r/qf(alpha/2,df1,df2)
   }
   data.frame(rate=r, df1=df1, df2=df2, a=a, b=b)
}