使用带有dplyr管道的{uniroot函数

时间:2018-05-30 17:03:31

标签: r function dplyr magrittr

我正在尝试在管道方案中使用uniroot功能。我有深度的根数据,我为每个作物年集合拟合一个模型,并将拟合参数(本例中的A)放入一个tibble。简化数据集如下:

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

我想添加一个列,告诉我y = 0.5时函数的x值。以下代码作为独立的代码使用。

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

如果我尝试使用dplyr的mutate将其置于管道方案中,或者这样做,它就不起作用了。

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 :(得分:3)

uniroot函数不会对其参数进行矢量化。像sqrt这样的函数是:

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

uniroot不是:

> 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函数将数据放回数据框中,如果它在您想要的地方。

答案 1 :(得分:0)

您可以使用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