Purrr безопасно создает списки списков

Я использовал safely, чтобы поймать ошибку, которая возникает в моем коде, когда я мурлычу. Однако результат safely намного сложнее, чем я ожидал.

Сначала мы создаем необходимые функции и примеры данных.

#base functions.
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))
}


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
}

#Creating the function which will display errors.
safe_new.topheight <- safely(new.topheight)

#Creating data
my.age <- seq(0,100, by=0.2)
my.si <- c(15)

si.crossing <- tidyr::crossing(my.si, my.age) %>% data.frame()


#Creating the column to be unnested.
si.crossing2<- si.crossing %>% 
 mutate(height=map2(my.si,my.age, safe_new.topheight))

Тем не менее, результат становится сложным для меня, чтобы разложить - я даже не знаю, насколько далеко заходит вложенность списков в столбце «высота». Вот вывод первых 5 строк в моих данных:

structure(list(my.si = c(15, 15, 15, 15, 15), my.age = c(0, 0.2, 
0.4, 0.6, 0.8), height = list(list(result = NULL, error = structure(list(
    message = "L-BFGS-B needs finite values of 'fn'", call = optim(par = list(topheight = 10), 
        method = "L-BFGS-B", fn = SI_tall, si = my.si, age = my.age, 
        lower = 0, upper = 100)), class = c("simpleError", "error", 
"condition"))), list(result = c(topheight = 0.000693170450744849), 
    error = NULL), list(result = c(topheight = 0.00205917508142004), 
    error = NULL), list(result = c(topheight = 0.00390099534708239), 
    error = NULL), list(result = c(topheight = 0.00639475141226834), 
    error = NULL))), row.names = c(NA, 5L), class = "data.frame")

Есть ли способ сгладить это до столбцов:

my.si, my.age, topheight, error.

Большое спасибо!


person Silviculturalist    schedule 20.05.2020    source источник


Ответы (1)


Может быть полезно различать safely и possibly. safely здорово видеть, какая ошибка произошла (и где). Лучше всего использовать с transpose, а не внутри tibble. possibly используется для запуска функции map, даже если она вызывает ошибку. Он позволяет выбрать альтернативное значение otherwise в случае возникновения ошибки.

# use `transpose` on the height column to turn the list inside out
# which results in two lists `result` and `error`
# first lets have a look at the structure
si.crossing2$height %>% 
  transpose %>% 
  str 

# then `pluck` the `error` list and remove all elements which are NULL 
# with `compact` - here you can see the error that occurred
si.crossing2$height %>% 
  transpose %>% 
  pluck("error") %>% 
  compact

# `safely` is a great function to see what went wrong
# but its not very useful inside a tibbles list-column
# what you actually want to use is `possibly`

possib_new.topheight <- possibly(new.topheight, otherwise = NA)

# this will not tell you what went wrong, but instead yield `NA`
# when an error is thrown - important to use `otherwise = NA`, 
# the default is NULL, which makes the output list shorter and
# won't fit to your tibble
si.crossing3 <- si.crossing %>% 
  mutate(height = map2_dbl(my.si,my.age, possib_new.topheight))

si.crossing3

#> # A tibble: 501 x 3
#>    my.si my.age    height
#>    <dbl>  <dbl>     <dbl>
#>  1    15    0   NA       
#>  2    15    0.2  0.000693
#>  3    15    0.4  0.00206 
#>  4    15    0.6  0.00390 
#>  5    15    0.8  0.00639 
#>  6    15    1    0.00947 
#>  7    15    1.2  0.0131  
#>  8    15    1.4  0.0172  
#>  9    15    1.6  0.0218  
#> 10    15    1.8  0.0269  
#> # … with 491 more rows
person TimTeaFan    schedule 20.05.2020
comment
Спасибо, я всегда забываю, какой из них использовать! - person Silviculturalist; 21.05.2020