PDF文库 - 千万精品文档,你想要的都能搜到,下载即用。

个人作业展示(三)——2015年秋季第1....pdf

Forgot 丢失12 页 405.978 KB下载文档
个人作业展示(三)——2015年秋季第1....pdf个人作业展示(三)——2015年秋季第1....pdf个人作业展示(三)——2015年秋季第1....pdf个人作业展示(三)——2015年秋季第1....pdf个人作业展示(三)——2015年秋季第1....pdf个人作业展示(三)——2015年秋季第1....pdf
当前文档共12页 2.88
下载后继续阅读

个人作业展示(三)——2015年秋季第1....pdf

非参数统计第 13 次作业 王健桥 2013202552 数据文件为 saheart.txt 分别用 Brown-Mood, OLS, Theil 以及 WLS 做出的回归图像如下: 用自己编写的函数将 OLS,Theil 以及 WLS 分别进行 Brown-Mood 检验,得到结果如下: H0 : α = α 0 , β =↔ β0 H 1 : α ≠ α 0 或β ≠ β 0 OLS BM_Rfun(cyx[1],cyx[2],xx,yy) 统计量为 6.796537 [1] "P 值为" [1] 0.03343111 THEIL BM_Rfun(intercept,slope,xx,yy) 3.160173 [1] "P 值为" [1] 0.2059573 WLS > BM_Rfun(coef(WLM)[1],coef(WLM)[2],xx,yy) [1] 0.5627706 [1] "P 值为" [1] 0.7547375 可知 OLS 没有通过 BM 检验,而 THEIL 和 WLS 通过了检验 流程图: 6.3 对于裁判判决的一致性检验,我们采用多变量 Kendall 协和系数检验的方法。 H 0 : 评委的打分不相关 H1 : 评委的打分是相关的,即具有一致性 输入全部的数据,进行检验 Kendall's coefficient of concordance Wt Chisq(9) = 33.2 p-value = 0.000123 p 值很小,即能拒绝原假设。 考虑到数据的现实背景,我们更加关注比赛中对排名前列的选手打分情况,所以选取总分 在中位数以上的选手所得得分进行一致性检验: A1<-colSums(ratings) A_num <- which(A1>median(A1)) ratings2<-ratings[,A_num] kendall(t(ratings2), correct = TRUE) 得到结果, Kendall's coefficient of concordance Wt Chisq(4) = 20.2 p-value = 0.000451 依旧能拒绝原假设,则我们得出结论,各个评委之间的判断具有一致性。 6.4 进行 Kappa 一致性检验,原假设为两种方法不一致 Z = 4.3019, p-value = 8.466e-06 95 percent confidence interval: 0.2430741 0.5918773 sample estimates: 0.4174757 "Moderate agreement" P 值很小,即可以拒绝原假设,说明两位医生的治疗方法具有一致性。统计量表明是具有 中等一致性。 6.8 (1)分位数回归是对普通最小二乘的一种扩充,对于假设因变量 Y 和自变量 X 之间存在 着相关关系,由于 Y 是随机变量,对于 X 的各个确定值 x,Y 都有对应的分布 F(y/x)。 直接确定 F(y/x)是困难的,作为一种近似,普通最小二乘回归方法转而确定 E(y/x)。 而分位回归是建立因变量 Y 与自变量 X 的条件分位模型,即 QY (τ | X ) = f ( X ) 其中 τ 是因变量 Y 在 X 条件下的分位数。 f ( X ) 拟合 Y 的第 τ 分位数,中位数拟合就是 0.5 分位回归。 (2)对于分位回归的最优化问题表示形式为:   arg min  ∑ τ | yi − f ( xi ) | + ∑ (1 − τ ) | yi − f ( xi ) | β ∈R n i∈{i: yi ≤ f ( x )}  i∈{i: yi ≥ f ( x )}  对于如上的表示形式,我们可以看到分位数回归用的是最小化残差的绝对值形式,这一点 与绝对值形式的性质有关,为了更好的说明这一点,不妨设我们分位数为 0.5,即此时为 ∑ 中位数回归,同时有一组样本 y1 , , yn ,对于一组样本,min (yi -) ξ 中,均值是最小 值解,而中位数则是 2 ∑ | y − ξ | 的最小值解同样,可以证明, i   − + − − τ y ξ τ y ξ | | (1 ) | |  ∑  的取最小值时,解为 τ 分位数,所以要寻找 ∑ i i i∈{i: yi ≤ f ( x )}  i∈{i: yi ≥ f ( x )}  分位数的回归,我们采取了最小化绝对值的方式。 当 f ( xi ) = xiT β 时,即为分位数的线性回归。由于绝对值形式的目标函数无法得到解析解, 因此只能通过数值方法反复迭,得到最优解。线性规划可以用单纯形法,而非线性规划可 以用可以用其他方法解决 (3)(1)当存在显著的异方差等情况最小二乘法估计稳健性非常差。分位回归对模型中的 随机误差项不需做具体的分布假定,有广泛的适用性,。 (2)分位回归没有使用连接函数描述因变量和自变量间的关系,因此分位回归体现了数 据驱动的建模思想 (3)分位回归对分位数 τ 进行回归,于是对异常值不敏感,模型结果比较稳定;而 OLS 是对均值进行回归,易受异常值影响。 (4)分位回归可解出不同分位数模型,能更全面的体现分布特点。而 OLS 只能表示均值 的变化。 (4) attach(infant_weight) fit1median(xx)] xx2 = xx[xxmedian(xx)]## yy2 = yy[xx intercept + slope*x[])) l2<-c((x[]>X_median & y[] < intercept + slope*x[])) T_STATISTICS <-((sum(l1)-length(l1)/4)^2+(sum(l2)-length(l2)/4)^2)*8/length(l1) pvalue = pchisq(T_STATISTICS,2,lower.tail = FALSE) result<-list(t=T_STATISTICS,info=paste("P 值为"),pvalue) result } BM_Rfun(cyx[1],cyx[2],xx,yy)#OLS BM_Rfun(intercept,slope,xx,yy)#Theil BM_Rfun(coef(WLM)[1],coef(WLM)[2],xx,yy)#WLS detach(data1) ################################ install.packages("irr") library(irr) ratings<-read.csv(file = "/Users/w/Desktop/junior_STAT_FIRST_SEM/nmSTAT/12data.csv",header = T) ratings<-ratings[!is.na(ratings)] ratings = matrix(ratings,nrow = 12, ncol =10) kendall(t(ratings), correct = TRUE) ##################################### A1<-colSums(ratings) A_num <- which(A1>median(A1)) ratings2<-ratings[,A_num] kendall(t(ratings2), correct = TRUE) #ratings.rank <- apply(ratings, 2, rank) #######################6.4#### D_Matrix<-matrix(c(40,5,25,30),2,2,byrow = T) library(fmsb) Kappa.test(D_Matrix) ############ p 值很小,具有显著的一致性 ###########6.8######## install.packages("quantreg") library(quantreg) library(SparseM) infant_weight<-read.table(file = "/Users/w/Desktop/junior_STAT_FIRST_SEM/nmSTAT/数据盘/ 各章数据/第 6 章/infant-birthweight.txt",header = T) attach(infant_weight) plot(m.wtgain,weight,xlab = "m.wtgain",ylable = "weight",type = "n") points(m.wtgain,weight) taus = seq(0.1,0.9,0.1) f = coef(rq(weight~m.wtgain,tau = taus)); for (i in 1:length(taus)){ abline(f[,i][1],f[,i][2],lty = 2,color = i) } abline(lm(weight~m.wtgain),lty = 9) legend(3000,700,c("mean","median","otherquantile"),lty = c(9,1,2)) fit1<-rq(weight~married+boy+smoke+mom.age+m.wtgain,method="pfn", tau=c(0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9)) summary(fit1) plot(summary(fit1, alpha=0.05)) detach(infant_weight)

相关文章