[Rd] Bug in plot.lm (PR#6640)

[berwin at maths.uwa.edu.au]

Dear all,

I noticed the following behaviour of plot.lm:

> fm1 <- lm(time~dist, data=hills, weights=c(0,0,rep(1,33)))
> par(mfrow=c(2,2))
> plot(fm1)
Warning messages: 
1: longer object length
	is not a multiple of shorter object length in: res/(sd * (1 - hat)) 
2: longer object length
	is not a multiple of shorter object length in: (res/(sd * (1 - hat)))^2 * hat 

which seems to be undesirable.

The patch below seems to fix the problem.  At least, there is no more
warning message and the output looks similar to the output from

> fm2 <- lm(time~dist, data=hills, subset= -(1:2) )
> par(mfrow=c(2,2))
> plot(fm2)

Cheers,
        
        Berwin

*** plot.lm.R.orig      Fri Aug 15 22:13:08 2003
--- plot.lm.R   Wed Mar  3 18:05:34 2004
***************
*** 16,32 ****
      show <- rep(FALSE, 4)
      show[which] <- TRUE
      r <- residuals(x)
-     n <- length(r)
      yh <- predict(x) # != fitted() for glm
      if (any(show[2:4])) {
          s <- if(inherits(x, "rlm")) x$s else sqrt(deviance(x)/df.residual(x))
          hii <- lm.influence(x, do.coef=FALSE)$hat
      }
      if (any(show[2:3])) {
          ylab23 <- if(isGlm) "Std. deviance resid." else "Standardized residuals"
-         w <- weights(x)
          # r.w := weighted.residuals(x):
!         r.w <- if(is.null(w)) r else (sqrt(w)*r)[w!=0]
          rs <- r.w/(s * sqrt(1 - hii))
      }
      if (any(show[c(1,3)]))
--- 16,38 ----
      show <- rep(FALSE, 4)
      show[which] <- TRUE
      r <- residuals(x)
      yh <- predict(x) # != fitted() for glm
+     w <- weights(x)
+     if(!is.null(w)){
+       wind <- w!=0
+       r <- r[wind]
+       yh <- yh[wind]
+       w <- w[wind]
+     }
+     n <- length(r)
      if (any(show[2:4])) {
          s <- if(inherits(x, "rlm")) x$s else sqrt(deviance(x)/df.residual(x))
          hii <- lm.influence(x, do.coef=FALSE)$hat
      }
      if (any(show[2:3])) {
          ylab23 <- if(isGlm) "Std. deviance resid." else "Standardized residuals"
          # r.w := weighted.residuals(x):
!         r.w <- if(is.null(w)) r else (sqrt(w)*r)
          rs <- r.w/(s * sqrt(1 - hii))
      }
      if (any(show[c(1,3)]))
***************
*** 39,46 ****
            stop("`id.n' must be in {1,..,",n,"}")
      }
      if(id.n > 0) { ## label the largest residuals
!         if(is.null(labels.id))
!             labels.id <- paste(1:n)
          iid <- 1:id.n
        show.r <- sort.list(abs(r), decreasing = TRUE)[iid]
          if(any(show[2:3]))
--- 45,55 ----
            stop("`id.n' must be in {1,..,",n,"}")
      }
      if(id.n > 0) { ## label the largest residuals
!         if(is.null(labels.id)){
!           labels.id <- paste(1:n)
!         }else if(!is.null(w) && length(labels.id)!=n){
!           labels.id <- labels.id[wind]
!         }
          iid <- 1:id.n
        show.r <- sort.list(abs(r), decreasing = TRUE)[iid]
          if(any(show[2:3]))

        
--please do not edit the information below--

Version:
 platform = i686-pc-linux-gnu
 arch = i686
 os = linux-gnu
 system = i686, linux-gnu
 status = 
 major = 1
 minor = 8.1
 year = 2003
 month = 11
 day = 21
 language = R

Search Path:
 .GlobalEnv, package:DAAG, package:MASS, package:methods, package:ctest, package:mva, package:modreg, package:nls, package:ts, Autoloads, package:base