View | Details | Raw Unified | Return to bug 16936
Collapse All | Expand All

(-)table.R (-24 / +14 lines)
Lines 64-73 Link Here
64
	else if (length(a) != lens)
64
	else if (length(a) != lens)
65
	    stop("all arguments must have the same length")
65
	    stop("all arguments must have the same length")
66
        cat <-
66
        cat <-
67
            if (is.factor(a)) {
67
            if (is.factor(a))
68
                if (any(is.na(levels(a)))) # Don't touch this!
69
                    a
68
                    a
70
                else {
71
                    ## The logic here is tricky because it tries to do
69
                    ## The logic here is tricky because it tries to do
72
                    ## something sensible if both 'exclude' and
70
                    ## something sensible if both 'exclude' and
73
                    ## 'useNA' are set.
71
                    ## 'useNA' are set.
Lines 76-107 Link Here
76
                    ## excluded levels to missing, which is different
74
                    ## excluded levels to missing, which is different
77
                    ## from the <NA> factor level. Excluded levels are
75
                    ## from the <NA> factor level. Excluded levels are
78
                    ## NOT tabulated, even if 'useNA' is set.
76
                    ## NOT tabulated, even if 'useNA' is set.
79
                    if (is.null(exclude) && useNA != "no")
77
            else # NB: this excludes first, unlike the case above.
80
                        addNA(a, ifany = (useNA == "ifany"))
78
                factor(a, exclude = exclude)
81
                    else {
79
        if (useNA != "no" && !anyNA(levels(cat)))
82
                        if (useNA != "no")
80
            cat <- addNA(cat, ifany = (useNA == "ifany"))
83
                            a <- addNA(a, ifany = (useNA == "ifany"))
81
        ll <- levels(cat)
84
                        ll <- levels(a)
82
        cat <- as.integer(cat)
85
                        a <- factor(a, levels = ll[!(ll %in% exclude)],
83
        if (is.factor(a) && !missing(exclude)) {
86
                               exclude = if (useNA == "no") NA)
84
            ll <- ll[used <- which(!(ll %in% exclude))]
87
                    }
85
            cat <- match(cat, used)
88
                }
86
        }
89
            }
90
            else { # NB: this excludes first, unlike the case above.
91
                a <- factor(a, exclude = exclude)
92
                if (useNA != "no")
93
                    addNA(a, ifany = (useNA == "ifany"))
94
                else
95
                    a
96
            }
97
87
98
	nl <- length(ll <- levels(cat))
88
	nl <- length(ll)
99
	dims <- c(dims, nl)
89
	dims <- c(dims, nl)
100
        if (prod(dims) > .Machine$integer.max)
90
        if (prod(dims) > .Machine$integer.max)
101
            stop("attempt to make a table with >= 2^31 elements")
91
            stop("attempt to make a table with >= 2^31 elements")
102
	dn <- c(dn, list(ll))
92
	dn <- c(dn, list(ll))
103
	## requiring   all(unique(as.integer(cat)) == 1L:nlevels(cat))  :
93
	## requiring   all(unique(cat) == 1L:nl)  :
104
	bin <- bin + pd * (as.integer(cat) - 1L)
94
	bin <- bin + pd * (cat - 1L)
105
	pd <- pd * nl
95
	pd <- pd * nl
106
    }
96
    }
107
    names(dn) <- dnn
97
    names(dn) <- dnn

Return to bug 16936