我正在使用如下所示的 tibble:
ex <- structure(list(rowid = c(4L, 5L, 6L, 9L, 10L), timestamp = structure(c(1502480694.03336,
1502480695.44736, 1502480696.03336, 1502480703.99836, 1502480706.19936
), class = c("POSIXct", "POSIXt"), tzone = "UTC"), cat = c(32L,
1L, 1L, 1L, 1L), var1 = structure(c(NA_integer_, NA_integer_,
NA_integer_, NA_integer_, NA_integer_), .Label = "1", class = "factor"),
var2 = c(0, 50, 29.7, 51, 70.8), var3 = c(NA, 26.3, 24, 20.5,
12), order = c(NA, 1L, 1L, 1L, 1L), bfr = list(NA, structure(list(
rowid = integer(0), timestamp = structure(numeric(0), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), cat = integer(0), var1 = structure(integer(0), .Label = "1", class = "factor"),
var2 = numeric(0), var3 = numeric(0), order = integer(0)), class = c("tbl_df",
"tbl", "data.frame"), row.names = integer(0)), structure(list(
rowid = 5L, timestamp = structure(1502480695.44736, class = c("POSIXct",
"POSIXt"), tzone = "UTC"), cat = 1L, var1 = structure(NA_integer_, .Label = "1", class = "factor"),
var2 = 50, var3 = 26.3, order = 1L), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -1L)), structure(list(
rowid = 5:8, timestamp = structure(c(1502480695.44736,
1502480696.03336, 1502480699.03336, 1502480701.03336), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), cat = c(1L, 1L, 1L, 1L), var1 = structure(c(NA_integer_,
NA_integer_, NA_integer_, NA_integer_), .Label = "1", class = "factor"),
var2 = c(50, 29.7, 52.8, 44), var3 = c(26.3, 24, 8.9,
12.4), order = c(1L, 1L, 1L, 1L)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -4L)), structure(list(
rowid = 5:9, timestamp = structure(c(1502480695.44736,
1502480696.03336, 1502480699.03336, 1502480701.03336,
1502480703.99836), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
cat = c(1L, 1L, 1L, 1L, 1L), var1 = structure(c(NA_integer_,
NA_integer_, NA_integer_, NA_integer_, NA_integer_), .Label = "1", class = "factor"),
var2 = c(50, 29.7, 52.8, 44, 51), var3 = c(26.3, 24,
8.9, 12.4, 20.5), order = c(1L, 1L, 1L, 1L, 1L)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -5L)))), row.names = c(4L,
5L, 6L, 9L, 10L), class = "data.frame")
我想用 map 总结 bfr 列中的嵌套小标题。为了省略不必要的计算，我想使用 map_if ，当 bfr 包含 cat == 1 的行数少于 2 时，它会跳过该行。然而，由于 bfr 列中存在 NA 和空 tibbles，我正在努力编写适当的谓词函数。这是我的尝试:
more_than <- function(df){
if (nrow(df) == 0 | is.na(df)) return(FALSE)
n <- df %>%
summarise(sum(cat == 1)) %>%
as.numeric()
return(n > 2)
}
ex %>%
mutate(mean_var2 = map_if(bfr, more_than,
~.x %>% summarise(mean_var2 = mean(var2))))
结果是:
Error in if (nrow(df) == 0 | is.na(df)) return(FALSE) : argument is of length zero
如何处理 NA 和空 tibbles 的存在以编写适当的谓词函数？
最佳答案
如果目的是获取“var2”列的平均值，请检查list元素是data.frame还是tibble(在本例中它是一个 tibble)，然后进行总结
out <- ex %>%
mutate(mean_var2 = map_if(bfr, is.tibble, ~
.x %>%
summarise(mean_var2 = mean(var2, na.rm = TRUE))))
如果我们还需要检查sum(cat ==1) > 2
more_than <- function(df){
i1 <- is_tibble(df)
if(i1) {
n <- df %>%
summarise(v1 = sum(cat == 1)) %>%
pull(v1)
}
i1 && (n > 2)
}
ex %>%
mutate(mean_var2 = map_if(bfr, more_than, ~
.x %>%
summarise(mean_var2 = mean(var2, na.rm = TRUE))))
is.na 不起作用的原因是它检查每个数据集，在其中一些数据集中它是一个 tibble 并且返回一个逻辑 矩阵，而if/else期望返回单个TRUE/FALSE。例如
(3 == 4) & (cbind(3:5, 1:3) == 3)
产生不同的输出
一个选项是使用 &&，这样它仅在第一个条件为 TRUE 时才评估 rhs 条件，从而避免不必要的评估
(3 == 4) && (cbind(3:5, 1:3) == 3)
#[1] FALSE
在OP的原始函数中，如果我们将|替换为||，它应该可以正常工作
more_than <- function(df){
if (nrow(df) == 0 || is.na(df)) return(FALSE)
n <- df %>%
summarise(sum(cat == 1)) %>%
as.numeric()
return(n > 2)
}
更新
如果我们想对那些不满足的情况返回 NA
ex %>%
mutate(mean_var2 = map_dbl(bfr, ~
if(is_tibble(.x) && sum(.x$cat == 1) > 2) mean(.x$var2, na.rm = TRUE) else NA))
或者另一种选择是使用可能(类似于tryCatch)
posmean <- possibly(function(dat) if(sum(dat$cat == 1) > 2)
mean(dat$var2, na.rm = TRUE) else NA_real_, otherwise = NA_real_)
ex %>%
mutate(mean_var2 = map_dbl(bfr, posmean))
关于r - 使用map_if省略NA和空数据帧，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/55701311/