Question

我很感激将用户定义的功能转换为使用mapply与tibble rowwise一起使用所需的任何提示提示或咒语。

这个可重复性最小的示例建立在问题described here上。

具体来说，我有一个函数调用uniroot，可以与mapply一起使用。但是，当它与tibble / data-frame一起使用时会中断。

values <- tibble(a=1:3, b=4:6)
class(values)

f_1 <- function(a, x = x_default, b = b_default, y = y_default, ...){
  x - a
}

f_2 <- function(a, x, b, y){
  value_a   <- uniroot(f_1, lower=-b*100, upper=b * 100, extendInt="no", tol=0.0001, trace = 20, maxiter=1000, check.conv=TRUE,
                          x=x, b=b, y=y)
}

newCF <- partial(f_2, x=10 , y=15)
values %>% 
  mutate( newCF( a = values$a, b = values$b ) )

x=10
y=15
mapply( f_2, values$a, x=x, values$b, y=y )

mapply的结果是：

> mapply( f_2, values$a, x=x, values$b, y=y )
       [,1] [,2] [,3]
root       10   10   10
f.root     0    0    0
iter       1    1    1
init.it    NA   NA   NA
estim.prec 410  510  610

使用tibble的结果是：

> values %>%
+   mutate( newCF( a = values$a, b = values$b ) )
Error in mutate_impl(.data, dots) :
  Evaluation error: f() values at end points not of opposite sign.
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
7: doTryCatch(return(expr), name, parentenv, handler)
6: tryCatchOne(expr, names, parentenv, handlers[[1L]])
5: tryCatchList(expr, classes, parentenv, handlers)
4: tryCatch(.External2(C_zeroin2, function(arg) f(arg, ...), lower,
       upper, f.lower, f.upper, tol, as.integer(maxiter)), warning = function(w) w)
3: uniroot(f_1, lower = -b * 100, upper = b * 100, extendInt = "no",
       tol = tolerance, trace = 20, maxiter = 1000, check.conv = TRUE,
       x = x, b = b, y = y) at #2
2: (function (a, x, b, y)
   {
       value_a <- uniroot(f_1, lower = -b * 100, upper = b * 100,
           extendInt = "no", tol = tolerance, trace = 20, maxiter = 1000,
           check.conv = TRUE, x = x, b = b, y = y)
   })(dots[[1L]][[1L]], x = dots[[2L]][[1L]], dots[[3L]][[1L]],
       y = dots[[4L]][[1L]])

Answer 1

该解决方案无需使用partial，如下所示：

library(purr)
values %>% 
  bind_cols(pmap_df(list(a=.$a, b=.$b), f_2, x=10 , y=15))

希望能有所帮助。

将函数从mapply迁移到tizble rowwise

1 个答案: