Solve for X row by row

Question

I'll start with what I've done already. I'm looking for a way to solve equation f by changing the b and s parameters for each row, Q and n are constants. I know that apply() works for this type of problem, but that doesn't seem to work for me. The variable that I want to find doesn't give a unique solution.

Q = 0.203
n = 0.014
f <- function(y) (Q - (1/n)*(y*b)*((y*b)/(2*y+b))^(2/3)*sqrt(s))

With these parameters, let's say for b = 0.5 and s = 0.01 using uniroot() I get the following. Which is the result I want.

uniroot(f, lower = 0.000001, upper = 1000000)$root

[1] 0.2328931

(those lower and upper values seemed to work out well for me)

Now what I need is to solve this function for a large dataset.

set.seed(123)
tibble::tibble(b = runif(n = 1000, min = 0.1, max = 1.5),
               s = runif(n = 1000, min = 0.001, max = 5)) %>% 
  dplyr::mutate(yn = uniroot(f, lower = 0.000001, upper = 1000000)$root) %>% 
  head(5)

And this is my desired output.

      b     s    yn
1 0.503 1.37  0.0434
2 1.20  2.97  0.0194
3 0.673 0.802 0.0421
4 1.34  4.27  0.0163
5 1.42  4.24  0.0157

Answer 1

Actually you are very close to the goal. Here is a base R option using Vectorize + do.call which may help you

f <- function(b, s) {
  fn <- function(y) (Q - (1 / n) * (y * b) * ((y * b) / (2 * y + b))^(2 / 3) * sqrt(s))
  uniroot(fn, lower = 0.000001, upper = 1000000)$root
}

df$yn <- do.call(Vectorize(f), df)

such that

> df
# A tibble: 1,000 x 3
       b     s     yn
   <dbl> <dbl>  <dbl>
 1 0.503 1.37  0.0435
 2 1.20  2.97  0.0194
 3 0.673 0.802 0.0422
 4 1.34  4.27  0.0163
 5 1.42  4.24  0.0157
 6 0.164 2.39  0.0912
 7 0.839 3.87  0.0224
 8 1.35  1.48  0.0223
 9 0.872 0.329 0.0468
10 0.739 2.20  0.0289
# ... with 990 more rows

Data

set.seed(123)
df <- tibble::tibble(b = runif(n = 1000, min = 0.1, max = 1.5),
               s = runif(n = 1000, min = 0.001, max = 5))

Answer 2

Consider changing the function to get the 'b', 's' columns from the data and use rowwise

f <- function(y, dat) with(dat, (Q - (1/n)*(y*b)*((y*b)/(2*y+ b))^(2/3)*sqrt(s)))
df1 %>%
    rowwise %>%
    dplyr::mutate(yn = uniroot(f, lower = 0.000001, upper = 1000000, 
            dat = cur_data())$root) %>% 
   ungroup %>%
   head(5)

-output

# A tibble: 5 x 3
#      b     s     yn
#  <dbl> <dbl>  <dbl>
#1 0.503 1.37  0.0434
#2 1.20  2.97  0.0194
#3 0.673 0.802 0.0421
#4 1.34  4.27  0.0163
#5 1.42  4.24  0.0157

---

Or another option is pmap from purrr

library(purrr)
df1 %>%
  mutate(yn = pmap_dbl(select(., b, s), ~
       uniroot(f,  lower = 0.000001, upper = 1000000,
        dat = tibble(b = ..1, s = ..2))$root))

-output

# A tibble: 10,000 x 3
#       b     s     yn
#   <dbl> <dbl>  <dbl>
# 1 0.503 1.37  0.0434
# 2 1.20  2.97  0.0194
# 3 0.673 0.802 0.0421
# 4 1.34  4.27  0.0163
# 5 1.42  4.24  0.0157
# ...

data

set.seed(123)
df1 <- tibble::tibble(b = runif(n = 1000, min = 0.1, max = 1.5),
               s = runif(n = 1000, min = 0.001, max = 5))