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