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