ImageVerifierCode 换一换
格式:DOC , 页数:43 ,大小:87.51KB ,
资源ID:7985454      下载积分:10 金币
快捷注册下载
登录下载
邮箱/手机:
温馨提示:
快捷下载时,用户名和密码都是您填写的邮箱或者手机号,方便查询和重复下载(系统自动生成)。 如填写123,账号就是123,密码也是123。
特别说明:
请自助下载,系统不会自动发送文件的哦; 如果您已付费,想二次下载,请登录后访问:我的下载记录
支付方式: 支付宝    微信支付   
验证码:   换一换

开通VIP
 

温馨提示:由于个人手机设置不同,如果发现不能下载,请复制以下地址【https://www.zixin.com.cn/docdown/7985454.html】到电脑端继续下载(重复下载【60天内】不扣币)。

已注册用户请登录:
账号:
密码:
验证码:   换一换
  忘记密码?
三方登录: 微信登录   QQ登录  

开通VIP折扣优惠下载文档

            查看会员权益                  [ 下载后找不到文档?]

填表反馈(24小时):  下载求助     关注领币    退款申请

开具发票请登录PC端进行申请

   平台协调中心        【在线客服】        免费申请共赢上传

权利声明

1、咨信平台为文档C2C交易模式,即用户上传的文档直接被用户下载,收益归上传人(含作者)所有;本站仅是提供信息存储空间和展示预览,仅对用户上传内容的表现方式做保护处理,对上载内容不做任何修改或编辑。所展示的作品文档包括内容和图片全部来源于网络用户和作者上传投稿,我们不确定上传用户享有完全著作权,根据《信息网络传播权保护条例》,如果侵犯了您的版权、权益或隐私,请联系我们,核实后会尽快下架及时删除,并可随时和客服了解处理情况,尊重保护知识产权我们共同努力。
2、文档的总页数、文档格式和文档大小以系统显示为准(内容中显示的页数不一定正确),网站客服只以系统显示的页数、文件格式、文档大小作为仲裁依据,个别因单元格分列造成显示页码不一将协商解决,平台无法对文档的真实性、完整性、权威性、准确性、专业性及其观点立场做任何保证或承诺,下载前须认真查看,确认无误后再购买,务必慎重购买;若有违法违纪将进行移交司法处理,若涉侵权平台将进行基本处罚并下架。
3、本站所有内容均由用户上传,付费前请自行鉴别,如您付费,意味着您已接受本站规则且自行承担风险,本站不进行额外附加服务,虚拟产品一经售出概不退款(未进行购买下载可退充值款),文档一经付费(服务费)、不意味着购买了该文档的版权,仅供个人/单位学习、研究之用,不得用于商业用途,未经授权,严禁复制、发行、汇编、翻译或者网络传播等,侵权必究。
4、如你看到网页展示的文档有www.zixin.com.cn水印,是因预览和防盗链等技术需要对页面进行转换压缩成图而已,我们并不对上传的文档进行任何编辑或修改,文档下载后都不会有水印标识(原文档上传前个别存留的除外),下载后原文更清晰;试题试卷类文档,如果标题没有明确说明有答案则都视为没有答案,请知晓;PPT和DOC文档可被视为“模板”,允许上传人保留章节、目录结构的情况下删减部份的内容;PDF文档不管是原文档转换或图片扫描而得,本站不作要求视为允许,下载前可先查看【教您几个在下载文档中可以更好的避免被坑】。
5、本文档所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用;网站提供的党政主题相关内容(国旗、国徽、党徽--等)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。
6、文档遇到问题,请及时联系平台进行协调解决,联系【微信客服】、【QQ客服】,若有其他问题请点击或扫码反馈【服务填表】;文档侵犯商业秘密、侵犯著作权、侵犯人身权等,请点击“【版权申诉】”,意见反馈和侵权处理邮箱:1219186828@qq.com;也可以拔打客服电话:0574-28810668;投诉电话:18658249818。

注意事项

本文(统计建模与R软件课后答案.doc)为本站上传会员【pc****0】主动上传,咨信网仅是提供信息存储空间和展示预览,仅对用户上传内容的表现方式做保护处理,对上载内容不做任何修改或编辑。 若此文所含内容侵犯了您的版权或隐私,请立即通知咨信网(发送邮件至1219186828@qq.com、拔打电话4009-655-100或【 微信客服】、【 QQ客服】),核实后会尽快下架及时删除,并可随时和客服了解处理情况,尊重保护知识产权我们共同努力。
温馨提示:如果因为网速或其他原因下载失败请重新下载,重复下载【60天内】不扣币。 服务填表

统计建模与R软件课后答案.doc

1、第二章 2.1 > x<-c(1,2,3);y<-c(4,5,6) > e<-c(1,1,1) > z<-2*x+y+e;z [1] 7 10 13 > z1<-crossprod(x,y);z1 [,1] [1,] 32 > z2<-outer(x,y);z2 [,1] [,2] [,3] [1,] 4 5 6 [2,] 8 10 12 [3,] 12 15 18 2.2 (1) > A<-matrix(1:20,nrow=4);B<-matrix(1:20,nrow=4,byrow=T)

2、> C<-A+B;C (2) > D<-A%*%B;D (3) > E<-A*B;E (4) > F<-A[1:3,1:3] (5) > G<-B[,-3] 2.3 > x<-c(rep(1,5),rep(2,3),rep(3,4),rep(4,2));x 2.4 > H<-matrix(nrow=5,ncol=5) > for (i in 1:5) + for(j in 1:5) + H[i,j]<-1/(i+j-1) (1)> det(H) (2)> solve(H) (3)> eigen(H) 2.5 > studentdata<-data.frame(

3、姓名=c('张三','李四','王五','赵六','丁一') + ,性别=c('女','男','女','男','女'),年龄=c('14','15','16','14','15'), + 身高=c('156','165','157','162','159'),体重=c('42','49','41.5','52','45.5')) 2.6 > write.table(studentdata,file='student.txt') > write.csv(studentdata,file='student.csv') 2.7 count<-function(n) { if (n<

4、0) print('要求输入一个正整数') else{ repeat{ if (n%%2==0) n<-n/2 else n<-(3*n+1) if(n==1)break } print('运算成功')} } 第三章 3.1 首先将数据录入为x。利用data_outline函数。如下 > data_outline(x) 3.2 > hist(x,freq=F) > lines(density(x),col='red') > y<-min(x):max(x) > lines(y,dnorm(y,73.668,3.9389),col='blue') >

5、plot(ecdf(x),verticals=T,do.p=F) > lines(y,pnorm(y,73.668,3.9389)) > qqnorm(x) > qqline(x) 3.3 > stem(x) > boxplot(x) > fivenum(x) 3.4 > shapiro.test(x) > ks.test(x,'pnorm',73.668,3.9389) One-sample Kolmogorov-Smirnov test data: x D = 0.073, p-value = 0.6611 alternative hy

6、pothesis: two-sided Warning message: In ks.test(x, "pnorm", 73.668, 3.9389) : ties should not be present for the Kolmogorov-Smirnov test 这里出现警告信息是因为ks检验要求样本数据是连续的,不允许出现重复值 3.5 >x1<-c(2,4,3,2,4,7,7,2,2,5,4);x2<-c(5,6,8,5,10,7,12,12,6,6);x3<-c(7,11,6,6,7,9,5,5,10,6,3,10) > boxplot(x1,x2,x

7、3,names=c('x1','x2','x3'),vcol=c(2,3,4)) >windows() >plot(factor(c(rep(1,length(x1)),rep(2,length(x2)),rep(3,length(x3)))),c(x1,x2,x3)) 3.6 > rubber<-data.frame(x1=c(65,70,70,69,66,67,68,72,66,68), +x2=c(45,45,48,46,50,46,47,43,47,48),x3=c(27.6,30.7,31.8,32.6,31.0,31.3,37.0,33.6,33.1,34.2)) >

8、plot(rubber) 具体有相关关系的两个变量的散点图要么是从左下角到右上角(正相关),要么是从左上角到右下角(负相关)。从上图可知所有的图中偶读没有这样的趋势,故均不相关。 3.7 (1)> student<-read.csv('3.7.csv') > attach(student) > plot(体重~身高) (2)> coplot(体重~身高|性别) (3)> coplot(体重~身高|年龄) (4)> coplot(体重~身高|年龄+性别) 只列出(4)的结果,如下图 3.8 > x<-seq(-2,3,0.5);y<-seq(-1,7,0.5)

9、 > f<-function(x,y) + x^4-2*x^2*y+x^2-2*x*y+2*y^2+9*x/2-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') > windows() > persp(x,y,z,theta=30,phi=30,expand=0.7,col='red') 3.9 > cor.test(身高,体重) 根据得出的结果看是相关的。具体结果不再列出 3.10 > df<-read.csv('48名求

10、职者得分.csv') > stars(df) 然后按照G的标准来画出星图 > attach(df) > df$G1<-(SC+LC+SMS+DRV+AMB+GSP+POT)/7 > df$G2<-(FL+EXP+SUIT)/3 > df$G3<-(LA+HON+KJ)/3 > df$G4<-AA > df$G5<-APP > a<-scale(df[,17:21]) > stars(a) 这里从17开始取,是因为在df中将ID也作为了一列 3.11 使用P159已经编好的函数unison,接着上题,直接有 > unison(a) 第四章 4.1 (1)先求

11、矩估计。 总体的期望为。因此我们有。可解得a=(2*E(x)-1)/(1-E(x)).因此我们用样本的均值来估计a即可。在R中实现如下 > x<-c(0.1,0.2,0.9,0.8,0.7,0.7) > (2*mean(x)-1)/(1-mean(x)) [1] 0.3076923 (2)采用极大似然估计 首先求出极大似然函数为 La;x=i=1na+1xia=(a+1)ni=1nxia 再取对数为 lnLa;x=nlna+1+aln(i=1nxi 最后求导 ∂lnL(a;x)∂a=na+1+lni=1nxi 好了下面开始用R编程求解,注意此题中n=6. 方法一、

12、使用unniroot函数 > f<-function(a) 6/(a+1)+sum(log(x)) > uniroot(f,c(0,1)) 方法二、 使用optimize函数 > g<-function(a) 6*log(a+1)+a*sum(log(x)) > optimize(g,c(0,1),maximum=T) 4.2 用极大似然估计得出λ=n/i=1nxi.现用R求解如下 >x<-c(rep(5,365),rep(15,245),rep(25,150),rep(35,100),rep(45,70),rep(55,45),rep(65,25)) > 1000/sum

13、x) 4.3 换句话讲,就是用该样本来估计泊松分布中的参数,然后求出该分布的均值。我们知道泊松分布中的参数λ,既是均值又是方差。因此我们只需要用样本均值作矩估计即可 在R中实现如下 > x<-c(rep(0,17),rep(1,20),rep(2,10),rep(3,2),rep(4,1)) > mean(x) [1] 1 4.4 > f<-function(x) { +obj<-c(-13+x[1]+((5-x[2])*x[2]-2)*x[2],(-29+x[1]+((x[2]+1)*x[2]-14)*x[2])) + sum(obj^2)} > nlm(f,c(0.

14、5,-2)) 4.5 在矩估计中,正态分布总体的均值用样本的均值估计。故在R中实现如下 > x<-c(54,67,68,78,70,66,67,70,65,69) > mean(x) [1] 67.4 然后用t.test作区间估计,如下 > t.test(x) > t.test(x,alternative='less') > t.test(x,alternative='greater') 此时我们只需要区间估计的结果,所以我们只看t.test中的关于置信区间的输出即可。t.test同时也给出均值检验的结果,但是默认mu=0 并不是我们想要的。下面我们来做是否低于72的均值

15、假设检验。如下 > t.test(x,alternative='greater',mu=72) One Sample t-test data: x t = -2.4534, df = 9, p-value = 0.9817 alternative hypothesis: true mean is greater than 72 95 percent confidence interval: 63.96295 Inf sample estimates: mean of x 67.4 结果说明:我们的备择假设是比72要大,但是p值为0.9817,所

16、以我们不接受备择假设,接受原假设比72小。因此这10名患者的平均脉搏次数比正常人要小。 4.6 我们可以用两种方式来做一做 > x<-c(140,137,136,140,145,148,140,135,144,141) > y<-c(135,118,115,140,128,131,130,115,131,125) > t.test(x,y,var.equal=T) > t.test(x-y) 结果不再列出,但是可以发现用均值差估计和配对数据估计的结果的数值有一点小小的差别。但得出的结论是不影响的(他们的期望差别很大) 4.7 > A<-c(0.143,0.142,0.143,

17、0.137) > B<-c(0.140,0.142,0.136,0.138,0.140) > t.test(A,B) 4.8 > x<-c(140,137,136,140,145,148,140,135,144,141) > y<-c(135,118,115,140,128,131,130,115,131,125) > var.test(x,y) > t.test(x,y,var.equal=F) 4.9 泊松分布的参数就等于它的均值也等于方差。我们直接用样本均值来估计参数即可,然后作样本均值0.95的置信区间即可。 > x<-c(rep(0,7),rep(1,10),re

18、p(2,12),rep(3,8),rep(4,3),rep(5,2)) > mean(x) [1] 1.904762 > t.test(x) 4.10 正态总体均值用样本均值来估计。故如下 > x<-c(1067,919,1196,785,1126,936,918,1156,920,948) > t.test(x,alternative='greater') 注意greater才是求区间下限的(都比它大的意思嘛) 第五章 5.1 这是一个假设检验问题,即检验油漆作业工人的血小板的均值是否为225.在R中实现如下 > x<-scan() 1: 220 188 162

19、 230 145 160 238 188 247 113 11: 126 245 164 231 256 183 190 158 224 175 21: Read 20 items > t.test(x,mu=225) 5.2 考察正态密度函数的概率在R中的计算。首先我们要把该正态分布的均值和方差给估计出来,这个就利用样本即可。然后用pnorm函数来计算大于1000的概率。如下 > x<-c(1067,919,1196,785,1126,936,918,1156,920,948) > pnorm(1000,mean(x),sd(x)) [1] 0.5087941 > 1

20、0.5087941 [1] 0.4912059 5.3 这是检验两个总体是否存在差异的问题。可用符号检验和wilcoxon秩检验。两种方法实现如下 > x<-c(113,120,138,120,100,118,138,123) > y<-c(138,116,125,136,110,132,130,110) > binom.test(sum(x wilcox.test(x,y,exact=F) p-value = 0.792 可见无论哪种方法P值都大于0.05,故接受原假设,他们无差异 5.4 (1)采用w检验法

21、 >x<-c(-0.7,-5.6,2,2.8,0.7,3.5,4,5.8,7.1,-0.5,2.5,-1.6,1.7,3,0.4,4.5,4.6,2.5,6,-1.4) >y<-c(3.7,6.5,5,5.2,0.8,0.2,0.6,3.4,6.6,-1.1,6,3.8,2,1.6,2,2.2,1.2,3.1,1.7,-2) > shapiro.test(x) > shapiro.test(y) 采用ks检验法 > ks.test(x,'pnorm',mean(x),sd(x)) > ks.test(y,'pnorm',mean(y),sd(y)) 采用pearson拟合优度法对

22、x进行检验 > A<-table(cut(x,br=c(-2,0,2,4,6,8))) > A (-2,0] (0,2] (2,4] (4,6] (6,8] 4 4 6 4 1 发现A中有频数小于5,故应该重新调整分组 > A<-table(cut(x,br=c(-2,2,4,8))) > A (-2,2] (2,4] (4,8] 8 6 5 然后再计算理论分布 > p<-pnorm(c(-2,2,4,8),mean(x),sd(x)) > p<-c(p[2],p[3]-p[2],1-p[

23、3]) 最后检验 > chisq.test(A,p=p) 采用pearson拟合优度法对y进行检验 > B<-table(cut(y,br=c(-2.1,1,2,4,7))) > B (-2.1,1] (1,2] (2,4] (4,7] 5 5 5 5 > p<-pnorm(c(1,2,4),mean(y),sd(y)) > p<-c(p[1],p[2]-p[1],p[3]-p[2],1-p[3]) > chisq.test(B,p=p) 以上的所有结果都不再列出,结论是试验组和对照组都是来自正态分布。

24、2)> t.test(x,y,var.equal=F) > t.test(x,y,var.equal=T) > t.test(x,y,paired=T) 结论是均值无差异 (3)> var.test(x,y) 结论是方差相同 由以上结果可以看出这两种药的效果并无二致 5.5 (1)对新药组应用chisq.test检验(也可用ke.test检验) > x<-c(126,125,136,128,123,138,142,116,110,108,115,140) > y<-c(162,172,177,170,175,152,157,159,160,162) > p<-pno

25、rm(c(105,125,145),mean(x),sd(x)) > p<-c(p[2],1-p[2]) > chisq.test(A,p=p) 对对照组用ks.test检验 > ks.test(y,'pnorm',mean(y),sd(y)) 结论是他们都服从正态分布 (2)> var.test(x,y) 结论是方差相同 (3)> wilcox.test(x,y,exact=F) 结果是有差别 5.6 明显是要检验二项分布的p值是否为0.147.R实现如下 > binom.test(57,400,p=0.147) 结果是支持 5.7 也就是检验二项分布中的p值是

26、否大于0.5 > binom.test(178,328,p=0.5,alternative='greater') 结果是不能认为能增加比例 5.8 就是检验你的样本是否符合那个分布 > chisq.test(c(315,101,108,32),p=c(9,3,3,1)/16) 结果显示符合自由组合规律 5.9 又是检验一个总体是否符合假定分布。 > x<-0:5;y<-c(92,68,28,11,1,0) > z<-rep(x,y) > A<-table(cut(z,br=c(-1,0,1,2,5))) > q<-ppois(c(0,1,2,5),mean(z)) >

27、 p<-c(q[1],q[2]-q[1],q[3]-q[2],1-q[3]) > chisq.test(A,p=p) 结论是符合泊松分布 5.10 > x<-c(2.36,3.14,7.52,3.48,2.76,5.43,6.54,7.41) > y<-c(4.38,4.25,6.53,3.28,7.21,6.55) > ks.test(x,y) 5.11 即列联表的的独立性检验 > x<-c(358,229,2492,2754) > dim(x)<-c(2,2) > chisq.test(x)或> fisher.test(x) 结论是有影响 5.12 > x<-c

28、45,12,10,46,20,28,28,23,30,11,12,35) > dim(x)<-c(4,3) > chisq.test(x) 结果是相关 5.13 > x<-c(3,4,6,4) > dim(x)<-c(2,2) > fisher.test(x) 结果显示工艺对产品质量无影响 5.14 即检验两种研究方法是否有差异 > x<-c(58,2,3,1,42,7,8,9,17) > dim(x)<-c(3,3) > mcnemar.test(x,correct=F) 结果表明两种检测方法有差异 5.15 > x<-c(13.32,13.06,14.02

29、11.86,13.58,13.77,13.51,14.42,14.44,15.43) > binom.test(sum(x>14.6),length(x),al='l') > wilcox.test(x,mu=14.6,al='l',exact=F) 结果表明是在中位数之下 5.16 (1)(2)(3) > x<-scan() 1: 48.0 33.0 37.5 48.0 42.5 40.0 42.0 36.0 11.3 22.0 11: 36.0 27.3 14.2 32.1 52.0 38.0 17.3 20.0 21.0 46.1 21: Read 20 item

30、s > y<-scan() 1: 37.0 41.0 23.4 17.0 31.5 40.0 31.0 36.0 5.7 11.5 11: 21.0 6.1 26.5 21.3 44.5 28.0 22.6 20.0 11.0 22.3 21: Read 20 items > binom.test(sum(x wilcox.test(x,y,paired=T,exact=F) > wilcox.test(x,y,exact=F) (4)> ks.test(x,'pnorm',mean(x),sd(x)) > ks.test(y,'pnorm

31、',mean(y),sd(y)) > var.test(x,y) 由以上检验可知数据符合正态分布且方差相同,故可做t检验 > t.test(x,y) 可以发现他们的均值是有差别的 (5)综上所述,Wilcoxon符号秩检验的差异检出能力最强,符号检验的差异检出最弱。 5.17 > x<-c(24,17,20,41,52,23,46,18,15,29) > y<-c(8,1,4,7,9,5,10,3,2,6) > cor.test(x,y,method='spearman') > cor.test(x,y,method='kendall') 有关系的 5.18 > x<

32、1:5 > y<-c(rep(x,c(0,1,9,7,3))) > z<-c(rep(x,c(2,2,11,4,1))) > wilcox.test(y,z,exact=F) 结果显示这两种疗法没什么区别 第六章 6.1 (1)> snow<-data.frame(X=c(5.1,3.5,7.1,6.2,8.8,7.8,4.5,5.6,8.0,6.4), + Y=c(1907,1287,2700,2373,3260,3000,1947,2273,3113,2493)) > plot(snow$X,snow$Y) 结论是有线性关系的。 (2)(3) > lm.sol

33、<-lm(Y~1+X,data=snow);summary(lm.sol) 结果是方程是显著的 (4)> predict(lm.sol,data.frame(X=7),interval='prediction',level=0.95) fit lwr upr 1 2690.227 2454.971 2925.484 6.2 (1)(2) > soil<-data.frame(X1=c(0.4,0.4,3.1,0.6,4.7,1.7,9.4,10.1,11.6,12.6, + 10.9,23.1,23.1,21.6,23.1,1.9,26.8

34、29.9),X2=c(52,23,19,34,24,65,44,31, + 29,58,37,46,50,44,56,36,58,51),X3=c(158,163,37,157,59,123,46,117, + 173,112,111,114,134,73,168,143,202,124),Y=c(64,60,71,61,54,77,81, + 93,93,51,76,96,77,93,95,54,168,99)) > lm.sol<-lm(Y~1+X1+X2+X3,data=soil);summary(lm.sol) 我们发现X2和X3的系数没有通过t检验。但是整个方程通过了检验

35、 (3)> lm.ste<-step(lm.sol) > summary(lm.ste) 可以发现新模型只含有X1和X3,但是X3的系数还是不显著。接下来考虑用drop1函数处理 > drop1(lm.ste) 发现去掉X3残差升高最小,AIC只是有少量增加。因此应该去掉X3 > lm.new<-lm(Y~X1,data=soil);summary(lm.new) 此时发现新模型lm.new系数显著且方程显著 6.3 (1)> da<-data.frame(X=c(1,1,1,1,2,2,2,3,3,3,4,4,4,5,6,6,6,7,7,7,8,8,8, + 9,11

36、12,12,12),Y=c(0.6,1.6,0.5,1.2,2.0,1.3,2.5,2.2,2.4,1.2,3.5,4.1, + 5.1,5.7,3.4,9.7,8.6,4.0,5.5,10.5,17.5,13.4,4.5,30.4,12.4,13.4, + 26.2,7.4)) > plot(da$X,da$Y) > lm.sol<-lm(Y~X,data=da) > abline(lm.sol) (2)> summary(lm.sol) 全部通过 (3)> plot(lm.sol,1) > windows() > plot(lm.sol,3) 可以观察到误差符合等方

37、差的。但是有残差异常值点24,27,28. (4)> lm.up<-update(lm.sol,sqrt(.)~.) > summary(lm.up) 都通过检验 > plot(da$X,da$Y) > abline(lm.up) > windows() > plot(lm.up,1) > windows() > plot(lm.up,3) 可以发现还是有残差离群值24,28 6.4 > lm.sol<-lm(Y~1+X1+X2,data=toothpaste);summary(lm.sol) > influence.measures(lm.sol) > plot(

38、lm.sol,3) 通过influence.measures函数发现5,8,9,24对样本影响较大,可能是异常值点,而通过残差图发现5是残差离群点,但是整个残差还是在[-2,2]之内的。因此可考虑剔除5,8,9,24点再做拟合。 > lm.new<-lm(Y~1+X1+X2,data=toothpaste,subset=c(-5,-8,-9,-24)) > windows() > plot(lm.new,3) > summary(lm.new) 我们发现lm.new模型的残差都控制在[-1.5,1.5]之内,而且方程系数和方程本身也都通过检验。 6.5 > cement<-da

39、ta.frame(X1=c(7,1,11,11,7,11,3,1,2,21,1,11,10), + X2=c(26,29,56,31,52,55,71,31,54,47,40,66,68), + X3=c(6,15,8,8,6,9,17,22,18,4,23,9,8), + X4=c(60,52,20,47,33,22,6,44,22,26,34,12,12), +Y=c(78.5,74.3,104.3,87.6,95.9,109.2,102.7,72.5,93.1,115.9,83.8,113.3,109.4)) > XX<-cor(cement[1:4]) > kappa(XX

40、exact=T) [1] 1376.881 > eigen(XX) 发现变量的多重共线性很强,且有 0.241X1+0.641X2+0.268X3+0.676X4=0 说明X1,X2,X3,X4多重共线。其实逐步回归可以解决多重共线的问题。我们可以检验一下step函数去掉变量后的共线性。step去掉了X3和X4。我们看看去掉他们的共线性如何。 > XX<-cor(cement[1:2]) > kappa(XX,exact=T) [1] 1.59262 我们发现去掉X3和X4后,条件数降低好多好多。说明step函数是合理的。 6.6 首先得把这个表格看懂。里面的数字应该是

41、有感染和无感染的人数。 而影响变量有三个。我们把这些影响变量进行编码。如下。 发生 不发生 抗生素X1 2 3 危险因子X2 4 5 有无计划X3 6 7 是否感染Y 1 0 对数据的处理,如下 X1 X2 X3 Y 频数 2 4 6 1 1 2 4 6 0 17 2 5 6 1 0 2 5 6 0 2 2 4 7 1 11 2 4 7 0 87 2 5 7 1 0 2 5 7 0 0 3 4 6 1 28 3 4 6 0 30 3 4 7

42、1 23 3 4 7 0 3 3 5 6 1 8 3 5 6 0 32 3 5 7 1 0 3 5 7 0 9 然后用R处理并求解模型 >hospital<-data.frame(X1=rep(c(2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3),c(1,17,0,2,11,87, + 0,0,28,30,23,3,8,32,0,9)),X2=rep(c(4,4,5,5,4,4,5,5,4,4,4,4,5,5,5,5), + c(1,17,0,2,11,87, + 0,0,28,30,23,3,8,32,0,9))

43、X3=rep(c(6,6,6,6,7,7,7,7,6,6,7,7,6,6,7,7), + c(1,17,0,2,11,87,0,0,28,30,23,3,8,32,0,9)), + Y=rep(c(1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0),c(1,17,0,2,11,87,0,0,28,30,23,3,8,32,0,9)) + ) > glm.sol<-glm(Y~X1+X2+X3,family=binomial,data=hospital) > summary(glm.sol) 可以发现如果显著性为0.1,则方程的系数和方程本省全部通过检验。 下面我

44、们来做一个预测,看看(使用抗生素,有危险因子,有计划)的一个孕妇发生感染的概率是多少。 > pre<-predict(glm.sol,data.frame(X1=2,X2=4,X3=6)) > p<-exp(pre)/(1+exp(pre));p 1 0.04240619 即感染的概率为4.2% 6.7 (1)> cofe<-data.frame(X=c(0,0,1,1,2,2,3,3,4,4,5,5,6,6),Y=c(508.1,498.4, +568.2,577.3,651.7,657,713.4,697.5,755.3,758.9,787.6,792.

45、1,841.4,831.8)) > lm.sol<-lm(Y~X,data=cofe) > summary(lm.sol) (2)> lm.s2<-lm(Y~X+I(X^2),data=cofe) > summary(lm.s2) (3)> plot(cofe$X,cofe$Y) > abline(lm.sol) > windows() > plot(cofe$X,cofe$Y) > lines(spline(cofe$X,fitted(lm.s2))) 6.8 (1)> pe<-read.csv('6.8.csv',header=T) > glm.sol<-glm(Y

46、~X1+X2+X3+X4+X5,family=binomial,data=pe) > summary(glm.sol) 可以发现各变量影响基本都不显著,甚至大部分还没通过显著性检验。 只有X1的系数通过了显著性检验,但是也不是很理想。下面计算每一个病人的生存时间大于200天的概率值。 >pre<-predict(glm.sol,data.frame(X1=pe$X1,X2=pe$X2,X3=pe$X3,X4=pe$X4,X5=pe$X5)) > p<-exp(pre)/(1+exp(pre)) > p (2)> lm.ste<-step(glm.sol) 结果是只保留了变量X1

47、和X4。 避免了多重共线性。更加合理一些。下面计算各个病人的存活概率。 >pre<-predict(lm.ste,data.frame(X1=pe$X1,X2=pe$X2,X3=pe$X3,X4=pe$X4,X5=pe$X5)) > p.new<-exp(pre)/(1+exp(pre)) > p.new 显然经过逐步回归后的模型更合理。用summary(lm.ste)看,第二个模型通过了显著性检验(a=0.1) 6.9 (1) 首先将公式线性化,对方程两边直接取对数即可。然后将得到的方程用lm回归。 > peo<-data.frame(X=c(2,5,7,10,14,19,2

48、6,31,34,38,45,52,53,60,65), + Y=c(54,50,45,37,35,25,20,16,18,13,8,11,8,4,6)) > lm.sol<-lm(log(Y)~1+X,data=peo);summary(lm.sol) Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) 4.037159 0.084103 48.00 5.08e-16 *** X -0.037974 0.002284 -16.62 3.

49、86e-10 *** > lm.sum<-summary(lm.sol) > exp(lm.sum$coefficients[1,1]) [1] 56.66512 所以theta0=56.66512,theta1=-0.0379 (2)> nls.sol<-nls(Y~b0*exp(b1*X),data=peo,start=list(b0=50,b1=0)) > summary(nls.sol) Parameters: Estimate Std. Error t value Pr(>|t|) b0 58.606535 1.472160 39.81 5.

50、70e-15 *** b1 -0.039586 0.001711 -23.13 6.01e-12 *** 发现所求的基本上与内在线性相同。 第七章 7.1 (1)>pro<-data.frame(Y=c(115,116,98,83,103,107,118,116,73,89,85,97), + X=factor(rep(1:3,rep(4,3)))) > pro.aov<-aov(Y~X,data=pro) > summary(pro.aov) 可以看到不同工厂对产品的影响是显著的 (2)首先自己编写求均值的小程序如下 > K<-matrix(0,nrow=1,nc

移动网页_全站_页脚广告1

关于我们      便捷服务       自信AI       AI导航        抽奖活动

©2010-2026 宁波自信网络信息技术有限公司  版权所有

客服电话:0574-28810668  投诉电话:18658249818

gongan.png浙公网安备33021202000488号   

icp.png浙ICP备2021020529号-1  |  浙B2-20240490  

关注我们 :微信公众号    抖音    微博    LOFTER 

客服