using the uniroot function with dplyr pipes

Question

I'm trying to utilize the uniroot function inside a piping scheme. I have root data by depth, and I fit a model for each crop-year set and put the fitted parameter (A in this example) into a tibble. A simplified dataset is below:

mydat <- tribble(
  ~crop, ~year,  ~A,
  "corn", 2011,  4,
  "corn", 2012,  8.5,
  "soy",  2011,  4.2
)

I want to add a column that tells me the x value of my function at y = 0.5. The following code works as a stand-alone.

myfunc <- function(x, y, A) {2 + A * x - y}
uniroot(myfunc, y = 0.5, A = 4, lower = 0, upper = 10, extendInt = "yes")

If I try to put it into a piping scheme using dplyr's mutate or do, it doesn't work.

mydat %>% 
    mutate(x50 = uniroot(myfunc, y = 0.5, A = .$A, lower = 0, upper = 10,
                         extendInt = "yes"))

mydat %>% 
    do(x50 = uniroot(myfunc, y = 0.5, A = .$A, lower = 0, upper = 10,
                     extendInt = "yes"))

Answer 1

The uniroot function is not vectorised over its arguments. Functions like sqrt are:

> sqrt(c(1,2,3))
[1] 1.000000 1.414214 1.732051

but uniroot isnt:

> uniroot(myfunc, y = 0.5, A = c(1,2,3),  lower = 0, upper = 10, extendInt = "yes")
Error in uniroot(myfunc, y = 0.5, A = c(1, 2, 3), lower = 0, upper = 10,  : 
  did not succeed extending the interval endpoints for f(lower) * f(upper) <= 0
In addition: Warning messages:
1: In if (is.na(f.lower)) stop("f.lower = f(lower) is NA") :
  the condition has length > 1 and only the first element will be used
2: In if (is.na(f.upper)) stop("f.upper = f(upper) is NA") :
  the condition has length > 1 and only the first element will be used

and mutate relies on having vectorised computation.

Use lapply to iterate over any vector and call a function like this:

> lapply(mydat$A, function(a){uniroot(myfunc, y = 0.5, A = a, lower = 0, upper = 10, extendInt = "yes")$root})
[[1]]
[1] -0.375

[[2]]
[1] -0.1764706

[[3]]
[1] -0.3571429

Then use standard R functions to put that data back in your data frame if that's where you want it.

Answer 2

You could use purrr::map to build a list column with the results (coercing it to a data.frame), then tidyr::unnest to spread it out into columns...

library(tibble)
library(dplyr)
library(purrr)
library(tidyr)

mydat <- tribble(
  ~crop, ~year,  ~A,
  "corn", 2011,  4,
  "corn", 2012,  8.5,
  "soy",  2011,  4.2
)

myfunc <- function(x, y, A) {2 + A * x - y}

mydat %>% 
  mutate(x50 = map(A, function(x) {
    as.data.frame(uniroot(myfunc, y = 0.5, A = x, lower = 0, upper = 10, 
                          extendInt = "yes"))
    })) %>% 
  unnest()

# # A tibble: 3 x 8
#   crop   year     A   root   f.root  iter init.it    estim.prec
#   <chr> <dbl> <dbl>  <dbl>    <dbl> <int>   <int>         <dbl>
# 1 corn  2011.  4.00 -0.375 0.          20      19 52439.       
# 2 corn  2012.  8.50 -0.176 2.22e-16    20      18     0.0000610
# 3 soy   2011.  4.20 -0.357 2.22e-16    21      19     0.0000610

Answer 3

The solution with dplyr is

data |>
rowwise() |>
mutate(var_name = uniroot(f, c(lower_limit, upper_limit), vars_from_data)$root)