哪种方法可以最快地得出 R 数据框列的条件最小值?

Which is the fastest manner to the derive the conditional minimum value of an R data frame column?

假设我们有这个数据框:

> data
  ID Period_1 Values
1  1  2020-03     -5
2  1  2020-04     25
3  2  2020-01     35
4  2  2020-02     45
5  2  2020-03     55
6  2  2020-04     87
7  3  2020-02     10
8  3  2020-03     20
9  3  2020-04     30

data <- 
  data.frame(
    ID = c(1,1,2,2,2,2,3,3,3),
    Period_1 = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-02", "2020-03", "2020-04"),
    Values = c(-5, 25, 35, 45, 55, 87, 10, 20, 30)
  )

我想提取“Values”的最小值,但前提是满足Period_1条件(如Period_1 == "2020-04")。我倾向于使用 dplyr group_by(Period_1) %>% 但我不需要所有 Period_1 分组的最小值,我只需要单个指定期间的最小值。我正在使用的实际数据库有 200 万多行,我怀疑我对 group_by(...) 的大量使用正在显着降低速度。

我评论的其他 Stack Overflow(和 Google 等)帖子也依赖于 group_by,也许这是处理这个问题的最快方法,我不知道,但我怀疑没有。

我尝试了以下方法,但没有成功:data %>% select(where(data$Period_1 == "2020-04"))%>% min(data$Values, na.rm=TRUE),返回消息“错误:无法将逻辑向量转换为函数”

处理速度方面,提取条件最小值的最快方法是什么?包括使用 dplyr。

您混淆了 dplyr::filterdplyr::selectselect(where(condition)) selects 列基于应用于整个 vector/column 的逻辑条件,如 select(where(is.numeric)),其中 selects 数字列。

对满足条件的select行,使用filter

library(dplyr)

data %>%
   filter(Period1 == "2020-04") %>%
   pull(Values) %>%
   min(na.rm = TRUE)

# OR with `summarise`

data %>%
   filter(Period1 == "2020-04") %>%
   summarise(min_Values = min(Values, na.rm = TRUE))

这是一个基本的 R 选项(如果您追求速度)。我们可以对数据进行子集化,然后获取第三列(即 Values)的最小值。

min(data[data$Period_1 == "2020-04", ][,3], na.rm = TRUE)

# [1] 25

基准

这是另一个基本 R 函数,它遵循 but is faster for small to medium data sets. Then the 2nd base R and 解决方案的时间线并绘制了时间图。

library(dplyr)
library(dtplyr)
library(data.table)
library(ggplot2)
library(microbenchmark)

f1 <- function(data, period){
  i <- data[["Period_1"]] == period
  min(data$Values[i], na.rm = TRUE)
}
f2 <- function(data, period){
  min(data[data$Period_1 == period, 3], na.rm = TRUE)
}
f3 <- function(data, period){
  data %>%
    filter(Period_1 == period) %>%
    pull(Values) %>%
    min(na.rm = TRUE)
}

funTest <- function(n, X = data, period = "2020-04"){
  Y <- as.data.table(X)
  out <- lapply(seq.int(n), function(k){
    y <- X
    y2 <- Y
    for(i in seq.int(k)) y <- rbind(y, y)
    for(i in seq.int(k)) y2 <- rbind(y2, y2)
    mb <- microbenchmark(
      base_Rui = f1(y, period),
      base_Andrew = f2(y, period),
      dplyr_GuedesBF = f3(y, period),
      dtplyr_GuedesBF = f3(y2, period)
    )
    mb$nrow <- nrow(y)
    aggregate(time ~ expr + nrow, mb, median)
  })
  do.call(rbind, out)
}

timings <- funTest(20)

ggplot(timings, aes(nrow, time, color = expr)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(trans = "log10") +
  scale_y_continuous(trans = "log10") +
  theme_bw()

reprex package (v2.0.1)

于 2022-02-07 创建