apply.Rout.save 6.69 KB
Newer Older
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 31 32 33 34 35 36 37 38
pqR version 2.15.0 (2014-00-00), based on R 2.15.0 (2012-03-30)

R 2.15.0 is Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0

Modifications to R in pqR are Copyright (C) 2013-2014 Radford M. Neal

Some modules are from R-2.15.1 or later versions distributed by the R Core Team

Platform: x86_64-unknown-linux-gnu (64-bit)
No helper threads, task merging enabled.

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.

> # 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")

39
-- lapply:
40
> print(lapply(L,f1))
41 42 43 44 45 46 47 48 49
$a
[1] 4.23

$b
[1] 9.23

$c
[1] 17.23

50
> print(lapply(L,f2,101.23))
51 52 53 54 55 56 57 58 59
$a
[1] 104.23

$b
[1] 109.23

$c
[1] 117.23

60 61
> 
> cat("\n-- vapply:\n")
62 63

-- vapply:
64
> print(vapply(L,f1,numeric(1)))
65 66
    a     b     c 
 4.23  9.23 17.23 
67
> print(vapply(L,f2,numeric(1),101.23))
68 69
     a      b      c 
104.23 109.23 117.23 
70 71
> 
> cat("\n-- eapply:\n")
72 73

-- eapply:
74
> print(eapply(as.environment(L),f1))
75 76 77 78 79 80 81 82 83
$c
[1] 17.23

$b
[1] 9.23

$a
[1] 4.23

84
> print(eapply(as.environment(L),f2,101.23))
85 86 87 88 89 90 91 92 93
$c
[1] 117.23

$b
[1] 109.23

$a
[1] 104.23

94 95
> 
> cat("\n-- apply:\n")
96 97

-- apply:
98 99
> M <- matrix (1:12, 3, 4)
> print(M)
100 101 102 103
     [,1] [,2] [,3] [,4]
[1,]    1    4    7   10
[2,]    2    5    8   11
[3,]    3    6    9   12
104
> print(apply(M,1,f1))
105
[1] 23.23 27.23 31.23
106
> print(apply(M,2,f1))
107
[1]  7.23 16.23 25.23 34.23
108
> print(apply(M,1,f2,101.23))
109
[1] 123.23 127.23 131.23
110
> print(apply(M,2,f2,101.23))
111
[1] 107.23 116.23 125.23 134.23
112 113
> A <- array (1:12, c(2,2,3))
> print(A)
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
, , 1

     [,1] [,2]
[1,]    1    3
[2,]    2    4

, , 2

     [,1] [,2]
[1,]    5    7
[2,]    6    8

, , 3

     [,1] [,2]
[1,]    9   11
[2,]   10   12

132
> print(apply(A,1,f1))
133
[1] 37.23 43.23
134
> print(apply(A,2,f1))
135
[1] 34.23 46.23
136
> print(apply(A,3,f1))
137
[1] 11.23 27.23 43.23
138
> print(apply(A,c(1,3),f1))
139 140 141
     [,1]  [,2]  [,3]
[1,] 5.23 13.23 21.23
[2,] 7.23 15.23 23.23
142
> print(apply(A,1,f2,101.23))
143
[1] 137.23 143.23
144
> print(apply(A,2,f2,101.23))
145
[1] 134.23 146.23
146
> print(apply(A,3,f2,101.23))
147
[1] 111.23 127.23 143.23
148
> print(apply(A,c(1,3),f2,101.23))
149 150 151
       [,1]   [,2]   [,3]
[1,] 105.23 113.23 121.23
[2,] 107.23 115.23 123.23
152 153 154 155 156 157 158
> 
> # 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")
159 160

-- checking warnings:
161 162 163 164 165 166 167 168 169 170 171 172
> 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))
+     A <- array(-1,c(2,2,2))
+     print(apply(A,2,sqrt))
+ }
Warning in FUN(c(-1, 2, -1)[[1L]]) : NaNs produced
Warning in FUN(c(-1, 2, -1)[[3L]]) : NaNs produced
173 174 175 176 177 178 179 180 181
[[1]]
[1] NaN

[[2]]
[1] 1.414214

[[3]]
[1] NaN

182 183
Warning in FUN(c(-1, 2, -1)[[1L]]) : NaNs produced
Warning in FUN(c(-1, 2, -1)[[3L]]) : NaNs produced
184
[1]      NaN 1.414214      NaN
185 186
Warning in FUN(list(-1, 2, -1)[[1L]]) : NaNs produced
Warning in FUN(list(-1, 2, -1)[[3L]]) : NaNs produced
187 188 189 190 191 192 193 194 195
$c
[1] NaN

$b
[1] 1.414214

$a
[1] NaN

Radford Neal's avatar
Radford Neal committed
196 197 198
Warning in FUN(X[1L, ]) : NaNs produced
Warning in FUN(X[2L, ]) : NaNs produced
Warning in FUN(X[3L, ]) : NaNs produced
199 200 201 202 203
     [,1] [,2] [,3]
[1,]  NaN  NaN  NaN
[2,]  NaN  NaN  NaN
[3,]  NaN  NaN  NaN
[4,]  NaN  NaN  NaN
Radford Neal's avatar
Radford Neal committed
204 205
Warning in FUN(array(X[, 1L], d.call, dn.call)) : NaNs produced
Warning in FUN(array(X[, 2L], d.call, dn.call)) : NaNs produced
206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240
     [,1] [,2]
[1,]  NaN  NaN
[2,]  NaN  NaN
[3,]  NaN  NaN
[4,]  NaN  NaN
[[1]]
[1] NaN

[[2]]
[1] 1.414214

[[3]]
[1] NaN

[1]      NaN 1.414214      NaN
$c
[1] NaN

$b
[1] 1.414214

$a
[1] NaN

     [,1] [,2] [,3]
[1,]  NaN  NaN  NaN
[2,]  NaN  NaN  NaN
[3,]  NaN  NaN  NaN
[4,]  NaN  NaN  NaN
     [,1] [,2]
[1,]  NaN  NaN
[2,]  NaN  NaN
[3,]  NaN  NaN
[4,]  NaN  NaN
There were 11 warnings (use warnings() to see them)
241
> warnings()
242
Warning messages:
Radford Neal's avatar
Radford Neal committed
243
1: In FUN(c(-1, 2, -1)[[1L]]) : NaNs produced
244
2: In FUN(c(-1, 2, -1)[[3L]]) : NaNs produced
Radford Neal's avatar
Radford Neal committed
245
3: In FUN(c(-1, 2, -1)[[1L]]) : NaNs produced
246
4: In FUN(c(-1, 2, -1)[[3L]]) : NaNs produced
Radford Neal's avatar
Radford Neal committed
247
5: In FUN(list(-1, 2, -1)[[1L]]) : NaNs produced
248
6: In FUN(list(-1, 2, -1)[[3L]]) : NaNs produced
Radford Neal's avatar
Radford Neal committed
249 250 251 252 253
7: In FUN(X[1L, ]) : NaNs produced
8: In FUN(X[2L, ]) : NaNs produced
9: In FUN(X[3L, ]) : NaNs produced
10: In FUN(array(X[, 1L], d.call, dn.call)) : NaNs produced
11: In FUN(array(X[, 2L], d.call, dn.call)) : NaNs produced
254 255 256 257 258
> 
> # Test that indexed value is corectly retained when the applied function
> # returns a function that references it.
> 
> cat("\n-- checking function environments:\n")
259 260

-- checking function environments:
261 262 263
> 
> fns <- lapply (11:13, function(x) function () x)
> print(fns)
264 265 266
[[1]]
function () 
x
Radford Neal's avatar
Radford Neal committed
267
<environment: 0x2765be8>
268 269 270 271

[[2]]
function () 
x
Radford Neal's avatar
Radford Neal committed
272
<environment: 0x2765e18>
273 274 275 276

[[3]]
function () 
x
Radford Neal's avatar
Radford Neal committed
277
<environment: 0x27660a8>
278

279
> print(c(fns[[1]](),fns[[2]](),fns[[3]]()))
Radford Neal's avatar
Radford Neal committed
280
[1] 11 12 13
281 282 283
> 
> fns <- vapply (11:13, function(x) list(function () x), list (function () 0))
> print(fns)
284 285 286
[[1]]
function () 
x
Radford Neal's avatar
Radford Neal committed
287
<environment: 0x2557920>
288 289 290 291

[[2]]
function () 
x
Radford Neal's avatar
Radford Neal committed
292
<environment: 0x2557b88>
293 294 295 296

[[3]]
function () 
x
Radford Neal's avatar
Radford Neal committed
297
<environment: 0x2557e18>
298

299
> print(c(fns[[1]](),fns[[2]](),fns[[3]]()))
Radford Neal's avatar
Radford Neal committed
300
[1] 11 12 13
301 302 303
> 
> fns <- eapply (as.environment(list(a=11,b=12,c=13)), function(x) function () x)
> print(fns)
304 305 306
$c
function () 
x
Radford Neal's avatar
Radford Neal committed
307
<environment: 0x1af8280>
308 309 310 311

$b
function () 
x
Radford Neal's avatar
Radford Neal committed
312
<environment: 0x1af84b0>
313 314 315 316

$a
function () 
x
Radford Neal's avatar
Radford Neal committed
317
<environment: 0x1af86e0>
318

319
> print(c(fns[[1]](),fns[[2]](),fns[[3]]()))
Radford Neal's avatar
Radford Neal committed
320
[1] 13 12 11
321 322 323
> 
> fns <- apply (matrix(11:13,3,1), 1, function(x) function () x)
> print(fns)
324 325 326
[[1]]
function () 
x
Radford Neal's avatar
Radford Neal committed
327
<environment: 0x1d3cd30>
328 329 330 331

[[2]]
function () 
x
Radford Neal's avatar
Radford Neal committed
332
<environment: 0x1d3da78>
333 334 335 336

[[3]]
function () 
x
Radford Neal's avatar
Radford Neal committed
337
<environment: 0x1d3e7b8>
338

339
> print(c(fns[[1]](),fns[[2]](),fns[[3]]()))
Radford Neal's avatar
Radford Neal committed
340
[1] 11 12 13
341 342 343
> 
> fns <- apply (array(1:8,c(2,2,2)), 1, function(x) function () x)
> print(fns)
344 345 346
[[1]]
function () 
x
Radford Neal's avatar
Radford Neal committed
347
<environment: 0x179e7c8>
348 349 350 351

[[2]]
function () 
x
Radford Neal's avatar
Radford Neal committed
352
<environment: 0x179ffe8>
353

354
> print(fns[[1]]())
355
     [,1] [,2]
Radford Neal's avatar
Radford Neal committed
356 357
[1,]    1    5
[2,]    3    7
358
> print(fns[[2]]())
359 360 361
     [,1] [,2]
[1,]    2    6
[2,]    4    8
362
>