在purrr()中使用optim()出错：vmmin不是有限的。

Question

我从另一个工作者那里收到了一个函数，用来计算一棵树在100岁时达到一定高度（SI）所需的高度。我的工作是把这个放到purrr中，计算出若干SI和高度交叉时的高度是什么样子，以便绘制生长轨迹。

首先我创建基础函数。

SI_tall <- function(topheight,  age, si ){
  paramasi <- 25
  parambeta <- 7395.6
  paramb2 <- -1.7829
  refAge <- 100

  d <- parambeta*(paramasi^paramb2)

  r <- (((topheight-d)^2)+(4*parambeta*topheight*(age^paramb2)))^0.5

  ## height at reference age
  h2 <- (topheight+d+r)/ (2+(4*parambeta*(refAge^paramb2)) / (topheight-d+r))

  return(abs(h2 - si))
}

为了计算一棵树的高度，给定树龄和地点指数， 我们在另一个函数中使用这个函数。高度将通过以下方式给出

my.age  <- 10
my.si <- 30

new.topheight <- function(my.si, my.age){
  optim(par = list(topheight = 10), ## this topheight is just an initial value
                       method = 'L-BFGS-B', fn = SI_tall, si = my.si, age = my.age, lower= 0, upper=100)$par
}

这对每个值都能很好地工作.由于我想绘制每棵树的生长轨迹，我首先需要在所需的分辨率下计算年龄和站点指数来绘制。我创建了两个向量来交叉。

my.age <- seq(0,110, by=0.2)
my.si <- c(5,10,15,20,25,30,35)

si.crossing <- tidyr::crossing(my.age, my.si)

si.crossing %>% group_by(my.age, my.si) %>% 
  nest() %>%
  mutate(topheight = map2(.x=my.age, .y=my.si, .f=~new.topheight(my.si=.y, my.age=.x)))

这是我得到的错误：

optim(par = list(topheight = 30), method = "BFGS", fn = SI_tall, : 'vmmin'中的初始值不是有限的，出现错误

到底出了什么问题？非常感谢。

Answer 1

直接传给 map2_dbl 与 tryCatch 来处理错误。

library(dplyr)
library(purrr)

si.crossing %>% 
     mutate(topheight = map2_dbl(my.si, my.age, 
              ~tryCatch(new.topheight(.x, .y), error = function(e) NA)))

或者使用 mapply 在基数R中，我们可以使用

si.crossing$topheight <- mapply(function(x, y) 
     tryCatch(new.topheight(x, y),error = function(e) NA), 
              si.crossing$my.si, si.crossing$my.age)

Answer 2

我们可以使用 possibly 从 purrr

library(purrr)
pnew.topheight <- possibly(new.topheight, otherwise = NA)
si.crossing %>% 
    mutate(topheight = map2_dbl(my.si, my.age, pnew.topheight))