逐行求解X

Question

我將從我已經做過的開始。 我正在尋找一種通過更改每行的b和s參數來求解方程f的方法， 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

（那些較低和較高的值似乎對我來說效果很好）

現在我需要為一個大型數據集解決這個 function。

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)

這是我想要的 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

考慮更改rowwise以從數據中獲取“b”、“s”列並按行使用

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

---

或者另一種選擇是來自purrr的pmap

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

Answer 2

實際上，您已經非常接近目標了。 這是使用Vectorize + do.call的基本 R 選項，它可以幫助您

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