library(faraway) data(exa) plot(y ~ x, exa,main="Example A",pch=".") lines(m ~ x, exa) data(exb) plot(y ~ x, exb,main="Example B",pch=".") lines(m ~ x, exb) data(faithful) plot(waiting ~ eruptions, faithful,main="Old Faithful",pch=".") plot(waiting ~ eruptions, faithful,main="bandwidth=0.1",pch=".") lines(ksmooth(faithful$eruptions,faithful$waiting,"normal",0.1)) plot(waiting ~ eruptions, faithful,main="bandwidth=0.5",pch=".") lines(ksmooth(faithful$eruptions,faithful$waiting,"normal",0.5)) plot(waiting ~ eruptions, faithful,main="bandwidth=2",pch=".") lines(ksmooth(faithful$eruptions,faithful$waiting,"normal",2)) library(sm) hm <- hcv(faithful$eruptions,faithful$waiting,display="lines") sm.regression(faithful$eruptions,faithful$waiting,h=hm,xlab="eruptions",ylab="waiting") hm <- hcv(exa$x,exa$y,display="lines") sm.regression(exa$x,exa$y,h=hm,xlab="x",ylab="y") try(hm <- hcv(exb$x,exb$y,display="lines")) try(hm <- hcv(exb$x,exb$y,display="lines",hstart=0.005)) sm.regression(exb$x,exb$y,h=0.005) plot(waiting ~ eruptions, faithful,pch=".") lines(smooth.spline(faithful$eruptions,faithful$waiting)) plot(y ~ x,exa,pch=".") lines(exa$x,exa$m) lines(smooth.spline(exa$x,exa$y),lty=2) plot(y ~ x,exb,pch=".") lines(exb$x,exb$m) lines(smooth.spline(exb$x,exb$y),lty=2) rhs <- function(x,c) ifelse(x>c,x-c,0) curve(rhs(x,0.5),0,1) knots <- 0:9/10 knots dm <- outer(exa$x,knots,rhs) matplot(exa$x,dm,type="l",col=1) g <- lm(exa$y ~ dm) plot(y ~ x, exa,pch=".",xlab="x",ylab="y") lines(exa$x,predict(g)) newknots <- c(0,0.5,0.6,0.65,0.7,0.75,0.8,0.85,0.9,0.95) dmn <- outer(exa$x,newknots,rhs) gn <- lm(exa$y ~ dmn) plot(y ~x, exa,pch=".",xlab="x",ylab="y") lines(exa$x,predict(gn)) library(splines) matplot(bs(seq(0,1,length=1000),df=12),type="l",ylab="",col=1) sm1 <- lm(y ~ bs(x,12),exa) plot(y ~ x, exa, pch=".") lines(m ~ x, exa) lines(predict(sm1) ~ x, exa, lty=2) plot(waiting ~ eruptions, faithful,pch=".") f <- loess(waiting ~ eruptions, faithful) i <- order(faithful$eruptions) lines(f$x[i],f$fitted[i]) plot(y ~ x, exa, pch=".") lines(exa$x,exa$m,lty=1) f <- loess(y ~ x,exa) lines(f$x,f$fitted,lty=2) f <- loess(y ~ x,exa,span=0.22) lines(f$x,f$fitted,lty=5) plot(y ~ x,exb,pch=".") f <- loess(y ~ x, exb) lines(f$x,f$fitted,lty=2) f <- loess(y ~ x, exb,span=1) lines(f$x,f$fitted,lty=5) lines(exb$x,exb$m) library(wavethresh) wds <- wd(exa$y,filter.number=1,bc="interval") draw(filter.number=1,family="DaubExPhase") plot(wds) wtd <- threshold(wds,policy="manual",value=9999) fd <- wr(wtd) plot(y ~ x, exa,pch=".") lines(m ~ x, exa) lines(fd ~ x, exa, lty=5, lwd=2) wtd2 <- threshold(wds) fd2 <- wr(wtd2) plot(y ~ x, exa,pch=".") lines(m ~ x,exa) lines(fd2 ~ x, exa, lty=5, lwd=2) wds <- wd(exa$y,filter.number=2,bc="interval") draw(filter.number=2,family="DaubExPhase") plot(wds) wtd <- threshold(wds) fd <- wr(wtd) plot(y ~ x, exa,pch=".") lines(m ~ x,exa) lines(fd ~ x, exa, lty=2) data(savings) y <- savings$sr x <- cbind(savings$pop15,savings$ddpi) sm.regression(x,y,h=c(1,1),xlab="pop15",ylab="growth",zlab="savings rate") sm.regression(x,y,h=c(5,5),xlab="pop15",ylab="growth",zlab="savings rate")