Thanks: [R] short puzzles
Marc Vandemeulebroecke
vandemem at gmx.de
Fri Jul 11 17:12:54 CEST 2003
Thanks to Andy Liaw, Patrick Burns, Sundar Dorai-Raj and Matthiew Wiener for
the answers to my puzzles. Here is a summary:
****************** The original question: ******************
> Dear R users,
>
> can someone help with these short puzzles?
>
> 1) Is there a function like outer() that evaluates a three-argument
> function
> on a threedimensional grid - or else how to define such a function, say,
> outer.3()? E.g., calculate (x/y)^z on (x,y,z) element of
> {1,2,3}x{3,4}x{4,5}
> and
> return the results in a 3-dimensional array. I would naively use outer()
> on
> two of the arguments within a for() loop for the third argument and
> somehow
> glue the array together. Is there a better way? What about outer.4(), or
> even
> outer.n(), generalizing outer() to functions with an arbitrary number of
> arguments?
>
> 2)
> Define a function dimnames.outer() such that dimnames.outer(x, y, "*")
> returns, for x <- 1:2, y <- 2:3, the following matrix:
>
> y
> x 2 3
> 1 2 3
> 2 4 6
>
> (Or does such such a function already exist?)
>
> 3)
>
> How to combine puzzle 1 and puzzle 2? A function dimnames.outer.n() would
> be
> a nice little tool.
>
> 4)
>
> How can I access, within a function, the name of a variable that I have
> passed to the function? E.g., letting a <- 2, and subsequently calling
> function
> f(a) as defined below,
>
> f <- function (x) {
> # How can I get "a" out of x?
> }
>
> 5)
>
> Finally: Letting x <- 2, how can I transform "x+y" into "2+y" (as some
> suitable object), or generally "func(x,y)" into "func(2,y)"?
>
> Many thanks,
> Marc
>
******************** Answer to 5 **********************
The solution is of course
substitute(func(x, y), list(x = 2))
******************** Answer to 4 **********************
This was easy, too:
deparse(substitute(x))
************* Answer to 1 in easy situations ****************
Where the three arguments are easily isolated, outer() can be used twice:
outer(outer(a,b, "/"),c,"^")
**************** Answer to 1, 2 and 3 ******************
A valuable idea came from Sundar Dorai-Raj who uses expand.grid() and then
transforms the grid into a matrix. Here is his code:
outer.3 <- function(x, y, z, FUN, ...) {
print(deparse(substitute(x))) # for question 2
n.x <- NROW(x)
n.y <- NROW(y)
n.z <- NROW(z)
nm.x <- if(is.array(x)) dimnames(x)[[1]] else names(x)
nm.y <- if(is.array(y)) dimnames(y)[[1]] else names(y)
nm.z <- if(is.array(z)) dimnames(z)[[1]] else names(z)
X <- expand.grid(x = x, y = y, z = z)
f <- FUN(X$x, X$y, X$z, ...)
array(f, dim = c(n.x, n.y, n.z),
dimnames = list(nm.x, nm.y, nm.z))
}
a <- 1:3
b <- 3:4
c <- 4:5
names(a) <- a
names(b) <- b
names(c) <- c
outer.3(a, b, c, function(x, y, z) (x/y)^z)
outer.3(as.matrix(a), as.matrix(b), as.matrix(c),
function(x, y, z) (x/y)^z)
Finally, I have included the following code in my Rprofile. Here only vector
arguments are allowed, the dimnames are handeled in a slightly different
manner, and the choice of creating dimnames is controlled by the logical
argument dn.
outer.2 <- function (x, y, f, dn=TRUE, ...) {
if (!(is.vector(x) && is.vector(y) && is.numeric(x) && is.numeric(y))) {
stop("arguments not numeric vectors")
}
### The suitability of f is not checked ###
result <- outer(x, y, f, ...)
if (dn) {
lab.x <- deparse(substitute(x))
lab.y <- deparse(substitute(y))
dimnames(result) <- list(x, y)
names(dimnames(result)) <- c(lab.x, lab.y)
}
result
}
outer.3 <- function(x, y, z, f, dn=TRUE, ...) {
if (!(is.vector(x) && is.vector(y) && is.vector(z)
&& is.numeric(x) && is.numeric(y) && is.numeric(z))) {
stop("arguments not numeric vectors")
}
### The suitability of f is not checked ###
X <- expand.grid(x=x, y=y, z=z)
temp <- f(X$x, X$y, X$z, ...)
result <- array(temp, dim = c(length(x), length(y), length(z)))
if (dn) {
lab.x <- deparse(substitute(x))
lab.y <- deparse(substitute(y))
lab.z <- deparse(substitute(z))
dimnames(result) <- list(x, y, z)
names(dimnames(result)) <- c(lab.x, lab.y, lab.z)
}
result
}
A similar function outer.4() is straightforward.
--
Jetzt ein- oder umsteigen und USB-Speicheruhr als Prämie sichern!
More information about the R-help
mailing list