использование функции uniroot с трубками dplyr - PullRequest
Новая
       25

использование функции uniroot с трубками dplyr

0 голосов
/ 30 мая 2018

Я пытаюсь использовать функцию uniroot внутри схемы трубопровода.У меня есть корневые данные по глубине, и я подгоняю модель для каждого набора года урожая и помещаю подогнанный параметр (A в этом примере) в таблицу.Ниже приведен упрощенный набор данных: 

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

Я хочу добавить столбец, который сообщает мне значение x моей функции при y = 0.5.Следующий код работает как отдельный.

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

Если я попытаюсь поместить его в схему трубопроводов, используя dplyr mutate или do, это не сработает.

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

Ответы [ 2 ]

0 голосов
/ 30 мая 2018

Вы можете использовать purrr::map, чтобы построить столбец списка с результатами (приведите его к data.frame), затем tidyr::unnest, чтобы распределить его по столбцам ... 

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
0 голосов
/ 30 мая 2018

Функция uniroot не векторизована по своим аргументам.Такие функции, как sqrt: 

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

, но 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

и mutate основаны на векторизации вычислений.

Использование lapply перебрать любой вектор и вызвать функцию, подобную этой: 

> 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

Затем используйте стандартные функции R, чтобы вернуть эти данные в ваш фрейм данных, если вы этого хотите.

...