1naa_longer<-function(naa, object,...) UseMethod("naa_longer",naa) 2naa_shorter<-function(naa, object,...) UseMethod("naa_shorter",naa) 3 4naa_longer.NULL<-function(naa, object,...) object 5naa_shorter.NULL<-function(naa, object,...) object 6 7naa_longer.default<-function(naa, object,...) stop("no default method (not psychic)") 8naa_shorter.default<-function(naa, object,...) stop("no default method (not psychic)") 9 10naa_longer.fail<-function(naa, object,...) stop("can't happen (na.fail)") 11naa_shorter.fail<-function(naa, object,...) stop("can't happen (na.fail)") 12 13naa_shorter.omit<-function(naa, object,...) object 14naa_longer.omit<-function(naa,object,...){ ##from naresid.exclude 15 if (length(naa) == 0 || !is.numeric(naa)) 16 stop("invalid argument 'naa'") 17 if (is.null(object)) 18 return(object) 19 n <- NROW(object) 20 keep <- rep.int(NA, n + length(naa)) 21 keep[-naa] <- 1L:n 22 if (is.matrix(object)) { 23 object <- object[keep, , drop = FALSE] 24 temp <- rownames(object) 25 if (length(temp)) { 26 temp[naa] <- names(naa) 27 rownames(object) <- temp 28 } 29 } 30 else if (is.array(object) && length(d <- dim(object)) > 2L) { 31 object <- object[keep, , , drop = FALSE] 32 temp <- (dn <- dimnames(object))[[1L]] 33 if (!is.null(temp)) { 34 temp[naa] <- names(naa) 35 dimnames(object)[[1L]] <- temp 36 } 37 } 38 else { 39 object <- object[keep] 40 temp <- names(object) 41 if (length(temp)) { 42 temp[naa] <- names(naa) 43 names(object) <- temp 44 } 45 } 46 object 47} 48 49naa_longer.exclude<-function(naa,object,...) object 50naa_shorter.exclude<-function(naa,object,...) { 51 if (length(naa) == 0 || !is.numeric(naa)) 52 stop("invalid argument 'naa'") 53 if (is.null(object)) 54 return(object) 55 n <- NROW(object) 56 keep <- (1:n)[-naa] 57 if (is.matrix(object)) { 58 object <- object[keep, , drop = FALSE] 59 temp <- rownames(object) 60 } 61 else if (is.array(object) && length(d <- dim(object)) > 2L) { 62 object <- object[keep, , , drop = FALSE] 63 temp <- (dn <- dimnames(object))[[1L]] 64 } 65 else { 66 object <- object[keep] 67 temp <- names(object) 68 } 69 object 70} 71 72 73 74 75