Решите для X построчно

Question

Начну с того, что я уже сделал. Я ищу способ решить уравнение f , изменив параметры b и s для каждой строки, Q и n являются константами. Я знаю, что apply() работает для такого типа проблем, но, похоже, это не работает для меня. Переменная, которую я хочу найти, не дает уникального решения.

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

С этими параметрами, скажем, для b = 0.5а также s = 0.01используя uniroot(), я получаю следующее. Какого результата я хочу.

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

[1] 0.2328931

(эти нижние и верхние значения, похоже, хорошо сработали для меня)

Теперь мне нужно решить эту функцию для большого набора данных.

      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)

И это мой желаемый результат.

            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

На самом деле вы очень близки к цели. Вот базовый вариант R, использующий Vectorize+ do.callчто может помочь вам

      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)

такой, что

      > 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

Данные

      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

Рассмотрите возможность изменения функции, чтобы получить столбцы «b», «s» из данных и использовать 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)

-выход

      # 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

---

Или еще такой вариант pmapиз 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))

-выход

      # 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
# ...

данные

      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))