本週上課將介紹迴歸的假設檢定,也就是從樣本的迴歸係數推論母體的迴歸係數\(\mu\)。之前我們證明\(\hat{\mu}=\bar{y}=\frac{1}{n}\Sigma_{i=1}^{n}y_{i}\)。同理,\(\hat{\beta}_{0}\)與\(\hat{\beta}_{1}\)分別是\(\beta_{0}\)跟\(\beta_{1}\)的估計。
例如從平均值為0、變異數為1的常態分佈抽100個數,分成兩種方式計算平均值,也就是兩種樣本統計。第一種是\(\frac{1}{n}\sum X_{i}\),第二種是\(\frac{1}{n+1}\sum X_{i}\),畫圖顯示重複1000次之後,樣本平均值所構成的分佈。
#Two sampling
set.seed(02139)
datam1<-rep(NA,1000)
for (i in 1:1000){
datam1[i]<-mean(rnorm(100, 0, 1))
}
mean2<-function(x){
sum(x)/(length(x)+1)
}
datam2<-rep(NA,1000)
for (i in 1:1000){
datam2[i]<-mean2(rnorm(100, 0, 1))
}
#Two graphs
par(mfrow=c(1,2))
hist(datam1,xlab=expression(paste(hat(mu)[1])),
main=expression(paste(hat(mu)[1]==frac(1,n),sum(X[i],i=1,N))),prob=T,
breaks=seq(-1, 1,by=0.01))
hist(datam2,xlab=expression(paste(hat(mu)[2])),
main=expression(paste(hat(mu)[2]==frac(1,n+1),sum(X[i],i=1,N))),prob=T,
breaks=seq(-1, 1,by=0.01))
比較上面兩個圖,形狀都近似常態分佈,而且都集中在0附近。如果重複次數更多次,或者每個樣本數更大,那麼離散程度會越來越趨近於0,越來越集中在0。
根據中央極限定理,如果\(X\)獨立抽樣於母體參數為\(\mu\)、\(\sigma\)的常態分佈母體,那麼隨著樣本數越來越大,\(\frac{\bar{X}-\mu}{\sigma/\sqrt{n}}\)會成平均值為0、變異數為1的常態分佈。 我們從\(\mu=1\)、\(\sigma=3\)的常態分佈抽樣,每次抽出10、30、1000個,並且重複抽取10次與100次,觀察\(\frac{\bar{X}-\mu}{s/\sqrt{n}}\)是否會成平均值為0、變異數為1的常態分佈。
par(mfrow=c(3,2))
set.seed(02138)
res <-c()
s <- c()
simulations <- c(10, 100)
samples <- c(10, 30, 1000)
for (i in 1:length(simulations)){
for (j in 1:length(samples)){
f=function(n=samples[j], mu=1, sigma=3){
s=rnorm(samples[j], 1, 3)
(mean(s)-mu)/sqrt((sum(s-mean(s))^2)/sqrt(n))
}
xvals = seq(-3,3, 0.1)
hist(UsingR::simple.sim(simulations[i], f, samples[j], 1), probability=TRUE, breaks=30, col='#3399FF', main=paste("N=", samples[j], ", Num. of Samples=", simulations[i]),
xlab=expression(mu))
xvals = seq(-3, 3, .01)
points(xvals,dnorm(xvals, 0, 1),type="l", lwd=2, col='#FF9933')
}
}
指數(exponential)分佈也適用於中央極限定理。指數分佈的密度函數可寫成\(\lambda e^{-\lambda t}\),期待值為\(\frac{1}{\lambda}\),變異數為\(\frac{1}{\lambda^2}\)。 當我們有\(X_{1}\ldots X_{N}\)抽自指數分佈的變數時,平均值為\(\lambda\),變異數為\(\frac{1}{N\lambda^2}\),而標準誤則為\(\frac{1}{\lambda\sqrt{N}}\)。 例如我們畫出5個圖表示不同的樣本數大小的指數抽樣分佈,母體的平均數為10:
par(mfrow=c(3,2))
samples <-c(20, 100, 500, 1000, 3000)
set.seed(02138)
for (i in 1:length(samples)){
f = function(n=samples[i],mu=10) (mean(rexp(n,1/mu))-mu)/(mu/sqrt(n))
xvals = seq(-3,3,.01)
hist(UsingR::simple.sim(100,f,1,10), probability=TRUE, breaks=50,
main=paste("N=", samples[i]), xlab=expression(lambda), col='#3399FF')
points(xvals, dnorm(xvals,0,1),type="l", lwd=2, col='#FF9933')
}
二元分布的樣本平均數也會成常態分佈。假設抽出一個二元的樣本\(n\)次,例如抽出某一日的天氣紀錄,了解是否有下雨,重複抽\(n\)次,\(Y=\sum_{i}^{n} X_{i}\),\(X\)代表是否有下雨,\(Y\)等於有下雨的總天數。\(Y\)與\(X_{i}\)都來自貝努利(Bernoulli)分佈。 \(X_{i}\)的平均值為\(p=\frac{Y}{n}\),也就是下雨的機率,而\(p(1-p)\)則是變異數。 \(Y\)的變異數是:
\(V[Y]=V[\sum X_{i}]=\sum V[X_{i}]=np(1-p)\)
這是因為\(Var(X)+Var(Y)=Var(X+Y)\)。變異數的線性組合等於變異數之間的相加減。而因為\(Y=nX_{i}\),故\(V[Y]=nV[X]=np(1-p)\)。 當我們重複相同的實驗\(k\)次,得到無數的\(Y\),構成完整的母體。此時平均值與變異數為何?因為\(p=\frac{Y}{n}\),所以:
\(V[\frac{Y}{n}]=\frac{1}{n^2}V[Y]=\frac{1}{n^2}np(1-p)=\frac{p(1-p)}{n}\)
因此標準誤為\(\sqrt{\frac{p(1-p)}{n}}\)
例如從二元分佈經過\(k\)次實驗後得到若干成功的次數,其中\(p=0.25\)。重複1000次同樣的程序之後,\(Y\)的標準化應該會形成一個常態分佈。
set.seed(2019)
results =numeric(0)
k=100; p=0.25; mu=k*p # k is number of trials
for (i in 1:1000) {
S = rbinom(1, k, p)
results[i]=(S-mu)/sqrt(k*p*(1-p)) #
}
hist(results, probability = T, col='#3399FF', breaks=30, main='')
xvals = seq(-3,3,.01)
points(xvals,dnorm(xvals,0,1),type="l", lwd=2, col='#FF9933')
\[ \hat{e}_{i}=y_{i}-\hat{y}_{i}=y_{i}-\hat{\beta}_{0}-\hat{\beta}_{1}x_{i} \]
\[ MSD(\hat{u})\equiv\frac{1}{n}\sum\limits_{i=1}^{n}(\hat{u}_{i}-\bar{\hat{u}})^2=\frac{1}{n}\sum\limits_{i=1}^{n}\hat{u}_{i}^2 \]
\[ \begin{eqnarray} E[MSD(\hat{u})] & = & \frac{n-2}{n}\sigma^{2}_{u}\\ \sigma^{2}_{u} & = &\frac{n}{n-2}MSD(\hat{u}) \\ & =& \frac{n}{n-2}\cdot\frac{1}{n}\sum\limits_{i=1}^{n}\hat{u}_{i}^2 \\ & =& \frac{1}{n-2}\sum\limits_{i=1}^{n}\hat{u}_{i}^2 \end{eqnarray} \]
\(\frac{1}{n-2}\sum\limits_{i=1}^{n}\hat{u}_{i}^2\)代入: \[ \begin{eqnarray} \hat{V}[\hat{\beta}_{1}|X] & = &\mathcal{\frac{\sigma_{u}^{2}}{\sum_{i=1}^{n}(x-\bar{x})^2}} \\ & = & \frac{\sigma_{u}^{2}}{SST_{x}} \end{eqnarray} \] \[ \begin{eqnarray} \hat{V}[\hat{\beta}_{0}|X] & = &\sigma_{u}^{2}\mathcal{\{\frac{1}{n}+\frac{\bar{x}^2}{\sum_{i=1}^{n}(x-\bar{x})^2}}\}\\ & = &\mathcal{\frac{\sigma_{u}^2\sum_{i=1}^{n}x^2}{n\sum_{i=1}^{n}(x-\bar{x})^2}} \end{eqnarray} \] where \[ \sigma_{u}^{2}=\frac{1}{n-2}\sum\limits_{i=1}^{n}\hat{u}_{i}^2 \]
\(\blacksquare\) 取開根號:\(\sqrt{\hat{V}[\hat{\beta}_{0}|X]}\)以及\(\sqrt{\hat{V}[\hat{\beta}_{1}|X]}\)\[ u\sim N(0,\sigma_{u}^{2}) \]
\[ \mathrm{Y}|\mathrm{X} \sim N(\beta_{0}+\beta_{1}X, \sigma_{u}^{2}) \]
也就是變異數同質性以及誤差項的平均值為0的假設。
\[ \sigma^2=\frac{\Sigma(y-\hat{y})^2}{n-2} \] \[ \mathrm{SE}(\hat{\beta_{1}})=\sqrt{\frac{\sigma^2}{\sum(x_{i}-\bar{x})^2}} \]
\(95\%\)的信賴區間相當於兩個標準誤,係數加減兩個標準誤構成一個\(95\%\)的信賴區間:
\[
[\mathcal{\hat{\beta_{1}}-2\cdot \mathrm{SE}(\hat{\beta_{1}}), \hspace{.3em}\hat{\beta_{1}}+2\cdot \mathrm{SE}(\hat{\beta_{1}})}]
\]
\(\it{H}_{0}\): X與Y沒有關係,也就是\(\it{H}_{0}\): \(\beta_{1}=0\)
\(\it{H}_{a}\): X與Y有某種關係,也就是\(\it{H}_{a}\): \(\beta_{1} \neq 0\)
\[ t=\frac{\hat{\beta}_{1}-0}{\mathrm{SE}(\hat{\beta}_{1})} \]
par(bty='n', yaxt='n')
cord.x<-c(1.962, seq(1.962,3,0.01), 3)
cord.x2<-c(-3, seq(-3, -1.962,0.01), -1.962)
cord.y<-c(0, dt(seq(1.962, 3, 0.01), 1000), 0)
cord.z<- c(0, dt(seq(-3, -1.962, 0.01), 1000), 0)
curve(dt(x, 1000),xlim=c(-3,3),
main=expression(paste("Normal Density with"," ", t[alpha/2]=="0.025")) , ylab='', xlab='t value')
polygon(cord.x, cord.y, col="red3")
polygon(cord.x2, cord.z, col="red3" , add=T)
單尾檢定可檢證\(\hat{\beta}\)是否大於0或是特定的數,對立假設是小於大於0或是特定的數:
par(bty='n', yaxt='n')
cord.x<-c(1.646, seq(1.646,3,0.01), 3)
cord.y<-c(0, dt(seq(1.646, 3, 0.01), 1000), 0)
curve(dt(x, 1000),xlim=c(-3,3),
main=expression(paste("Normal Density with"," ", t[alpha/2]=="0.05")) , ylab='', xlab='t value')
polygon(cord.x, cord.y, col="red3")
plot(function(x) dt(x, df = 300), -3, 3, ylim = c(0, .5),
main = "t - Density", yaxs = "i", col="white",ylab="Density",
xlab=expression(paste(X %~% tau[n])))
curve(dt(x, df = 3), -3,3, bty="l", col="blue", add=T, lwd=2)
curve(dt(x, df = 1), -3,3, bty="l", col="black", add=T, lwd=2)
curve(dt(x, df = 1000), -3,3, bty="l", col="red", add=T, lwd=2)
curve(dt(x, df = 15), -3,3, bty="l", col="green", add=T, lwd=2)
legend("topright", lty=c(1,1,1,1), lwd=c(2,2,2,2),
legend=c(expression(nu==1, nu==3, nu==15,nu==1000)),
col=c("black", "blue", "green","red"))
迴歸模型的自由度代表有多少資訊可以用來估計係數,自由度越大,估計係數越穩定。 自由度等於\(n-k\),\(n\)代表觀察值,\(k\)代表係數。一般來說,每一個係數至少需要10到15個樣本(參考Jim Frost)。 如果樣本數太少、參數太多,那麼少數的樣本決定參數的大小,產生overfitting的問題。從有限的樣本所得到的參數,可能無法推論到母體。 想像有20個樣本,我們可以計算平均數,再用\(t\)檢定檢驗是否等於某個數。但是如果我們把20個樣本分成兩群,分別計算平均數,再用\(t\)檢定檢驗是否等於某個數,我們分別剩下10個樣本給其中一組,任何樣本的偏差就會影響樣本統計。如果再分成3群、4群,自由度越來越小。迴歸模型也是如此。樣本數代表資訊,資訊夠多,得到的係數估計才會正確。
因為\(t=\frac{\hat{\beta}}{\sigma/\sqrt{n}}\),所以\(t\)值取決於:
以上三個因素與檢定力(statistical power)相關。檢定力可寫成Power=1-\(\beta\)。其中\(\beta\)代表Type II error的機率,也就是虛無假設不成立的條件下,但是不否定虛無假設。因此,檢定力代表正確地拒斥錯誤的虛無假設。如果\(\beta=0.8\),代表有\(80\%\)的機會正確地發現事實上存在的作用。
根據檢定力的概念,我們可以反推需要多少樣本數,才不會拒斥正確的虛無假設,或者拒斥錯誤的虛無假設。
\(\blacksquare\)有關Type I跟Type II error可見Jim Frost (https://statisticsbyjim.com/hypothesis-testing/types-errors-hypothesis-testing/)。
R
計算\(t\)分布的百分位的機率,也可以計算機率對應的百分位。首先計算特定機率的百分位:
qtd <-data.frame(q_975=qt(0.950, 1000),
q_950=qt(0.975, 1000),
q_990=qt(0.990, 1000))
newqtd <- qtd %>% kable("html") %>%
kable_styling(bootstrap_options = 'striped')
newqtd
q_975 | q_950 | q_990 |
---|---|---|
1.646379 | 1.962339 | 2.330083 |
tt <- data.frame(p_168=pt(1.68, 1000), p_196=pt(1.96, 1000), p_300=pt(3.00, 1000))
newtt <- tt %>% kable("html") %>%
kable_styling(bootstrap_options = 'striped')
newtt
p_168 | p_196 | p_300 |
---|---|---|
0.9533652 | 0.9748634 | 0.9986166 |
假設迴歸模型為:\[Y=\beta_{0}+\beta_{1}X+\beta_{2}Z+\epsilon\]
估計的迴歸係數可寫成\[\hat{\beta}_{1}=\frac{\sum_{i}^{n}\hat{r}_{xz,i}y_{i}}{\sum_{i}^{n}\hat{r}_{xz,i}}\]
其中\(\hat{r}_{xz,i}\)代表用\(Z\)預測\(X\)的殘差: \[X=\lambda+\delta\dot Z+r_{xz}\]
也就是說,
以pscl
套件的UKHouseOfCommons為例,v2是工黨的得票率,v3是自由民主黨的得票率,labinc代表該選區現任者為工黨議員。 先估計完整的複迴歸模型:
library(pscl); library(stargazer)
m1<-lm(v2 ~ v3 + labinc , data=UKHouseOfCommons)
stargazer(m1, type='html')
Dependent variable: | |
v2 | |
v3 | -0.998*** |
(0.041) | |
labinc | 0.206*** |
(0.009) | |
Constant | 0.495*** |
(0.010) | |
Observations | 521 |
R2 | 0.770 |
Adjusted R2 | 0.769 |
Residual Std. Error | 0.085 (df = 518) |
F Statistic | 865.698*** (df = 2; 518) |
Note: | p<0.1; p<0.05; p<0.01 |
估計得到的模型可寫成: \[v2=0.495-0.998\cdot \mathrm{v3}+0.206\cdot \mathrm{labinc}\]
分別估計第二個自變數預測第一個自變數的模型,把殘差值存起來,預測原來的依變數。
library(pscl)
m2 <- lm(v3 ~ labinc , data=UKHouseOfCommons)
resd.m2 <- residuals(m2)
m3 <- lm(v2 ~ resd.m2, data=UKHouseOfCommons)
stargazer(m3, type='html')
Dependent variable: | |
v2 | |
resd.m2 | -0.998*** |
(0.073) | |
Constant | 0.361*** |
(0.007) | |
Observations | 521 |
R2 | 0.263 |
Adjusted R2 | 0.261 |
Residual Std. Error | 0.153 (df = 519) |
F Statistic | 184.956*** (df = 1; 519) |
Note: | p<0.1; p<0.05; p<0.01 |
估計結果為:
\[v3=0.361-0.998\cdot \mathrm{residual\hspace{.1cm}of\hspace{.1cm}model\hspace{.1cm}2}\]
得到的係數等於複迴歸模型的第一個迴歸係數。這說明第一個自變數的係數代表去掉第二個自變數作用的淨作用。
請問大學教師的薪水與性別有關嗎?使用car
裡面的Salaries
資料:
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
##
## Call:
## lm(formula = salary ~ sex)
##
## Residuals:
## Min 1Q Median 3Q Max
## -57290 -23502 -6828 19710 116455
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 101002 4809 21.001 < 2e-16 ***
## sexMale 14088 5065 2.782 0.00567 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 30030 on 395 degrees of freedom
## Multiple R-squared: 0.01921, Adjusted R-squared: 0.01673
## F-statistic: 7.738 on 1 and 395 DF, p-value: 0.005667
## [1] 0.02534923
## [1] 0.002847915
請問氣溫與風力大小、月份有關嗎?我們分析airquality
資料:
##
## Call:
## lm(formula = Temp ~ Wind + factor(Month))
##
## Residuals:
## Min 1Q Median 3Q Max
## -14.8929 -4.4212 0.0799 3.4794 17.8880
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 74.1885 2.0544 36.112 < 2e-16 ***
## Wind -0.7434 0.1488 -4.996 1.64e-06 ***
## factor(Month)6 12.5436 1.5943 7.868 7.18e-13 ***
## factor(Month)7 16.3621 1.6183 10.110 < 2e-16 ***
## factor(Month)8 16.3163 1.6239 10.047 < 2e-16 ***
## factor(Month)9 10.2792 1.5959 6.441 1.59e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.175 on 147 degrees of freedom
## Multiple R-squared: 0.5884, Adjusted R-squared: 0.5744
## F-statistic: 42.03 on 5 and 147 DF, p-value: < 2.2e-16
\[
\hat{\beta_{1}}=\frac{\sum (x_{i}-\bar{x})(y_{i}-\bar{y})}{\sum(y_{i}-\bar{y})^2}
\] \[
\sigma^2=\frac{\Sigma(y-\hat{y})^2}{n-2}
\] \[
\mathrm{SE}(\hat{\beta_{1}})=\sqrt{\frac{\sigma^2}{\sum(x_{i}-\bar{x})^2}}
\]
library(kableExtra)
DT<-data.frame(X=c(4, 3, 5, 2, 4, 2, 2, 3, 2, 2, 2, 3, 5, 1, 1),
Y=c(5, 5, 5, 3, 4, 3, 3, 4, 4, 5, 4, 5, 3, 2, 1))
DT %>%
kable("html") %>%
kable_styling(bootstrap_options = 'striped')
X | Y |
---|---|
4 | 5 |
3 | 5 |
5 | 5 |
2 | 3 |
4 | 4 |
2 | 3 |
2 | 3 |
3 | 4 |
2 | 4 |
2 | 5 |
2 | 4 |
3 | 5 |
5 | 3 |
1 | 2 |
1 | 1 |
X | Y |
---|---|
2 | 3 |
1 | 4 |
3 | 5 |
4 | 4 |
5 | 4 |
## 最後更新日期 06/07/2019