UA MATH571A QE練習 R語言 非參數回歸上

• 2014年5月第五題
• 2015年1月第四題
• 2015年5月第四題

這一篇介紹2014年5月第五題、2015年1月第四題、2015年5月第四題。

2014年5月第五題

一項研究試圖探索1950年代到2000年代后期北美模特體質比的變化。現在有的數據是BMI平均值的時間序列數據，數據為時間和BMI，時間是月份（字符）+年份（數值），我們先處理一下時間：

q3.df = read.csv( file.choose() ) attach( q3.df ) month.digit = match( Month,month.abb ) date = paste( Year,month.digit,sep='-' ) library( zoo ) month = as.yearmon(date)

第一行選取數據，第二行給它貼個名字，第三行把月份從字符變成數字，第四行把年份和月份用-連起來，接下來就是用as.yearmon這個函數把xxxx-xx型的時間數據變成這種

> as.yearmon("2007-12") [1] "12月 2007"

變成這種之后有一個好處，就是可以用as.numeric變成數值

> as.numeric(as.yearmon("2007-12")) [1] 2007.917

轉換規則是第$i$個月變成小數加在年份后面，轉換規則是$(i?1)/12$。把時間做了這些處理之后畫出散點圖：

month = as.yearmon(date) x = as.numeric(month); Y = BMI plot( Y~x, pch=19 )

這個散點圖反映出三個特征：

數據存在replicate；

整體呈現模特平均BMI逐年下降的趨勢；

數據顯然不是線性的

下面用loess方法擬合一下，

BMI1r.loess = loess( Y~x, span = 0.5, degree = 1, family='symmetric' ) Ysmooth1r = predict( BMI1r.loess, data.frame(x = seq(1953,2009,.25) )) plot( Y~x, pch=19, xlim=c(1950,2009), ylim=c(15,24) ); par( new=T ) plot( Ysmooth1r~seq(1953,2009,.25), type='l', lwd=2 , xaxt='n',yaxt='n' , xlab='', ylab='', xlim=c(1950,2009), ylim=c(15,24) )

大致可以看出到1983年左右是呈現下降趨勢的，1983年之后鮮有回升。殘差圖如下

plot( resid(BMI1r.loess)~x, pch=19 ); abline( h=0 )

基本是均勻分布在橫軸兩側的，但最上面的點疑似異常值。

2015年1月第四題

這道題和上一道非常像，我就不寫文字了，數據數隔行存的，讀進來很多nan，可以用na.omit去掉。

gapminder.df = read.csv( file.choose() ) G = na.omit(gapminder.df$GDP) Y = na.omit(gapminder.df$life.expect) hist( G, prob=T, main='' ) lines ( density(G) )

X = log(G) plot( Y ~ X, pch=19 )

gapminder.loess = loess( Y~X, span=0.7, degree=1, family='symmetric' ) Ysmooth1r = predict( gapminder.loess, data.frame(X=seq(4,11)) ) plot( Y~X, pch=19, xlim=c(4,11), ylim=c(40,90) ); par( new=T ) plot( Ysmooth1r~seq(4,11), type='l', lwd=2 , xaxt='n',yaxt='n' , xlab='', ylab='', xlim=c(4,11), ylim=c(40,90) )

plot( resid(gapminder.loess)~X, pch=19, ylab='Resid.' ); abline( h=0 )

2015年5月第四題

loess方法或許可以用來做模型診斷，在用線性模型擬合了數據之后，我們可以用loess模型對殘差關于擬合值的散點圖做一個非參數回歸，如果非參數回歸曲線不平，就說明有異方差；如果非參數回歸曲線比較平，就說明是同方差。

先看一下數據

baseball.df = read.csv( file.choose() ) Y = na.omit(baseball.df$batting.average) X = na.omit(baseball.df$years) plot( Y ~ X, pch=19 )

再看一下一元回歸殘差絕對值關于擬合值的散點圖

baseballSLR.lm <- lm(Y ~ X) absresid = abs(resid(baseballSLR.lm)) Yhat = fitted(baseballSLR.lm) plot(absresid~Yhat,pch=19)

如果取$q=0.75$，則

baseball.lo = loess( absresid~Yhat, span = 0.75, degree = 2,family='symmetric' ) Ysmooth = predict( baseball.lo,data.frame(Yhat = seq(min(Yhat),max(Yhat),.001)) ) plot( absresid~Yhat, xlim=c(.25,.29), ylim=c(0,.11) ) par( new=TRUE ) plot( Ysmooth~seq(min(Yhat),max(Yhat),.001), type='l', lwd=2,xaxt='n', yaxt='n' , xlab='', ylab='', xlim=c(.25,.29), ylim=c(0,.11))

如果取$q=0.33$，則

baseball.lo = loess( absresid~Yhat, span = 0.33, degree = 2,family='symmetric' ) Ysmooth = predict( baseball.lo,data.frame(Yhat = seq(min(Yhat),max(Yhat),.001)) ) plot( absresid~Yhat, xlim=c(.25,.29), ylim=c(0,.11) ) par( new=TRUE ) plot( Ysmooth~seq(min(Yhat),max(Yhat),.001), type='l', lwd=2,xaxt='n', yaxt='n' , xlab='', ylab='', xlim=c(.25,.29), ylim=c(0,.11))

如果取$q=0.5$，則

baseball.lo = loess( absresid~Yhat, span = 0.5, degree = 2,family='symmetric' ) Ysmooth = predict( baseball.lo,data.frame(Yhat = seq(min(Yhat),max(Yhat),.001)) ) plot( absresid~Yhat, xlim=c(.25,.29), ylim=c(0,.11) ) par( new=TRUE ) plot( Ysmooth~seq(min(Yhat),max(Yhat),.001), type='l', lwd=2,xaxt='n', yaxt='n' , xlab='', ylab='', xlim=c(.25,.29), ylim=c(0,.11))

從上面三組結果的比較我們可以得出兩個結論：

基本可以認定非參數回歸曲線是平坦的，雖然$q=0.33$時比較彎曲，但此時的非參數回歸曲線并不夠平滑，不能體現出數據的趨勢；

非參數回歸做診斷的結果對超參比較敏感；

《新程序員》：云原生和全面數字化實踐50位技術專家共同創作，文字、視頻、音頻交互閱讀

總結

以上是生活随笔為你收集整理的UA MATH571A QE练习 R语言 非参数回归 上的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。