apply.R 2.25 KB
 Radford Neal committed Feb 28, 2015 1 2 3 4 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 ``````# Test possible bugs involving the various apply functions. # # Added for pqR, 2015, Radford M. Neal. # Check basic function, with and without extra arguments. f1 <- function (x) sum(x)+1.23 f2 <- function (x,a) sum(x)+a L <- list (a=3, b=c(1,7), c=c(5,2,9)) cat("\n-- lapply:\n") print(lapply(L,f1)) print(lapply(L,f2,101.23)) cat("\n-- vapply:\n") print(vapply(L,f1,numeric(1))) print(vapply(L,f2,numeric(1),101.23)) cat("\n-- eapply:\n") print(eapply(as.environment(L),f1)) print(eapply(as.environment(L),f2,101.23)) cat("\n-- apply:\n") M <- matrix (1:12, 3, 4) print(M) print(apply(M,1,f1)) print(apply(M,2,f1)) print(apply(M,1,f2,101.23)) print(apply(M,2,f2,101.23)) `````` Radford Neal committed Feb 28, 2015 31 32 33 34 35 36 37 38 39 40 ``````A <- array (1:12, c(2,2,3)) print(A) print(apply(A,1,f1)) print(apply(A,2,f1)) print(apply(A,3,f1)) print(apply(A,c(1,3),f1)) print(apply(A,1,f2,101.23)) print(apply(A,2,f2,101.23)) print(apply(A,3,f2,101.23)) print(apply(A,c(1,3),f2,101.23)) `````` Radford Neal committed Feb 28, 2015 41 42 43 44 45 46 47 48 49 50 51 52 53 54 `````` # Check that delayed warnings refer to [[1L]] and [[3L]]. (They don't # if later calls modifiy earlier calls.) The first set of warnings are # the undelayed ones, followed at the end of this script or end of this # section (depending on how it's run) by the delayed versions. cat("\n-- checking warnings:\n") for (w in c(1,0)) { options(warn=w) print(lapply(c(-1,2,-1),sqrt)) print(vapply(c(-1,2,-1),sqrt,numeric(1))) print(eapply(as.environment(list(a=-1,b=2,c=-1)),sqrt)) M <- matrix(-1,3,4) print(apply(M,1,sqrt)) `````` Radford Neal committed Feb 28, 2015 55 56 `````` A <- array(-1,c(2,2,2)) print(apply(A,2,sqrt)) `````` Radford Neal committed Feb 28, 2015 57 ``````} `````` Radford Neal committed Feb 28, 2015 58 ``````warnings() `````` Radford Neal committed Feb 28, 2015 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 `````` # Test that indexed value is corectly retained when the applied function # returns a function that references it. cat("\n-- checking function environments:\n") fns <- lapply (11:13, function(x) function () x) print(fns) print(c(fns[[1]](),fns[[2]](),fns[[3]]())) fns <- vapply (11:13, function(x) list(function () x), list (function () 0)) print(fns) print(c(fns[[1]](),fns[[2]](),fns[[3]]())) fns <- eapply (as.environment(list(a=11,b=12,c=13)), function(x) function () x) print(fns) print(c(fns[[1]](),fns[[2]](),fns[[3]]())) fns <- apply (matrix(11:13,3,1), 1, function(x) function () x) print(fns) print(c(fns[[1]](),fns[[2]](),fns[[3]]())) `````` Radford Neal committed Feb 28, 2015 81 82 83 84 ``````fns <- apply (array(1:8,c(2,2,2)), 1, function(x) function () x) print(fns) print(fns[[1]]()) print(fns[[2]]())``````