1

I am working with R. I am trying to replicate the answer provided from this stackoverflow post over here: How can I plot 3D function in r?

Using the "lattice" library in R, I am trying to create a 3D surface plot of "input_1", "input_2", "input_3" - and color the surface according to values of "final_value".

I created a function for this problem:

my_function_b <- function(input_1, input_2, input_3, input_4) {
    
    final_value = sin(input_1) + cos(input_2) + input_3 + input_4
    
}

Then, I assigned each "input" from this function a series of values:

input_1 <- seq(-10, 10, length= 30)
input_2 <- input_1
input_3 <- input_1
input_4 <- input_1

Next, I try to use the "outer" function:

z <- outer(input_1, input_2, input_3, my_function_b)

But this returns the following error:

Error in get(as.character(FUN), mode = "function", envir = envir) : 
  object 'input_3' of mode 'function' was not found

Can someone please show me what I am doing wrong?

Thanks

Additional References:

stats_noob
  • 5,401
  • 4
  • 27
  • 83

1 Answers1

2

outer takes only two arguments. We may need pmap

library(purrr)
pmap_dbl(list(input_1, input_2, input_3, input_4), my_function_b)

or Map/mapply

mapply(my_function_b, input_1, input_2, input_3, input_4)

If we need all combinations, create the combinations with expand.grid and apply over the rows

tmp <- expand.grid(input_1 = input_1, input_2 = input_2, 
     input_3 = input_3, input_4 = input_4)
out <- apply(tmp, 1, 
       FUN = function(x) do.call(my_function_b, as.list(x)))

Or may speed up with dapply from collapse

library(collapse)

out1 <- dapply(tmp, MARGIN = 1, FUN = function(x) 
            my_function_b(x[1], x[2], x[3], x[4]))

Perhaps, we create the combinations on two vectors, and then add ?

my_function_b <- function(input_1, input_2) sin(input_1) + cos(input_2)
tmp1 <- outer(input_1, input_2, my_function_b)
z <- tmp1 + input_3[col(tmp1)] + input_4[col(tmp1)]
library(lattice)
wireframe(z, drape=TRUE, col.regions=rainbow(100))

-output

enter image description here

akrun
  • 874,273
  • 37
  • 540
  • 662
  • Thank you for your reply! I tried to run your code "out <- apply(expand.grid(input_1 = input_1, input_2 = input_2, input_3 = input_3, input_4 = input_4), 1, FUN = function(x) do.call(my_function_b, as.list(x))) " ... it has been a few minutes and the code is still running. Is this to be expected? thank you so much for your help! – stats_noob Jul 24 '21 at 20:27
  • @Noob For me, it took `user system elapsed 5.615 0.075 5.631`. and the `length(out)# [1] 810000`. It is only because you have 4 vector combinations – akrun Jul 24 '21 at 20:29
  • @Noob Can you try with `dapply`, It took me only ` user system elapsed 1.673 0.050 1.721` – akrun Jul 24 '21 at 20:36
  • @noob Maybe you system is less powerful. You could still use `outer` though, but your function takes 4 arguments at a time. i.e. `outer(1:3, outer(1:3, 1:3, FUN = `+`), FUN = `+`)`, returns an array with a recursive outer – akrun Jul 24 '21 at 20:45
  • I will give you the points for this question since you have spent so much time trying to solve this problem. I never knew this would be such a difficult problem. I am trying to make a 3d surface plot with "input_1", "input_2", "input_3" (ignore "input_4) ... and color the surface according to "final_value". Do you think you can help me do this if you have time? – stats_noob Jul 24 '21 at 20:46
  • @Noob What i think based on the linked post is that your function should take two arguments `my_function_b <- function(input_1, input_2) { sin(input_1) + cos(input_2)}` and then `+` would be on the recursive outer i.e. `tmp1 <- outer(input_1, input_2, my_function_b); outer(tmp1, input_3, FUN = "+")` – akrun Jul 24 '21 at 20:48
  • @Noob Do you need something like in the update figure – akrun Jul 24 '21 at 20:59
  • 1
    thank you for all your help - I am trying to do something like this: https://stackoverflow.com/questions/68513888/r-coloring-plotly-plots-according-to-another-variable - can you please take a look at it if you have time? thank you for all your help - I really appreciate it – stats_noob Jul 24 '21 at 21:21