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) }