#-*- S -*-

# Chapter 8   Robust Statistics

library(MASS)
postscript(file="ch08.ps", width=8, height=6, pointsize=9)
library(lqs)


# 8.1  Univariate samples

data(chem)
sort(chem)
mean(chem)
median(chem)
#location.m(chem)
#location.m(chem, psi.fun="huber")
mad(chem)
#scale.tau(chem)
#scale.a(chem)
#scale.tau(chem, 3.68)
#scale.a(chem, 3.68)
unlist(huber(chem))
unlist(hubers(chem))

data(abbey)
sort(abbey)
mean(abbey)
median(abbey)
#location.m(abbey)
#location.m(abbey, psi.fun="huber")
unlist(hubers(abbey))
unlist(hubers(abbey, 2))
unlist(hubers(abbey, 1))


# 8.3  Robust regression

data(phones)
attach(phones)
phones.lm <- lm(calls ~ year, phones)
plot(year, calls)
abline(phones.lm$coef)
#abline(l1fit(year, calls), lty=2)
abline(ltsreg(year, calls), lty=3)
#legend(locator(1), legend=c("least squares", "L1", "ltsreg"), lty=1:3)

#glm(calls ~ year, robust(maxit=50), data=phones)
summary(lm(calls ~ year, data=phones))
summary(rlm(calls ~ year, maxit=50, data=phones))
#summary(rlm(calls ~ year, sw=3, data=phones)) # no sw=3
#summary(glm(calls ~ year, robust, data=phones))
summary(rlm(calls ~ year, k=0.25, maxit=50, data=phones))
#summary(glm(calls ~ year, robust(k=0.25, maxit=20), data=phones))
#rreg(year, calls, method=psi.hampel)
#rreg(year, calls, init=l1fit(year,calls)$coef, method=psi.hampel)
detach()


# 8.4  Resistant regression

data(stackloss)
summary(lm(stack.loss ~ stack.x))
lmsreg(stack.x, stack.loss)
ltsreg(stack.x, stack.loss)
#l1fit(stack.x, stack.loss)
stack.rl <- rlm(stack.loss ~ stack.x)
summary(stack.rl)
stack.rl$w

if(F) {
x1 <- stack.x[,1]; x2 <- stack.x[,2]
stack.loess <- loess(log(stack.loss) ~ x1*x2, span=0.5,
   family="symmetric")
stack.plt <- expand.grid(x1=seq(50,80,0.5), x2=seq(17,27,0.2))
stack.plt$z <- as.vector(predict(stack.loess, stack.plt))
dupls <- c(2,7,8,11)
contourplot(z ~ x1*x2, stack.plt, aspect=1,
   xlab="Air flow", ylab="Water temp",
   panel = function(x, y, subscripts, ...){
      panel.contourplot(x, y, subscripts, ...)
      panel.xyplot(x1, x2)
      text(x1[-dupls] + par("cxy")[1] ,
           x2[-dupls] + 0.5* par("cxy")[2],
           as.character(seq(x1)[-dupls]), cex=0.7)
   })
}

data(hills)
hills.lm <- lm(time ~ dist + climb, hills)
hills.lm
hills1.lm <- lm(time ~ dist + climb, hills[-18, ])
hills1.lm # omitting Knock Hill
rlm(time ~ dist + climb, hills)
summary(rlm(time ~ dist + climb, hills, weights=1/dist^2))
attach(hills)
#rreg(cbind(dist, climb), time)$coef
#rreg(cbind(dist, climb), time, wx=1/dist^2)$coef
ltsreg(cbind(dist, climb), time)$coef
detach()

hills <- hills
hills$ispeed <- hills$time/hills$dist
hills$grad <- hills$climb/hills$dist
attach(hills)
hills2.lm <- lm(ispeed ~ grad, hills[-18, ])
summary(hills2.lm) # omitting Knock Hill

ltsreg(grad, ispeed)$coef
#rreg(grad, ispeed)$coef
summary(rlm(ispeed ~ grad, hills))
detach()

# End of ch08
