1na.detail.response <- function(mf)
2{
3  if(is.null(z <- .Options$na.detail.response) || !z)
4    return(NULL)
5
6  response <- model.extract(mf, response)
7  if(is.null(response))
8    return(NULL)
9
10  if(!is.matrix(response))
11    response <- as.matrix(response)
12
13  GFUN <- options()$na.fun.response
14  if(is.null(GFUN))
15    GFUN <-  function(x, ...)
16    {
17      if(is.matrix(x)) x <- x[,ncol(x)]
18      x <- x[!is.na(x)]
19      c(N=length(x),Mean=mean(x))
20    }
21  else GFUN <- if(.R.) eval.parent(as.name(GFUN))
22                  else eval(as.name(GFUN), local=FALSE)
23
24  w <- NULL; nam <- names(mf); wnam <- NULL
25  N <- nrow(mf)
26  p <- ncol(mf)
27  omit <- rep(FALSE, N)
28  for(i in 2:p) {
29    x <- mf[,i]
30    if(is.matrix(x))
31      x <- x[,1]
32
33    isna <- is.na(x)
34    omit <- omit | isna
35    nmiss <- sum(isna)
36    if(nmiss) {
37      w <- cbind(w, GFUN(response[isna,]))
38      wnam <- c(wnam, paste(nam[i],"=NA",sep=""))
39    }
40
41    n <- N-nmiss
42    if(n) {
43      w <- cbind(w, GFUN(response[!isna,]))
44      wnam <- c(wnam, paste(nam[i],"!=NA",sep=""))
45    }
46  }
47
48  ## summarize responce for ANY x missing
49  if(p>2) {
50    nmiss <- sum(omit)
51    if(nmiss) {
52      w <- cbind(w, GFUN(response[omit,]))
53      wnam <- c(wnam, "Any NA")
54    }
55
56    if(N-nmiss) {
57      w <- cbind(w, GFUN(response[!omit,]))
58      wnam <- c(wnam, "No NA")
59    }
60  }
61
62  dimnames(w)[[2]] <- wnam
63  w
64}
65