plot.lmRobBI(x, residuals=NULL, smooths=F, rugplot=F, id.n=3, ask=F,
which.plots=NULL, ...)
~explain details here.
~put references here, make other sections like NOTE and WARNING with .SH
# The function is currently defined as
function(x, residuals = NULL, smooths = F, rugplot = F, id.n = 3, ask = F,
which.plots = NULL, ...)
{
#
# Identical to plot.lmRobBI
#
Residuals <- resid(x)
if(!is.null(dim(Residuals)))
stop("Not implemented for multivariate responses.")
if(!is.null(residuals)) {
if(length(residuals) == 1 && residuals)
residuals <- Residuals
else Residuals <- residuals
}
fits <- predict.lm(x)
response <- fits + Residuals
form <- formula.lm(x)
response.name <- deparse(form[[2]])
model <- deparse(form[[3]])
fit.lab <- paste("Fitted :", model, sep = " ")
add.ons <- function(x, y, smooths = T, rugplot = T, id.n = 3)
{
if(smooths) {
prediction <- loess.smooth(x, y, span = 1, degree = 1)
lines(prediction)
}
if(rugplot) {
jx <- jitter(x[!is.na(x)])
xlim <- range(jx)
rug(jx)
}
if(id.n) {
# Identify id.n greatest y-values (in absolute value)
n <- length(y)
oy <- order(abs(y))
which <- oy[(n - id.n + 1):n]
text(x[which], y[which], as.character(which), adj = 0)
}
}
if(is.null(which.plots)) {
choices <- c("All", "Residuals vs Fitted Values",
"Sqrt of abs(Residuals) vs Fitted Values",
"Response vs Fitted Values",
"Normal QQplot of Residuals", "r-f spread plot")
choices <- substring(choices, 1, 40) #truncate long names
tmenu <- paste("plot:", choices)
pick <- 2
ask.now <- ask
while(pick <= length(tmenu) + 2) {
if(ask.now)
pick <- menu(tmenu, title =
"\nMake a plot selection (or 0 to exit):\n") +
1
switch(pick,
invisible(return(x)),
{
# Plot all choices one by one
ask.now <- F
}
,
{
# Residuals vs Fitted Values
plot(fits, Residuals, xlab = fit.lab, ylab =
"Residuals", ...)
abline(h = 0, lty = 2)
add.ons(fits, Residuals, smooths = smooths,
rugplot = rugplot, id.n = id.n)
}
,
{
# Sqrt of abs(Residuals) vs Fitted Values
y <- sqrt(abs(Residuals))
plot(fits, y, xlab = fit.lab, ylab = deparse(
substitute(sqrt(abs(resid(lm.obj))))), ...)
add.ons(fits, y, smooths = smooths, rugplot
= rugplot, id.n = id.n)
}
,
{
# Response vs Fitted Values
plot(fits, response, xlab = fit.lab, ylab =
response.name, ...)
abline(0, 1, lty = 2)
add.ons(fits, response, smooths = smooths,
rugplot = rugplot, id.n = F)
}
,
{
# Normal QQplot of Residuals
qqxy <- qqnorm(Residuals)
add.ons(qqxy$x, qqxy$y, smooths = F, rugplot
= F, id.n = id.n)
qqline(Residuals, lty = 2)
}
,
{
# Plot an r-f spread plot
rfplot(fits, Residuals, yname = response.name
)
}
)
if(!ask.now)
pick <- pick + 1
if(pick == length(tmenu) + 2)
ask.now <- ask
}
}
else {
for(i in which.plots) {
switch(i,
{
# Residuals vs Fitted Values
plot(fits, Residuals, xlab = fit.lab, ylab =
"Residuals", ...)
abline(h = 0, lty = 2)
add.ons(fits, Residuals, smooths = smooths,
rugplot = rugplot, id.n = id.n)
}
,
{
# Sqrt of abs(Residuals) vs Fitted Values
y <- sqrt(abs(Residuals))
plot(fits, y, xlab = fit.lab, ylab = deparse(
substitute(sqrt(abs(resid(lm.obj))))), ...)
add.ons(fits, y, smooths = smooths, rugplot
= rugplot, id.n = id.n)
}
,
{
# Response vs Fitted Values
plot(fits, response, xlab = fit.lab, ylab =
response.name, ...)
abline(0, 1, lty = 2)
add.ons(fits, response, smooths = smooths,
rugplot = rugplot, id.n = F)
}
,
{
# Normal QQplot of Residuals
qqxy <- qqnorm(Residuals)
add.ons(qqxy$x, qqxy$y, smooths = F, rugplot
= F, id.n = id.n)
qqline(Residuals, lty = 2)
}
,
{
# Plot an r-f spread plot
rfplot(fits, Residuals, yname = response.name
)
}
,
warning(paste("There is no plot number", i)))
}
}
invisible(x)
}