logo标签列表

如何从 purrr 中安全地提取结果？

rpurrr
5

数据

以下是示例数据集：

> dput(veh)
structure(list(Vehicle.ID2 = c("857-850", "857-850", "857-850", 
"857-850"), svel = c(12.21277, 12.22125, 12.2362, 12.26268), 
    frspacing = c(10.73435, 10.64279, 10.54999, 10.45493), Local.Y = c(394.76339, 
    395.98552, 397.20914, 398.43541), PrecVehLocalY = c(409.70444, 
    410.83501, 411.96583, 413.09704), CC0 = c(4.1374232, 4.1374232, 
    4.1374232, 4.1374232), CC8 = c(1.75, 1.75, 1.75, 1.75), CC9 = c(1.04, 
    1.04, 1.04, 1.04), PrecVehLength = c(4.2067, 4.2067, 4.2067, 
    4.2067)), .Names = c("Vehicle.ID2", "svel", "frspacing", 
"Local.Y", "PrecVehLocalY", "CC0", "CC8", "CC9", "PrecVehLength"
), class = c("tbl_df", "data.frame"), row.names = c(NA, -4L))

我想做的事情：

我正在将以下函数应用于数据框 veh：

apply_W99 <- function(df){
  for( i in ( seq_len( nrow(df)-1 ) + 1 ) ) {
    if( i <= 2L ) {
      df$Un_dt_1[i] <- df$svel[i-1] * 3.6 + 
        3.6 * ( df$CC8[i] + ( df$CC8[i] - df$CC9[i] ) * 
                  df$svel[i-1] * 3.6 / 80 ) * 0.1
      df$Un_dt_2[i] <- 3.6 * ( df$frspacing[i-1] - df$CC0[i] ) / 0.1
    } else {
      df$Un_dt_1[i] <- df$Un_dt[i-1] + 
        3.6 * ( df$CC8[i] + ( df$CC8[i] - df$CC9[i] ) * 
                  df$Un_dt[i-1] / 80 ) * 0.1
      df$Un_dt_2[i] <- 3.6 * ( df$pred_frspacing[i-1] - df$CC0[i] ) / 0.1
    }
    df$Un_dt[i] <- pmin( df$Un_dt_1[i], df$Un_dt_2[i] )
    if( i <= 2 ) {
      df$pred_Local.Y[i] <- df$Local.Y[i-1] + 
        0.5 * ( ( df$Un_dt[i] + df$svel[i-1] ) / 3.6 ) * 0.1
    } else {
      df$pred_Local.Y[i] <- df$pred_Local.Y[i-1] + 
        0.5 * ( ( df$Un_dt[i] + df$Un_dt[i-1] ) / 3.6 ) * 0.1
    }

    df$pred_frspacing[i] <- df$PrecVehLocalY[i] - df$pred_Local.Y[i] - df$PrecVehLength[i]
  }
  return(df)
}

请注意，原始数据框具有多个Vehicle.ID2。我使用了tidyr和purrr来应用此函数。此外，我正在使用purrr中的safely函数来收集结果和错误。
library(tidyr)
foob <- veh %>%
  group_by(Vehicle.ID2) %>% 
  nest()

library(purrr)
foos <- foob %>% 
  mutate(joo = map(data, safely(apply_W99)))

这很好用。现在，我想要获取结果。safely会创建一个包含result和error的列表。对于示例数据：

> dput(foos$joo)
list(structure(list(result = structure(list(svel = c(12.21277, 
12.22125, 12.2362, 12.26268), frspacing = c(10.73435, 10.64279, 
10.54999, 10.45493), Local.Y = c(394.76339, 395.98552, 397.20914, 
398.43541), PrecVehLocalY = c(409.70444, 410.83501, 411.96583, 
413.09704), CC0 = c(4.1374232, 4.1374232, 4.1374232, 4.1374232
), CC8 = c(1.75, 1.75, 1.75, 1.75), CC9 = c(1.04, 1.04, 1.04, 
1.04), PrecVehLength = c(4.2067, 4.2067, 4.2067, 4.2067), Un_dt_1 = c(NA, 
44.73644328054, 45.5093762168213, 46.2847786738341), Un_dt_2 = c(NA, 
237.489364799999, 249.715278159729, 245.301888411047), Un_dt = c(NA, 
44.73644328054, 45.5093762168213, 46.2847786738341), pred_Local.Y = c(NA, 
395.554351295563, 396.807765455249, 398.082684273174), pred_frspacing = c(NA, 
11.0739587044369, 10.9513645447513, 10.8076557268256)), .Names = c("svel", 
"frspacing", "Local.Y", "PrecVehLocalY", "CC0", "CC8", "CC9", 
"PrecVehLength", "Un_dt_1", "Un_dt_2", "Un_dt", "pred_Local.Y", 
"pred_frspacing"), row.names = c(NA, -4L), class = c("tbl_df", 
"data.frame")), error = NULL), .Names = c("result", "error")))

我该如何将结果部分作为新的数据框提取出来？
我尝试使用 foos <- unnest(foos, map(joo, transpose())) 但是并没有成功。

你可以直接索引它，假设你知道它在哪里：foos$joo[[1]]$result - alistaire
@alistaire，这是一个好建议，我确实尝试过了。但是当“result”为“NULL”时，它会抛出一个错误，因为“NULL”不是数据框。 - umair durrani
我猜你可以使用 purrr 来简化它：foos %>% select(joo) %>% as.list() %>% map(1) %>% map_df('result')。老实说，我会先清理一下函数，这样你就不必处理错误了。 - alistaire
@alistaire，使用map(1)将输出减少到第一个Vehicle.ID2。它适用于示例数据。但对于具有多个Vehicle.ID2的完整数据集，由于数据问题，存在一些结果为NULL。我想在一个数据框中保留所有非NULL结果及其相应的Vehicle.ID2。使用unnest不成功，因为joo是一个包含2个元素的列表。 - umair durrani
类似 map_if(~!is.null(.x), 1) 这样的代码？你真的需要提供相关的样本数据。 - alistaire
2个回答
6
3

假设list.out是您创建的列表输出。如果您想从此列表中提取结果组件，则可以执行以下操作。

list.out %>%
 purrr::map("result") %>%  # Extract results 
 purrr::compact() %>% # Keep the elements of interest 
 purrr::reduce(bind_rows) # in case, if you want to combine the results as a dataframe; this assumes that the output of the function is in a dataframe.

请注意，map("result")等同于map(function(x) x[["result"]])。因此，逻辑与其他人已经建议的相同，但语法更简单。
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接