题目

练习题一

在一个3000英亩的保护区中，有730英亩的栖息地遭受了一场或咋。6个月后研究者在保护区中对保护区展开调查，将保护区分为4个部分：（1）火灾中心（520英亩）；（2）火灾区内边缘（210英亩）；（3）火灾区外边缘（240英亩）；（4）火灾区外未燃烧区（2030英亩）。研究者在3000英亩的保护区内共计数鹿75头，其中2头位于火灾中心，12头位于火灾区内边缘，18头位于火灾区外边缘，43头位于火灾外未燃烧区。若火灾前任意鹿个体出现在保护区任意位置的概率相等，问火灾能影响鹿的行为吗？

练习题二

为探究德国人头发和眼睛颜色的关系，一个人类学家调查了6800名德国男性的样本，发现眼睛和头发全为黑色的有726人，眼睛为浅色、头发为黑色的有3129人，眼睛为黑色、头发为浅色的有131人，眼睛为浅色、头发为浅色的有2814人。问头发颜色和眼睛颜色是否相互独立？

练习题三

随机抽取一群大学生群体，其中13人注射过流感疫苗，28人未注射。在注射过流感疫苗的人中，有3名同学感染了流感；在未注射流感疫苗的人中，有15名同学感染了流感。问注射流感疫苗是否影响患上流感的概率？

练习题四

研究人员测定了7名男性志愿者参与10周的训练项目前后体内甘油三脂浓度，结果如下。问该运动是否可以降低甘油三脂水平？

参与者|运动前(血清甘油三脂浓度mol/L)|运动后

1|0.87|0.57

2|1.13|1.03

3|3.14|1.47

4|2.14|1.43

5|2.98|1.20

6|1.18|1.09

7|1.60|1.51

练习题一

拟合优度检验用于检验实际观测数与依照某种假设或模型计算的理论数之间的一致性。设观测数为O，理论数为T，在O、T均服从或近似服从正态分布时，构建统计量 \[ \chi^{2} = \sum_{i=1}^{k}\frac{(O_i - T_i)^2}{T_i} \] 若T完全已知，该统计量自由度为 \[ df = k - 1 \] 当观测数足够大时，可证明该统计量近似服从自由度为df的卡方分布 \[ \chi^2 \sim \chi^2_{df} \] 拟合优度检验的原假设为 \[ H_0 : O - T = 0 \] 备择假设为 \[ H_1 : O - T \neq 0 \] 对于此题，代码分析及结果如下

# 计算理论值
T_ <- c(520, 210, 240, 2030) * 75 / 3000
# 观测值
O_ <- c(2, 12, 18, 43)
# 构建统计量
chi <- sum(((O_ - T_)^2 / T_))
# 自由度
df <- length(O_) - 1
# 若火灾不影响鹿的行为，原假设：O - T = 0
# 置信度
alpha <- 0.05
# 接受原假设的概率
p <- 1 - pchisq(chi, df = df)
# 结论
print(paste("构造统计量chi =", chi))
## [1] "构造统计量chi = 43.1697612732096"
print(paste("统计量自由度df =", df))
## [1] "统计量自由度df = 3"
print(paste("接受原假设的概率p =", p))
## [1] "接受原假设的概率p = 2.26499452526951e-09"
print(ifelse(p <= 0.05, "在95%的置信水平下，可认为火灾影响了鹿的行为", "无足够证据支持火灾影响了鹿的行为"))
## [1] "在95%的置信水平下，可认为火灾影响了鹿的行为"
# 用R语言自带的做一遍, 结果和分析一致
chisq.test(O_, p = c(520, 210, 240, 2030) / 3000)
## 
##  Chi-squared test for given probabilities
## 
## data:  O_
## X-squared = 43.17, df = 3, p-value = 2.265e-09

练习题二

独立性检验指的是检验两个变量之间是否关联。对于一个联列表而言，变量的分布未知，只能通过变量的独立性原理进行检验。即 \[ T = P(AB) = P(A)P(B) \] 列联表表中数据即为观测值O。 统计量的自由度如下，其中r、c为二维列联表的行、列数 \[ df = (r - 1)(c - 1) \] 在2×2的列联表中，即自由度为1，应作连续性校正，即统计量为 \[ \chi^{2} = \sum_{i=1}^{k}\frac{(\left |O_i - T_i\right| - 0.5)^2}{T_i} \] 原假设、备择假设和上题完全相同。 对于此题而言，代码和分析如下

# 列联表
O_ <- c(726, 3129, 131, 2814)
total <- sum(O_)
res <- matrix(O_, 2, 2)
# 计算列联表的边缘分布
black_eye <- sum(res[1,])
white_eye <- sum(res[2,])
black_hair <- sum(res[,1])
white_hair <- sum(res[,2])
# 计算理论值
T_bb <- black_eye * black_hair / total
T_wb <- white_eye * black_hair / total
T_bw <- black_eye * white_hair / total
T_ww <- white_eye * white_hair / total
T_ <- c(T_bb, T_wb, T_bw, T_ww)
# 构建统计量
chi <- sum(((abs(O_ - T_) - 0.5)^2 / T_))
# 自由度
df <- (dim(res)[1] - 1) * (dim(res)[2] - 1)
# 接受原假设的概率
p <- 1 - pchisq(chi, df = df)
# 结论
print(paste("构造统计量chi =", chi))
## [1] "构造统计量chi = 312.326874947256"
print(paste("统计量自由度df =", df))
## [1] "统计量自由度df = 1"
print(paste("接受原假设的概率p =", p))
## [1] "接受原假设的概率p = 0"
print(ifelse(p <= 0.05, "在95%的置信水平下，可拒绝原假设，接受备择假设，即认为德国人头发和眼睛颜色存在相关性", "无足够理由拒绝原假设，即德国人头发和眼睛颜色不存在相关性"))
## [1] "在95%的置信水平下，可拒绝原假设，接受备择假设，即认为德国人头发和眼睛颜色存在相关性"
# R语言自带的做一遍, 结果和分析一致
chisq.test(res)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  res
## X-squared = 312.33, df = 1, p-value < 2.2e-16

练习题三

当二维列联表中样本量较小时，统计量不再近似服从卡方分布，不能再用上述方法进行检验。此时应用fisher精确检验，即穷举法。令列联表的边缘分布不变，列举所有可能出现的表，计算所关心的表出现的频率。 对于此题而言，代码和结果如下

# 列联表
O_ <- c(15, 13, 3, 10)
total <- sum(O_)
res <- matrix(O_, 2, 2)
# 边缘分布
had_flu <- sum(res[1,])
not_flu <- sum(res[2,])
not_im <- sum(res[,1])
had_im <- sum(res[,2])
edge <- c(had_flu, not_flu, not_im, had_im)
# 可能出现的表的总数
t_all <- (factorial(total) / (factorial(had_flu) * factorial(not_flu))) * (factorial(total) / (factorial(had_im) * factorial(not_im)))
# 为计算简便，在边缘确定一个最小的值
min_i <- which.min(edge)
# 在第几行
min_r <- 2 - (min_i %% 2)
# 在第几列
min_c <- round(min_i / 4) + 1
# 第一次计算哪一行
first_r <- ifelse(min_r == 1, had_flu, not_flu)
# 穷举所有可能
ps <- sapply(0:edge[min_i], function(x){
  T_ <- matrix(0, 2, 2)
  # 确定了一个值，便可利用边缘分布确定其他所有值
  T_[min_r, min_c] = x
  # 先推算所在行的值
  T_[min_r, 3 - min_c] = first_r - x
  # 推算列的值
  T_[3 - min_r, 1] = not_im - T_[min_r, 1]
  T_[3 - min_r, 2] = had_im - T_[min_r, 2]
  # 以频率估计概率
  return(factorial(total) / prod(sapply(T_, factorial)) / t_all)
})
# 原假设，注射疫苗和感染流感无关，故做双侧检验
p <- sum(ps[ps<=(factorial(total) / prod(sapply(O_, factorial)) / t_all)])
# 结果和分析
print(paste("接受原假设的概率p =", p))
## [1] "接受原假设的概率p = 0.0954831157156234"
print(ifelse(p <= 0.05, "在95%的置信水平下，可拒绝原假设，接受备择假设，即认为注射流感预防针，可以改变患上流感的概率", "无足够理由拒绝原假设，即无论是否注射流感预防针，每人患上流感的概率相同"))
## [1] "无足够理由拒绝原假设，即无论是否注射流感预防针，每人患上流感的概率相同"
# R语言自带的做一遍，结果和分析一致
fisher.test(res)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  res
## p-value = 0.09548
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##   0.7403295 25.6099310
## sample estimates:
## odds ratio 
##   3.721944

练习题四

对于配对数据样本的t检验，可以转换为配对数据差值间的单个样本的t检验问题。对于配对数据y = (y1, y2), 令d = y1 - y2,用d构建统计量。其中s为样本标准差，n为样本量。 \[ t = \frac{\overline{d} - \mu}{\frac{s}{\sqrt{n}}} \] t服从自由度为n-1的t分布 \[ t \sim t_{n-1} \] 对于此题，原假设为 \[ H_0 : \mu_{\overline{d}} = 0 \] 对于此题，备择假设为 \[ H_1 : \mu_{\overline{d}} > 0 \] 代码和结果如下

# 配对数据
before <- c(0.87, 1.13, 3.14, 2.14, 2.98, 1.18, 1.60)
after <- c(0.57, 1.03, 1.47, 1.43, 1.20, 1.09, 1.51)
# 构造d
d_ <- before - after
# 构造统计量
t <- (mean(d_) - 0) / (sd(d_) / sqrt(length(d_)))
# 单尾，接受原假设的概率
p = 1 - pt(t, df = length(d_) - 1)
# 结果和分析
print(paste("接受原假设的概率p =", p))
## [1] "接受原假设的概率p = 0.0269676098357199"
print(ifelse(p <= 0.05, "在95%的置信水平下，可拒绝原假设，接受备择假设，即认为有规律的运动可以降低甘油三脂的水平", "无足够理由拒绝原假设，即认为有规律的运动不能降低甘油三脂的水平"))
## [1] "在95%的置信水平下，可拒绝原假设，接受备择假设，即认为有规律的运动可以降低甘油三脂的水平"
# 用R语言自带的做一遍，结果和分析一致
t.test(before, after, alternative = "greater", paired = TRUE)
## 
##  Paired t-test
## 
## data:  before and after
## t = 2.3912, df = 6, p-value = 0.02697
## alternative hypothesis: true mean difference is greater than 0
## 95 percent confidence interval:
##  0.1268792       Inf
## sample estimates:
## mean difference 
##       0.6771429