非参数统计分析

实验内容及要求

1. 利用观测数据计算总体分位数、对称中心和位置差的点估计，区间估计；
2. 利用R软件自带程序或自编程序完成中位数的符号检验，两总体比较的Wilcoxon秩和检验和K-S检验，独立性与随机性的卡方检验和Fisher列联表检验，相关性秩检验与协同性检验以及多总体比较的秩和检验和卡方检验；
3. 制作数据经验分布函数、概率密度图像，使用分布拟合方法解决总体类型的检验问题；
4. 通过最小二乘与权函数结合使用的方法解决非线性回归问题；

 

 

本文中国运动员获世界冠军实验项目数据来源于国家数据网站：

http://data.stats.gov.cn/easyquery.htm?cn=C01

实验项目一

项目一收集1999年至2017年中国运动员获世界冠军的项数（单位：项）和人数（单位：人）。

年份 获世界冠军项数 获世界冠军人数 男子世界冠军人数 女子世界冠军人数 1999年 91 129 57 72 2000年 92 109 49 60 2001年 79 138 61 77 2002年 99 123 42 81 2003年 17 94 31 63 2004年 27 175 77 98 2005年 22 159 70 89 2006年 24 169 82 87 2007年 22 217 94 123 2008年 24 151 68 83 2009年 30 223 89   2010年 22 180 99   2011年 24 198 96   2012年 24 140     2013年 22 164     2014年 22 206     2015年 25 214     2016年 23 154     2017年 24 248

 

(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)

 

#两总体比较的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)

     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