any-all.Rout.save 3.8 KB
Newer Older
1

2
R version 3.3.1 RC (2016-06-14 r70774) -- "Bug in Your Hair"
3 4
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> basic_tests <- list(
+      list(input=c(TRUE, FALSE), any=TRUE, all=FALSE),
+      list(input=c(FALSE, TRUE), any=TRUE, all=FALSE),
+ 
+      list(input=c(TRUE, TRUE), any=TRUE, all=TRUE),
+      list(input=c(FALSE, FALSE), any=FALSE, all=FALSE),
+ 
+      list(input=c(NA, FALSE), any=NA, all=FALSE, any.na.rm=FALSE),
+      list(input=c(FALSE, NA), any=NA, all=FALSE, any.na.rm=FALSE),
+ 
+      list(input=c(NA, TRUE), any=TRUE, all=NA, all.na.rm=TRUE),
+      list(input=c(TRUE, NA), any=TRUE, all=NA, all.na.rm=TRUE),
+ 
+      list(input=logical(0), any=FALSE, all=TRUE),
+ 
+      list(input=NA, any=NA, all=NA, any.na.rm=FALSE, any.na.rm=TRUE),
+ 
+      list(input=c(TRUE, NA, FALSE), any=TRUE, any.na.rm=TRUE,
+           all=FALSE, all.na.rm=FALSE)
+      )
> 
> ## any, all accept '...' for input.
> list_input_tests <-
+     list(
+          list(input=list(TRUE, TRUE), all=TRUE, any=TRUE),
+          list(input=list(FALSE, FALSE), all=FALSE, any=FALSE),
+          list(input=list(TRUE, FALSE), all=FALSE, any=TRUE),
+          list(input=list(FALSE, TRUE), all=FALSE, any=TRUE),
+ 
+          list(input=list(FALSE, NA),
+               all=FALSE, all.na.rm=FALSE, any=NA, any.na.rm=FALSE),
+          list(input=list(NA, FALSE),
+               all=FALSE, all.na.rm=FALSE, any=NA, any.na.rm=FALSE),
+ 
+          list(input=list(TRUE, NA),
+               all=NA, all.na.rm=TRUE, any=TRUE, any.na.rm=TRUE),
+          list(input=list(NA, TRUE),
+               all=NA, all.na.rm=TRUE, any=TRUE, any.na.rm=TRUE),
+ 
+          list(input=list(NA, NA),
+               any=NA, any.na.rm=FALSE, all=NA, all.na.rm=TRUE),
+ 
+          list(input=list(rep(TRUE, 2), rep(TRUE, 10)),
+               all=TRUE, any=TRUE),
+ 
+          list(input=list(rep(TRUE, 2), c(TRUE, NA)),
+               all=NA, all.na.rm=TRUE, any=TRUE),
+ 
+          list(input=list(rep(TRUE, 2), c(TRUE, FALSE)),
+               all=FALSE, any=TRUE),
+ 
+          list(input=list(c(TRUE, FALSE), c(TRUE, NA)),
+               all=FALSE, all.na.rm=FALSE, any=TRUE, any.na.rm=TRUE)
+          )
> 
> 
> 
> do_tests <- function(L)
+ {
+     run <- function(f, input, na.rm = FALSE)
+     {
+         if (is.list(input))
+             do.call(f, c(input, list(na.rm = na.rm)))
+         else f(input, na.rm = na.rm)
+     }
+ 
+     do_check <- function(case, f)
+     {
+         fun <- deparse(substitute(f))
+         if (!identical(case[[fun]], run(f, case$input))) {
+             cat("input: "); dput(case$input)
+             stop(fun, " returned ", run(f, case$input),
+                  " wanted ", case[[fun]], call. = FALSE)
+         }
+         narm <- paste(fun, ".na.rm", sep = "")
+         if (!is.null(case[[narm]])) {
+             if (!identical(case[[narm]],
+                            run(f, case$input, na.rm = TRUE))) {
+                 cat("input: "); dput(case$input)
+                 stop(narm, " returned ", run(f, case$input, na.rm = TRUE),
+                      " wanted ", case[[narm]], call. = FALSE)
+             }
+         }
+     }
+     lab <- deparse(substitute(L))
103
+     for (case in L) {
104 105 106 107 108 109 110 111
+         do_check(case, any)
+         do_check(case, all)
+     }
+ }
> 
> do_tests(basic_tests)
> do_tests(list_input_tests)
>