Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

replace nested loop with expand.grid and call inner function with multiple arguments

Tags:

r

I want to use rollapply function with various combinations of width, by and FUN arguments (width and by should have same value). I've inspired here and created following code which is working but it has nothing to do with rollapply so far, it just demonstrates how to pass several arguments to function inside apply:

> dframe   <- expand.grid(c(1,2,3), c(1,2,3))
> testFunc <- function(a, b) a^2 + b
> apply(dframe, 1, function(x) testFunc(x[1], x[2]))
[1]  2  5 10  3  6 11  4  7 12
> apply(dframe, 1, function(x) x[1]^2 + x[2])
[1]  2  5 10  3  6 11  4  7 12
> apply(dframe, 1, function(x) (x[1]^2 + x[2]))
[1]  2  5 10  3  6 11  4  7 12
> apply(dframe, 1, function(x) {x[1]^2 + x[2]})
[1]  2  5 10  3  6 11  4  7 12

My final solution is here, but this is not working:

> dframe   <- expand.grid(c(1,2,3), c(median, mean))
> testFunc <- function(a, b) rollapply(mtcars, width = a, by = a, FUN = b, align="left")

> apply(dframe, 1, function(x) testFunc(x[1], x[2]))
 Error in get(as.character(FUN), mode = "function", envir = envir) : 
  object 'b' of mode 'function' was not found

> apply(dframe, 1, function(x) rollapply(mtcars, width = x[1], by = x[1], FUN = x[2], align="left"))
 Error in match.fun(FUN) : 'x[2]' is not a function, character or symbol 

When I call testFunc directly everything is working fine so I guess the problem is that apply is not able to collect the results somehow:

> testFunc(10,mean)
       mpg cyl   disp    hp  drat     wt   qsec  vs  am gear carb
[1,] 20.37 5.8 208.61 122.8 3.538 3.1280 18.581 0.6 0.3  3.6  2.5
[2,] 19.89 6.6 259.25 149.6 3.552 3.6689 18.301 0.4 0.3  3.4  2.9
[3,] 20.39 6.2 228.25 152.6 3.654 2.8633 16.914 0.3 0.5  3.9  2.6

> class(testFunc(10,mean))
[1] "matrix"

I've tried also debug testFunc and call it from apply and seems that arguments are passed correctly:

> debug(testFunc)
> apply(dframe, 1, function(x) testFunc(x[1], x[2]))
debugging in: testFunc(x[1], x[2])
debug: rollapply(mtcars, width = a, by = a, FUN = b, align = "left")

Browse[2]> print(a)
$Var1
[1] 1

Browse[2]> print(b)
$Var2
function (x, na.rm = FALSE) 
UseMethod("median")
<bytecode: 0x08244ffc>
<environment: namespace:stats>

Browse[2]> n
Error in get(as.character(FUN), mode = "function", envir = envir) : 
  object 'b' of mode 'function' was not found

Questions:

  1. What is error saying and what I'm doing wrong?
  2. How can I replace nested loop with expand.grid and call inner function with multiple arguments?
  3. How to return list of matrices using *apply family of functions?

PS: I guess it would be easy to achieve this using two nested loops but I'm wondering if there is R-way.

PPS: Here is answer regarding similar error (object 'b' of mode 'function' was not found) with the conclusion that b (in my case) conflicts with the named arguments with other function. But I cannot see this problem in my code.

like image 949
Wakan Tanka Avatar asked Mar 15 '16 17:03

Wakan Tanka


1 Answers

Suppose that df <- data.frame(a = 1:2, b = 3:4) and we apply apply(df, 1, function(x) fun(x)). Then the two passed arguments x are vectors c(1, 3) and c(2, 4).

However, when df <- expand.grid(c(1,2,3), c(median, mean)) and apply(df, 1, function(x) fun(x)) is done, we can no longer store, e.g., 1 and median to a single vector because they are of too different types. Then x happens to be a list, e.g., x <- list(1, median). Then, doing x[1] or x[2] does not give 1 and median as desired; instead these are lists with a single element (hence the error object 'b' of mode 'function' was not found). This can actually be seen in your debugging example.

So, here are some ways to use apply in your case:

1) do not modify testFunc but recognize that a list is passed by apply; in that case do.call helps, but it also cares about the names of the columns of df, so I also use unname:

apply(unname(df), 1, do.call, what = testFunc)

2) same as 1) but without do.call:

apply(dframe, 1, function(x) testFunc(x[[1]], x[[2]]))

3) testFunc redefined to have a single argument:

testFunc <- function(a) rollapply(mtcars, width = a[[1]], by = a[[1]], FUN = a[[2]], align="left")
apply(dframe, 1, testFunc)
like image 112
Julius Vainora Avatar answered Oct 04 '22 03:10

Julius Vainora