# fit a GCV spline to
# control group of rats.
fit<- sreg(rat.diet$t,rat.diet$con)
summary( fit)
set.panel(2,2)
plot(fit) # four diagnostic plots of fit
set.panel()
predict( fit) # predicted values at data points
xg<- seq(0,110,,50)
sm<-predict( fit, xg) # spline fit at 50 equally spaced points
der.sm<- predict( fit, xg, deriv=1) # derivative of spline fit
set.panel( 2,1)
plot( fit$x, fit$y) # the data
lines( xg, sm) # the spline
plot( xg,der.sm, type="l") # plot of estimated derivative
set.panel() # reset panel to 1 plot
# the same fit using the thin plate spline numerical algorithms
# sreg does not scale the obs so instruct Tps not to sacel either
# this will make lambda comparable within factor of n.
fit.tps<-Tps( rat.diet$t,rat.diet$con, scale="unscaled")
summary( fit.tps)
# compare sreg and Tps results to show the adjustment to lambda.
predict( fit)-> look
predict( fit.tps, lambda=fit$lambda*fit$N)-> look2
test.for.zero( look, look2) # silence means it checks to 1e-8
# finding approximate standard errors at observations
SE<- fit$tauHat.GCV*sqrt(fit$diagA)
# compare to predictSE( fit.tps) differences are due to
# slightly different lambda values and using tauHat.MLE instad of tauHat.GCV
#
# 95% pointwise prediction intervals
Zvalue<- qnorm(.0975)
upper<- fit$fitted.values + Zvalue* SE
lower<- fit$fitted.values - Zvalue* SE
#
# conservative, simultaneous Bonferroni bounds
#
ZBvalue<- qnorm(1- .025/fit$N)
upperB<- fit$fitted.values + ZBvalue* SE
lowerB<- fit$fitted.values - ZBvalue* SE
#
# take a look
plot( fit$x, fit$y, type="n")
envelopePlot(fit$x, lowerB,fit$x, upperB, col = "grey90",
lineCol="grey")
envelopePlot(fit$x, lower,fit$x, upper, lineCol="grey")
lines( fit$predicted, col="red",lwd=2)
points( fit$x, fit$y,pch=16)
title( "95 pct pointwise and simultaneous intervals")
# or try the more visually honest not connecting points
plot( fit$x, fit$y, type="n")
segments( fit$x, lowerB, fit$x, upperB, col="grey",lwd=3)
segments( fit$x, lower, fit$x, upper, col="thistle3", lwd=6)
lines( fit$predicted, lwd=2,col="red")
points( fit$x, fit$y,pch=16)
title( "95 pct pointwise and simultaneous intervals")
set.panel( 1,1)
Run the code above in your browser using DataLab