1# Last modified 25 Nov 2009 for point marking
2# 18 January 2012 added robust estimation from Pendergast and Sheather
3# 25 April 2016 check na.action for compatibility with Rcmdr
4# 2017-02-13: modified to use id arg in calls to invTranPlot(). J. Fox
5# 2017-11-30: substitute carPalette() for palette(). J. Fox
6# 2019-05-16: make sure that xlab arg is properly passed to invTranPlot(). J. Fox
7# 2019-11-14: change class(x) == "y" to inherits(x, "y")
8
9inverseResponsePlot <- function(model, lambda=c(-1, 0, 1), robust=FALSE,
10   xlab=NULL, ...)
11    UseMethod("inverseResponsePlot")
12
13invResPlot <- function(model, ...) UseMethod("inverseResponsePlot")
14
15
16inverseResponsePlot.lm <- function(model, lambda=c(-1, 0, 1), robust=FALSE,
17       xlab=NULL, id=FALSE, ...) {
18  if(inherits(model$na.action, "exclude")) model <- update(model, na.action=na.omit)
19  id <- applyDefaults(id, defaults=list(method="x", n=2, cex=1, col=carPalette()[1], location="lr"), type="id")
20  if (isFALSE(id)){
21      id.n <- 0
22      id.method <- "none"
23      labels <- id.cex <- id.col <- id.location <- NULL
24  }
25  else{
26      labels <- id$labels
27      if (is.null(labels)) labels <- names(residuals(model))
28      id.method <- id$method
29      id.n <- if ("identify" %in% id.method) Inf else id$n
30      id.cex <- id$cex
31      id.col <- id$col
32      id.location <- id$location
33  }
34  if(robust == TRUE){
35    m <- model$call
36    m[[1L]] <- as.name("rlm")
37    model <- eval(m, parent.frame())
38  }
39  mf <- model$model
40  if (is.null(mf)) mf <- update(model, model=TRUE, method="model.frame")
41
42  if (is.null(xlab)) xlab <- names(mf)[1] else force(xlab)
43  y <- mf[, 1]
44  yhat <- predict(model)
45  invTranPlot(y, yhat, lambda=lambda, xlab=xlab, robust=robust,
46              id=list(n=id.n, method=id.method, labels=labels, cex=id.cex, col=id.col, location=id.location), ...)
47}
48