which_test.R

rand_v <- function(n, pct.true, use.names = FALSE, use.na = FALSE)
{
    vals <- c(TRUE, FALSE)
    probs <- c(pct.true, (1 - pct.true))
    if (use.na) {
        vals <- c(vals, NA)
        pct.o <- (1 - pct.true) / 2
        probs <- c(pct.true, pct.o, pct.o)
    }
    v <- sample(vals, size = n, replace = TRUE, prob = probs)
    if (use.names) {
        names(v) <- paste("el", seq_len(n), sep = "")
    }
    v
}

which.orig <- function(x)
{
    if(!is.logical(x))
        stop("argument to 'which' is not logical")
    wh <- seq_along(x)[x & !is.na(x)]
    dl <- dim(x)
    if (is.null(dl)) {
        names(wh) <- names(x)[wh]
    }
    ## array index version omitted
    wh
}

correctness_test <- function()
{
    results_match <- function(v)
    {
        orig <- which.orig(v)
        new <- which(v)
        if (!identical(orig, new)) {
            stop("results differ: ", v)
        }
    }

    for (val in c(TRUE, FALSE, NA)) {
        v <- val
        results_match(v)
        results_match(v[0]) ## empty
        v <- c(a=val)
        results_match(v)
        results_match(v[0]) ## named empty
    }

    for (p in c(0.1, 0.5, 0.8)) {
        for (nms in c(TRUE, FALSE)) {
            for (nas in c(TRUE, FALSE)) {
                cat(p, nms, nas, "\n")
                v <- rand_v(1000, p, nms, nas)
                results_match(v)
            }
        }
    }
}

do_test <- function(N, pcts, use.names = FALSE, use.na = FALSE)
{
    times <- matrix(0, nrow = length(pcts), ncol = 2,
                    dimnames = list(as.character(pcts), c("orig", "new")))
    for (p in pcts) {
        v <- rand_v(N, p, use.names, use.na)
        lab <- as.character(p)
        times[lab, "orig"] <- st(which.orig(v))[[3]]
        times[lab, "new"] <- st(which(v))[[3]]
    }
    times
}


set.seed(0x447)
correctness_test()
st <- system.time
do_test(7e6, seq(.10, .90, by= .2))
do_test(2e6, seq(.10, .90, by= .2), use.names = TRUE)
do_test(2e6, seq(.10, .90, by= .2), use.na = TRUE)
do_test(2e6, seq(.10, .90, by= .2), use.na = FALSE)