1basic_tests <- list( 2 list(input=c(TRUE, FALSE), any=TRUE, all=FALSE), 3 list(input=c(FALSE, TRUE), any=TRUE, all=FALSE), 4 5 list(input=c(TRUE, TRUE), any=TRUE, all=TRUE), 6 list(input=c(FALSE, FALSE), any=FALSE, all=FALSE), 7 8 list(input=c(NA, FALSE), any=NA, all=FALSE, any.na.rm=FALSE), 9 list(input=c(FALSE, NA), any=NA, all=FALSE, any.na.rm=FALSE), 10 11 list(input=c(NA, TRUE), any=TRUE, all=NA, all.na.rm=TRUE), 12 list(input=c(TRUE, NA), any=TRUE, all=NA, all.na.rm=TRUE), 13 14 list(input=logical(0), any=FALSE, all=TRUE), 15 16 list(input=NA, any=NA, all=NA, any.na.rm=FALSE, any.na.rm=TRUE), 17 18 list(input=c(TRUE, NA, FALSE), any=TRUE, any.na.rm=TRUE, 19 all=FALSE, all.na.rm=FALSE) 20 ) 21 22## any, all accept '...' for input. 23list_input_tests <- 24 list( 25 list(input=list(TRUE, TRUE), all=TRUE, any=TRUE), 26 list(input=list(FALSE, FALSE), all=FALSE, any=FALSE), 27 list(input=list(TRUE, FALSE), all=FALSE, any=TRUE), 28 list(input=list(FALSE, TRUE), all=FALSE, any=TRUE), 29 30 list(input=list(FALSE, NA), 31 all=FALSE, all.na.rm=FALSE, any=NA, any.na.rm=FALSE), 32 list(input=list(NA, FALSE), 33 all=FALSE, all.na.rm=FALSE, any=NA, any.na.rm=FALSE), 34 35 list(input=list(TRUE, NA), 36 all=NA, all.na.rm=TRUE, any=TRUE, any.na.rm=TRUE), 37 list(input=list(NA, TRUE), 38 all=NA, all.na.rm=TRUE, any=TRUE, any.na.rm=TRUE), 39 40 list(input=list(NA, NA), 41 any=NA, any.na.rm=FALSE, all=NA, all.na.rm=TRUE), 42 43 list(input=list(rep(TRUE, 2), rep(TRUE, 10)), 44 all=TRUE, any=TRUE), 45 46 list(input=list(rep(TRUE, 2), c(TRUE, NA)), 47 all=NA, all.na.rm=TRUE, any=TRUE), 48 49 list(input=list(rep(TRUE, 2), c(TRUE, FALSE)), 50 all=FALSE, any=TRUE), 51 52 list(input=list(c(TRUE, FALSE), c(TRUE, NA)), 53 all=FALSE, all.na.rm=FALSE, any=TRUE, any.na.rm=TRUE) 54 ) 55 56 57 58do_tests <- function(L) 59{ 60 run <- function(f, input, na.rm = FALSE) 61 { 62 if (is.list(input)) 63 do.call(f, c(input, list(na.rm = na.rm))) 64 else f(input, na.rm = na.rm) 65 } 66 67 do_check <- function(case, f) 68 { 69 fun <- deparse(substitute(f)) 70 if (!identical(case[[fun]], run(f, case$input))) { 71 cat("input: "); dput(case$input) 72 stop(fun, " returned ", run(f, case$input), 73 " wanted ", case[[fun]], call. = FALSE) 74 } 75 narm <- paste(fun, ".na.rm", sep = "") 76 if (!is.null(case[[narm]])) { 77 if (!identical(case[[narm]], 78 run(f, case$input, na.rm = TRUE))) { 79 cat("input: "); dput(case$input) 80 stop(narm, " returned ", run(f, case$input, na.rm = TRUE), 81 " wanted ", case[[narm]], call. = FALSE) 82 } 83 } 84 } 85 lab <- deparse(substitute(L)) 86 for (case in L) { 87 do_check(case, any) 88 do_check(case, all) 89 } 90} 91 92do_tests(basic_tests) 93do_tests(list_input_tests) 94