统计建模与R软件第三章习题答案(数据描述性分析)

标签:
r |
分类: R |
Ex3.1
新建txt文件如下:3.1.txt
74.3 79.5 75.0 73.5 75.8 74.0 73.5 67.2 75.8 73.5 78.8 75.6 73.5 75.0 75.8
72.0 79.5 76.5 73.5 79.5 68.8 75.0 78.8 72.0 68.8 76.5 73.5 72.7 75.0 70.4
78.0 78.8 74.3 64.3 76.5 74.3 74.7 70.4 72.7 76.5 70.4 72.0 75.8 75.8 70.4
76.5 65.0 77.2 73.5 72.7 80.5 72.0 65.0 80.3 71.2 77.6 76.5 68.8 73.5 77.2
80.5 72.0 74.3 69.7 81.2 67.3 81.6 67.3 72.7 84.3 69.7 74.3 71.2 74.3 75.0
72.0 75.4 67.3 81.6 75.0 71.2 71.2 69.7 73.5 70.4 75.0 72.7 67.3 70.3 76.5
73.5 72.0 68.0 73.5 68.0 74.3 72.7 72.7 74.3 70.4
编写一个函数(程序名为data_outline.R)描述样本的各种描述性统计量。
data_outline<-function(x){
n<-length(x)
m<-mean(x)
v<-var(x)
s<-sd(x)
me<-median(x)
cv<-100*s/m
css<-sum((x-m)^2)
uss<-sum(x^2)
R <- max(x)-min(x)
R1 <-quantile(x,3/4)-quantile(x,1/4)
sm <-s/sqrt(n)
g1 <-n/((n-1)*(n-2))*sum((x-m)^3)/s^3
g2 <-((n*(n+1))/((n-1)*(n-2)*(n-3))*sum((x-m)^4)/s^4-(3*(n-1)^2)/((n-2)*(n-3)))
data.frame(N=n,Mean=m,Var=v,std_dev=s,Median=me,std_mean=sm,CV=cv,CSS=css,USS=uss,R=R,R1=R1,Skewness=g1,Kurtosis=g2,row.names=1)
}
进入R,
source("data_outline.R") #将程序调入内存
serumdata<-scan("3.1.txt");serumdata #将数据读入向量serumdata。
data_outline(serumdata)
结果如下:
N
Mean
Var std_dev Median
std_mean
CV
CSS
USS R
1 100 73.696 15.41675 3.926417 73.5 0.3926417
5.327857 1526.258 544636.3 20
R1
Skewness
Kurtosis
1 4.6 0.03854249 0.07051809
要点:read.table()用于读表格形式的文件。上述形式的数据由于第七行缺几个数据,故用read.table()不能读入。 scan()可以直接读纯文本文件。scan()和matrix()连用还可以将数据存放成矩阵形式。
X<-matrix(scan("3.1.txt",0),ncol=10,byrow=TRUE)
#将上述数据放置成10*10的矩阵。
scan()还可以从屏幕上直接输入数据。
Y<-scan()
然后按提示输入即可。结束输入时按回车即可。
Ex3.2
>hist(serumdata,freq=FALSE,col="purple",border="red",density=3,angle=60,main=paste("the histogram of serumdata"),xlab="age",ylab="frequency")#直方图。col是填充颜色。 默认空白。border是边框的颜色,默认前景色。density是在图上画条纹阴影,默认不画。angle是条纹阴影的倾斜角度(逆时针方向),默认45度。main, xlab, ylab是 标题,x和y坐标轴名称。
>lines(density(serumdata),col="blue")#密度估计曲线。
>x<-64:85
> lines(x,dnorm(x,mean(serumdata),sd(serumdata)),col="green")
#正态分布的概率密度曲线
> plot(ecdf(serumdata),verticals=TRUE,do.p=FALSE) #绘制经验分布图
> lines(x,pnorm(x,mean(serumdata),sd(serumdata)),col="blue") #正态经验分布
> qqnorm(serumdata,col="purple") #绘制QQ图
> qqline(serumdata,col="red") #绘制QQ直线
Ex3.3
> stem(serumdata,scale=1) #作茎叶图。原始数据小数点后数值四舍五入。
The decimal
point is at the |
64 |
300
66 |
23333
68 |
00888777
70 |
34444442222
72 |
0000000777777755555555555
74 |
033333333700000004688888
76 |
5555555226
78 |
0888555
80 |
355266
82
|
84 |
3
>boxplot(serumdata,col="lightblue",notch=T) #作箱线图。notch表示带有缺口。
> fivenum(serumdata) #五数总结
[1] 64.3 71.2 73.5 75.8 84.3
Ex3.4
> shapiro.test(serumdata) #正态性Shapori-Wilk检验方法
Shapiro-Wilk normality test
data:
serumdata
W = 0.9897, p-value = 0.6437
结论:p值>0.05,可认为来自正态分布的总体。
> ks.test(serumdata,"pnorm",mean(serumdata),sd(serumdata)) #Kolmogrov-Smirnov检验,正态性
One-sample Kolmogorov-Smirnov test
data:
serumdata
D = 0.0701, p-value = 0.7097
alternative hypothesis: two-sided
Warning message:
In ks.test(serumdata, "pnorm", mean(serumdata), sd(serumdata)) :
cannot
compute correct p-values with ties
结论:p值>0.05,可认为来自正态分布的总体。
注意,这里的警告信息,是因为数据中有重复的数值,ks检验要求待检数据时连续的,不允许重复值。
Ex3.5
> y<-c(2,4,3,2,4,7,7,2,2,5,4,5,6,8,5,10,7,12,12,6,6,7,11,6,6,7,9,5,5,10,6,3,10) #输入数据
> f<-factor(c(rep(1,11),rep(2,10),rep(3,12))) #因子分类
> plot(f,y,col="lightgreen") #plot()生成箱线图
> x<-c(2,4,3,2,4,7,7,2,2,5,4)
> y<-c(5,6,8,5,10,7,12,12,6,6)
> z<-c(7,11,6,6,7,9,5,5,10,6,3,10)
> boxplot(x,y,z,names=c("1","2","3"),col=c(5,6,7))
#boxplot()生成箱线图
http://s9/middle/681aaa554b821eef04238&690
结论:第2和第3组没有显著差异。第1组合其他两组有显著差异。
Ex3.6
数据太多,懒得录入。离散图应该用plot即可。
Ex3.7
> studata<-read.table("3.7.txt") #读入数据
> data.frame(studata) #转化为数据框
V1
V2 V3 V4
V5
V6
1
1 alice f 13
56.5 84.0
2
2 becka f 13
65.3 98.0
3
3
gail f 14 64.3
90.0
4
4 karen f 12
56.3 77.0
5
5 kathy f 12
59.8 84.5
6
6
mary f 15 66.5 112.0
7
7 sandy f 11
51.3 50.5
8
8 sharon f 15 62.5
112.5
9
9 tammy f 14
62.8 102.5
10 10
alfred m 14 69.0 112.5
11 11
duke m 14 63.5 102.5
12 12 guido m 15
67.0 133.0
13 13 james m 12
57.3 83.0
14 14 jeffery
m 13 62.5 84.0
15 15
john m 12 59.0
99.5
16 16
philip m 16 72.0 150.0
17 17
robert m 12 64.8 128.0
18 18
thomas m 11 57.5
85.0
19 19 william
m 15 66.5 112.0
> names(studata)<-c("stuno","name","sex","age","height","weight"),studata #给各列命名
stuno name
sex age height weight
1
1
alice f
13
56.5 84.0
2
2
becka f
13
65.3 98.0
3
3
gail f
14
64.3 90.0
...
> attach(studata) #将数据框调入内存
> plot(weight~height,col="red") #体重对于身高的散点图
> coplot(weight~height|sex,col="blue") #不同性别,体重与身高的散点图
> coplot(weight~height|age,col="blue") #不同年龄,体重与身高的散点图
> coplot(weight~height|age+sex,col="blue") #不同年龄和性别,体重与身高的散点图
http://s2/middle/681aaa554b821e42ef311&690
Ex3.8
> x<-seq(-2,3,0.05)
> y<-seq(-1,7,0.05)
> f<-function(x,y) x^4-2*x^2*y+x^2-2*x*y+2*y^2+4.5*x-4*y+4
> z<-outer(x,y,f) #必须做外积运算才能绘出三维图形
> contour(x,y,z,levels=c(0,1,2,3,4,5,10,15,20,30,40,50,60,80,100),col="blue") #二维等值线
http://s10/middle/681aaa554b8222fc44939&690
> persp(x,y,z,theta=120,phi=0,expand=0.7,col="lightblue") #三位网格曲面
http://s6/middle/681aaa554b822275db915&690
Ex3.9
> attach(studata)
> cor.test(height,weight) #Pearson相关性检验
Pearson's product-moment correlation
data: height
and weight
t = 7.5549, df = 17, p-value = 7.887e-07
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
0.7044314
0.9523101
sample estimates:
cor
0.8777852
由此可见身高和体重是相关的。
Ex3.10
Ex3.11
上述两题原始数据太多,网上找不到,懒得录入。略。
新建txt文件如下:3.1.txt
74.3 79.5 75.0 73.5 75.8 74.0 73.5 67.2 75.8 73.5 78.8 75.6 73.5 75.0 75.8
72.0 79.5 76.5 73.5 79.5 68.8 75.0 78.8 72.0 68.8 76.5 73.5 72.7 75.0 70.4
78.0 78.8 74.3 64.3 76.5 74.3 74.7 70.4 72.7 76.5 70.4 72.0 75.8 75.8 70.4
76.5 65.0 77.2 73.5 72.7 80.5 72.0 65.0 80.3 71.2 77.6 76.5 68.8 73.5 77.2
80.5 72.0 74.3 69.7 81.2 67.3 81.6 67.3 72.7 84.3 69.7 74.3 71.2 74.3 75.0
72.0 75.4 67.3 81.6 75.0 71.2 71.2 69.7 73.5 70.4 75.0 72.7 67.3 70.3 76.5
73.5 72.0 68.0 73.5 68.0 74.3 72.7 72.7 74.3 70.4
编写一个函数(程序名为data_outline.R)描述样本的各种描述性统计量。
data_outline<-function(x){
n<-length(x)
m<-mean(x)
v<-var(x)
s<-sd(x)
me<-median(x)
cv<-100*s/m
css<-sum((x-m)^2)
uss<-sum(x^2)
R <- max(x)-min(x)
R1 <-quantile(x,3/4)-quantile(x,1/4)
sm <-s/sqrt(n)
g1 <-n/((n-1)*(n-2))*sum((x-m)^3)/s^3
g2 <-((n*(n+1))/((n-1)*(n-2)*(n-3))*sum((x-m)^4)/s^4-(3*(n-1)^2)/((n-2)*(n-3)))
data.frame(N=n,Mean=m,Var=v,std_dev=s,Median=me,std_mean=sm,CV=cv,CSS=css,USS=uss,R=R,R1=R1,Skewness=g1,Kurtosis=g2,row.names=1)
}
进入R,
source("data_outline.R") #将程序调入内存
serumdata<-scan("3.1.txt");serumdata #将数据读入向量serumdata。
data_outline(serumdata)
结果如下:
1 100 73.696 15.41675 3.926417
1 4.6 0.03854249 0.07051809
要点:read.table()用于读表格形式的文件。上述形式的数据由于第七行缺几个数据,故用read.table()不能读入。 scan()可以直接读纯文本文件。scan()和matrix()连用还可以将数据存放成矩阵形式。
scan()还可以从屏幕上直接输入数据。
Ex3.2
>hist(serumdata,freq=FALSE,col="purple",border="red",density=3,angle=60,main=paste("the histogram of serumdata"),xlab="age",ylab="frequency")#直方图。col是填充颜色。 默认空白。border是边框的颜色,默认前景色。density是在图上画条纹阴影,默认不画。angle是条纹阴影的倾斜角度(逆时针方向),默认45度。main, xlab, ylab是 标题,x和y坐标轴名称。
>lines(density(serumdata),col="blue")#密度估计曲线。
>x<-64:85
> lines(x,dnorm(x,mean(serumdata),sd(serumdata)),col="green")
> plot(ecdf(serumdata),verticals=TRUE,do.p=FALSE) #绘制经验分布图
> lines(x,pnorm(x,mean(serumdata),sd(serumdata)),col="blue") #正态经验分布
> qqnorm(serumdata,col="purple") #绘制QQ图
> qqline(serumdata,col="red") #绘制QQ直线
Ex3.3
> stem(serumdata,scale=1) #作茎叶图。原始数据小数点后数值四舍五入。
>boxplot(serumdata,col="lightblue",notch=T) #作箱线图。notch表示带有缺口。
> fivenum(serumdata) #五数总结
[1] 64.3 71.2 73.5 75.8 84.3
Ex3.4
> shapiro.test(serumdata) #正态性Shapori-Wilk检验方法
data:
W = 0.9897, p-value = 0.6437
结论:p值>0.05,可认为来自正态分布的总体。
> ks.test(serumdata,"pnorm",mean(serumdata),sd(serumdata)) #Kolmogrov-Smirnov检验,正态性
data:
D = 0.0701, p-value = 0.7097
alternative hypothesis: two-sided
Warning message:
In ks.test(serumdata, "pnorm", mean(serumdata), sd(serumdata)) :
结论:p值>0.05,可认为来自正态分布的总体。
注意,这里的警告信息,是因为数据中有重复的数值,ks检验要求待检数据时连续的,不允许重复值。
Ex3.5
> y<-c(2,4,3,2,4,7,7,2,2,5,4,5,6,8,5,10,7,12,12,6,6,7,11,6,6,7,9,5,5,10,6,3,10) #输入数据
> f<-factor(c(rep(1,11),rep(2,10),rep(3,12))) #因子分类
> plot(f,y,col="lightgreen") #plot()生成箱线图
> x<-c(2,4,3,2,4,7,7,2,2,5,4)
> y<-c(5,6,8,5,10,7,12,12,6,6)
> z<-c(7,11,6,6,7,9,5,5,10,6,3,10)
> boxplot(x,y,z,names=c("1","2","3"),col=c(5,6,7))
http://s9/middle/681aaa554b821eef04238&690
结论:第2和第3组没有显著差异。第1组合其他两组有显著差异。
Ex3.6
数据太多,懒得录入。离散图应该用plot即可。
Ex3.7
> studata<-read.table("3.7.txt") #读入数据
> data.frame(studata) #转化为数据框
1
2
3
4
5
6
7
8
9
10 10
11 11
12 12
13 13
14 14 jeffery
15 15
16 16
17 17
18 18
19 19 william
> names(studata)<-c("stuno","name","sex","age","height","weight"),studata #给各列命名
1
2
3
...
> attach(studata) #将数据框调入内存
> plot(weight~height,col="red") #体重对于身高的散点图
> coplot(weight~height|sex,col="blue") #不同性别,体重与身高的散点图
> coplot(weight~height|age,col="blue") #不同年龄,体重与身高的散点图
> coplot(weight~height|age+sex,col="blue") #不同年龄和性别,体重与身高的散点图
http://s2/middle/681aaa554b821e42ef311&690
Ex3.8
> x<-seq(-2,3,0.05)
> y<-seq(-1,7,0.05)
> f<-function(x,y) x^4-2*x^2*y+x^2-2*x*y+2*y^2+4.5*x-4*y+4
> z<-outer(x,y,f) #必须做外积运算才能绘出三维图形
> contour(x,y,z,levels=c(0,1,2,3,4,5,10,15,20,30,40,50,60,80,100),col="blue") #二维等值线
http://s10/middle/681aaa554b8222fc44939&690
> persp(x,y,z,theta=120,phi=0,expand=0.7,col="lightblue") #三位网格曲面
http://s6/middle/681aaa554b822275db915&690
Ex3.9
> attach(studata)
> cor.test(height,weight) #Pearson相关性检验
data:
t = 7.5549, df = 17, p-value = 7.887e-07
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
sample estimates:
0.8777852
由此可见身高和体重是相关的。
Ex3.10
Ex3.11
上述两题原始数据太多,网上找不到,懒得录入。略。
前一篇:linux下R绘图