实验内容及要求
- 利用观测数据计算总体分位数、对称中心和位置差的点估计，区间估计；
- 利用R软件自带程序或自编程序完成中位数的符号检验，两总体比较的Wilcoxon秩和检验和K-S检验，独立性与随机性的卡方检验和Fisher列联表检验，相关性秩检验与协同性检验以及多总体比较的秩和检验和卡方检验；
- 制作数据经验分布函数、概率密度图像，使用分布拟合方法解决总体类型的检验问题；
- 通过最小二乘与权函数结合使用的方法解决非线性回归问题；
本文中国运动员获世界冠军实验项目数据来源于国家数据网站：
http://data.stats.gov.cn/easyquery.htm?cn=C01
实验项目一
项目一收集1999年至2017年中国运动员获世界冠军的项数（单位：项）和人数（单位：人）。
|
|
|
|
|
(1)计算其中运动员获世界冠军人数(人)的总体分位数如下：
$人数排序
94 109 123 129 138 140 151 154 159 164 169 175 180 198 206 214 217 223
248
$五数总括
94 139 164 202 248
$分位数
0% 25% 50% 75% 100%
94 139 164 202 248
(2) 计算其中运动员获世界冠军人数(人)的对称中心的点估计、区间估计：
点估计：
$均值
[1] 37.52632
$截尾均值
[1] 167.9474
区间估计：求出置信度为0.9的置信区间
$数据位置
[1] "( 5 , 15 )"
$区间估计
[1] "[ 22 , 30 ]"
(3)设运动员获世界冠军项数(项)和运动员获世界冠军人数(人)这两个简单样本分别取自总体Y和X，假定，试用样本均值差作的估计。
样本均值易受异常值影响，但是中位数不会，因此对于本样本同时采用中位数来作为位置差的点估计。
$样本均值之差
[1] 130.4211
$样本中位数之差
[1] 140
位置差的HL区间估计：
$中位数
[1] 131
$上下界位置
[1] "114" "248"
$`95%置信区间`
[1] "[ 107 , 152 ]
实验项目二
(1) 中位数的符号检验
检验1999年至2017年期间，运动员获世界冠军人数(人)的中位数是否为155？()
中为负数的个数，则的拒绝域为
根据公式
由观测值得到Y的值，若则接受，否则拒绝。
|
| 运动员获世界冠军人数(人) |
| P值 | 0.6476059 |
由于p值大于0.05，检验的结论是接受原假设，认为运动员获世界冠军人数(人)的中位数应该为155。
(2)两总体比较的Wilcoxon秩和检验
运动员获世界冠军男女人数是否存在显著差异？()
拒绝域为：
通过软件计算出：
$r1
[1] 88
$r2
[1] 152
$是否落入拒绝域
[1] FALSE
则得到结论：运动员获世界冠军男女人数存在显著差异。
(3) 两总体比较的K-S检验
设男子世界冠军人数来自分布为F(x)的总体女子世界冠军人数来自分布为Gx)的总体，检验这两个分布是否相同，即原假设为：
计算结果如下：
Two-sample Kolmogorov-Smirnov test
data: x and y
D = 0.33846, p-value = 0.5366
alternative hypothesis: two-sided
由于p值=0.5366>0.05，故接受原假设，即认为F(x)和G(x)这两个分布函数相同。
(4)卡方独立性检验
本案例数据来源于百度文库。
在遇到车祸的情况下，乘客系安全带与没系安全带时受到的冲击力的数据如下：
| 受伤情况 | 无 | 轻微 | 较重 | 严重 | 合计 |
| 安全带系 | 12813 | 647 | 359 | 42 | 13861 |
| 安全带没系 | 65963 | 4000 | 2642 | 303 | 72908 |
| 合计 | 78776 | 4647 | 3001 | 345 | 86769 |
各因子之间是否是独立的？
计算结果如下：
Pearson's Chi-squared test
data: rbind(yesbelt, nobelt)
X-squared = 59.224, df = 3, p-value = 8.61e-13
其中p值=8.61e-13<0.05，拒绝原假设，即认为两行因子不是相互独立的。
(5) Fisher列联表检验
本例仍然使用乘客系安全带与没系安全带时受到的冲击力的数据进行分析，首先将上例数据改为2*2的列联表：
| 受伤情况 | 无 | 受伤 | 合计 |
| 安全带系 | 12813 | 1048 | 13861 |
| 安全带没系 | 65963 | 6945 | 72908 |
| 合计 | 78776 | 7993 | 86769 |
计算结果如下：
Fisher's Exact Test for Count Data
data: x
p-value = 6.971e-14
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
1.202757 1.378612
sample estimates:
odds ratio
1.287236
由于P值=6.971e-14 < 0.05，因此拒绝原假设，即认为受伤情况与是否系安全带有显著关系。由于赔率比大于1，因此还是正相关。
(6)Spearman秩相关检验方法
选取1999年到2008年运动员获世界冠军男女人数数据，检验二者之间是否存在相关关系？
计算结果如下：
Spearman's rank correlation rho
data: x and y
S = 22, p-value = 0.002681
alternative hypothesis: true rho is not equal to 0
sample estimates:
rho
0.8666667
结果显示P值=0.002681 < 0.05，因此拒绝原假设，认为变量X与Y相关，且高度正相关。
(7) 协同性检验（Kendall相关检验）
选取1999年到2008年运动员获世界冠军男女人数数据，试用Kendall检验方法检验二者之间是否存在相关关系？
计算结果如下：
Kendall's rank correlation tau
data: x and y
T = 39, p-value = 0.002213
alternative hypothesis: true tau is not equal to 0
sample estimates:
tau
0.7333333
结果显示P值=0.002681 < 0.05，因此拒绝原假设，认为变量X与Y相关，且高度正相关。
(8) 多总体比较的秩和检验
本案例数据来源于百度文库。
某汽车驾驶员记录了使用5种不同牌子的汽油每5加仑行驶的距离，数据如下：
| 品牌1 | 37.5 | 31.3 | 33.8 | 32.5 |
| 品牌2 | 36.3 | 32.5 | 36.3 | 35.0 |
| 品牌3 | 40 | 40 | 43.8 | 46.3 |
| 品牌4 | 36.3 | 42.5 | 40 | 41.3 |
| 品牌5 | 40 | 32.5 | 38.8 | 33.8 |
这些数据是否说明这5种牌子的汽油每加仑平均行驶距离全相等?
计算结果如下：
Kruskal-Wallis rank sum test
data: x
Kruskal-Wallis chi-squared = 11.996, df = 4, p-value = 0.01738
结果显示P值=0.017 < 0.05，故拒绝原假设，认为这5种牌子的汽油每加仑平均行驶距离不全相等。
(9) 多总体比较的卡方检验
本案例数据来自课后习题
在研究教师的疲劳对教学效果的影响时，有人做了如下实验，让一名教师在一天中对一个班中的三个组教授同一门课程，这三个组是随机划分的，最后的考试成绩为：
| 学生(成绩) | 1 | 2 | 3 |
| 8点上课 | 72 | 84 | 75 |
| 10点上课 | 77 | 67 | 79 |
| 14点上课 | 58 | 78 | 80 |
试问每组间的学生的学习有无显著差异，取显著性水平为0.05。
计算结果如下：
Pearson's Chi-squared test
data: x
X-squared = 4.4667, df = 4, p-value
= 0.3465
结果显示P值=0.3465 > 0.05，故接受原假设，认为每组间的学生的学习无显著差异。
实验项目三
(1)制作数据经验分布函数,使用分布拟合方法解决总体类型的检验问题
本例给出15名学生的体重数据（单位：kg）
| 75.0 | 64.0 | 47.4 | 66.9 | 62.2 |
| 62.2 | 58.7 | 63.5 | 66.6 | 64.0 |
| 57.0 | 69.0 | 56.9 | 50.0 | 72.0 |
绘制出15名学生体重的经验分布图和相应的正态分布图：
绘制出的经验分布图和正态分布曲线：
将学生体重进行排序得：
47.4 50.0 56.9 57.0 58.7 62.2 62.2 63.5 64.0 64.0 66.6 66.9 69.0 72.0 75.0
求得经验分布函数为：
(2) 概率密度图像，使用分布拟合方法解决总体类型的检验问题
绘制出直方图和密度估计曲线和正态分布的概率密度曲线：
通过上图，可以明显看出密度估计曲线和正态分布的概率密度曲线还是有一定的差别的。
实验项目四
通过最小二乘与权函数结合使用的方法解决非线性回归问题
本案例数据来自课后习题
1.一只红铃虫的产卵数与温度有关。下表是产卵数Y与温度X的一组数据，试研究Y与X的回归关系。
| 编号 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |
| 温度x | 21 | 23 | 25 | 27 | 29 | 32 | 25 |
| 产卵数y | 7 | 11 | 21 | 24 | 66 | 115 | 325 |
绘制出散点图：
| X | Y | 线性拟合 | 残差 | 权函数估计 | 混合估计 |
| 21 | 7 | 50.91986 | -43.919861 | -43.919861 | 7 |
| 23 | 11 | 63.06620 | -52.066202 | -52.066202 | 11 |
| 25 | 21 | 75.21254 | -54.212544 | 97.787456 | 173 |
| 27 | 24 | 87.35889 | -63.358885 | -63.358885 | 24 |
| 29 | 66 | 99.50523 | -33.505226 | -33.505226 | 66 |
| 32 | 115 | 117.72474 | -2.724739 | -2.724739 | 115 |
| 25 | 325 | 75.21254 | 249.787456 | 97.787456 | 173 |
解得回归直线方程为：
附录
#非参数统计
#1
data1 <- read.csv("C:\\Users\\Administrator\\Desktop\\运动员.csv",header=T)
cham_num <- data1[,3]
cham_item <- data1[,2]
list("人数排序"=sort(cham_num),"五数总括"=fivenum(cham_num),"分位数"=quantile(cham_num))
x <- cham_item
list("均值"=mean(x),"截尾均值"=mean(cham_num,trim = 0.05))
qj<-function(p,alpha){
n=length(x);
for(i in 1:n){
s1=ppois(i-1,n*p);
s2=ppois(i,n*p); #s1+dpois(i,n*p)
if(s1<=(1-alpha)/2&&s2>(1-alpha)/2) break
}
for(j in n:1){
s3=1-ppois(j,n*p);
s4=1-ppois(j-1,n*p); #s3+dpois(j,n*p)
if(s3<=(1-alpha)/2&&s4>(1-alpha)/2) break
}
dp<-paste("(",i,",",j,")")
ci<-paste("[",sort(x)[i],",",sort(x)[j],"]")
list("数据位置"=dp,"区间估计"=ci)
}
qj(0.5,0.9)
x<-cham_item
y<-cham_num
list("样本均值之差"=mean(y)-mean(x),"样本中位数之差"=median(y)-median(x))
HL<-function(x,y,alpha){
n1<-length(x);
n2<-length(y);
d<-n1*n2/2-sqrt(n1*n2*(n1+n2+1)/12)*qnorm(1-alpha/2);
nn<-c();
for(j in 1:n2){
nn<-c(nn,y[j]-x)
}
d1=floor(d+1);d2=n1*n2-d1;
wz<-paste(c(d1,d2+1))
ci<-paste("[",sort(nn)[d1],",",sort(nn)[d2+1],"]")
list("Yi-Xi数据"=nn,sort(nn),中位数=median(nn),上下界位置=wz,"95%置信区间"=ci)
}
HL(x,y,alpha=0.05)
#2
#中位数检验
sign.test<-function(x, m0, alpha=0.05, alter="two.sided"){
p<-list( )
n<-length(x)
sign<-as.numeric(x>=m0)
s<-sum(sign)
result<-binom.test(s, n, p=0.5, alternative=alter,
conf.level=alpha)
p$p.value=result$p.value
p
}
sign.test(y,155)
#两总体比较的Wilcoxon秩和检验
data2 <- read.csv("C:\\Users\\Administrator\\Desktop\\运动员男女获得世界冠军.csv",header=T)
cham_man <- data2[,2]
cham_woman <- data2[,3]
x<-cham_man
y<-cham_woman
z<-append(x,y)
rxy<-rank(z);rxy
ry<-rank(z)[-c(1:length(x))];ry
jrs<-sum(ry);jrs
r1<-function(m,n,alpha){round(m*(m+n+1)/2-qnorm(1-alpha/2)*sqrt(m*n*(m+n+1)/12))}
r2<-function(m,n,alpha){round(m*(m+n+1)/2+qnorm(1-alpha/2)*sqrt(m*n*(m+n+1)/12))}
list("r1"=r1(10,13,0.05),"r2"=r2(10,13,0.05),"是否落入拒绝域"=l<-r1(10,13,0.05)<jrs&jrs<r2(10,13,0.05)) #是否落入接受域
#两总体比较的K-S检验
ks.test(x,y)
#卡方独立性检验
yesbelt <- c(12813,647,359,42)
nobelt <- c(65963,4000,2642,303)
chisq.test(rbind(yesbelt,nobelt))
#Fisher列联表检验
x <- c(12813,65963,1048,6945);dim(x) <- c(2,2)
fisher.test(x)
#Spearman秩相关检验方法
x<-data2[1:10,2]
y<-data2[1:10,3]
cor.test(x,y,method = "spearman")
#协同性检验（Kendall相关检验）
x<-data2[1:10,2]
y<-data2[1:10,3]
cor.test(x,y,method = "kendall")
#多总体比较的秩和检验
x <- list(
a=c(37.5,31.3,33.8,32.5),
b=c(36.3,32.5,36.3,35.0),
c=c(40,40,43.8,46.3),
d=c(36.3,42.5,40,41.3),
e=c(40,32.5,38.8,33.8)
)
kruskal.test(x)
#多总体比较的卡方检验
x <- c(72,77,58,84,67,78,75,79,80)
dim(x) <- c(3,3)
x
chisq.test(x,correct = FALSE)
#制作数据经验分布函数,使用分布拟合方法解决总体类型的检验问题
w <- c(75,64,47.4,66.9,62.2,62.2,58.7,63.5,66.6,64,57,69,56.9,50,72)
plot(ecdf(w),verticals = TRUE,do.p=FALSE)
x <- 44:78
lines(x,pnorm(x,mean(w),sd(w)))
sort(w)
# 概率密度图像，使用分布拟合方法解决总体类型的检验问题
w
hist(w,freq = F,main="概率密度直方图")
lines(density(w),col="blue")
x<-44:78
lines(x,dnorm(x,mean(w),sd(w)),col="red")
#试研究Y与X的回归关系
x<-c(21,23,25,27,29,32,25)
y<-c(7,11,21,24,66,115,325)
plot(x,y)
ML<-function(x,y,bw){
a<-lm(y~x) #线性拟合但只返回拟合系数用unclass()具体查看
b<-a$fitted.values #提取拟合结果列表
c<-a$residuals #拟合残差结果列表
d<-matrix(c(x,c),nc=2)
e<-c()
for(i in 1:length(x)){
f<-which((d[i,1]-bw)<d[,1]&d[,1]<(d[i,1]+bw))
e<-c(e,mean(d[f,2]))
}
data.frame(X=x,Y=y,线性拟合=b,残差=c,权函数估计=e,混合估计=b+e)
}
ML(x,y,0.5)
a<-{mean(y)*mean(x^2)-mean(x*y)*mean(x)}/{mean(x^2)-mean(x)^2};a
b<-{mean(x*y)-mean(x)*mean(y)}/{mean(x^2)-mean(x)^2};b
2478
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
