使用阈值标准聚合数据

Question

让我们考虑一下可以在此处下载的雅虎财务数据： https://finance.yahoo.com/quote/BTC-USD/history?period1=1325372400&period2=1548025200&interval=1d&filter=history&frequency=1d

您可以使用以下方式读取数据：

yahoo <- read.csv("~/Downloads/yahoo.BTC-USD.daily.csv",
                   na.strings=c("NA","NaN", " "))

这是生成的数据框：

> head(yahoo)
        Date Open High  Low Close  Volume
1 2011-12-31 4.25 5.00 4.20  4.72  596240
2 2012-01-01 4.72 5.50 4.62  5.27  553045
3 2012-01-02 5.27 5.47 4.80  5.22  360357
4 2012-01-03 5.22 5.29 4.65  4.88  619170
5 2012-01-04 4.88 5.70 4.75  5.57  688717
6 2012-01-05 5.57 7.22 5.57  6.95 1130623

这些是每日蜡烛，即每条线代表一个交易日。

我想做两件事：

1. 将此数据框聚合到例如每周数据，将 7 行分组在一起：

   • Open 将是 7 行的第一个 Open 值
   • Close 将是 7 行的最后一个 Close 值
   • High 将是 7 行的 High 值的最大值
   • Lo​​w 将是 7 行的 Low 值的最小值
   • 音量将是音量值的总和

2. 针对给定的体积阈值，将此数据帧聚合到一个几乎等体积的系列：每个体积阈值都有一行。

这是我使用 for 循环得出的结论：

第 1 点：

aggregate.candles <- function(x, candles) {
  Date <- candles$Date[x[1]]
  Open <- candles$Open[x[1]]
  High <- max(candles$High[x])
  Low <- min(candles$Low[x])
  Close <- candles$Close[tail(x, 1)]
  Volume <- sum(candles$Volume[x])

  return(data.frame(Date, Open, High, Low, Close, Volume))
}

require(zoo)

yahoo.weekly <- as.data.frame(rollapply(seq_along(yahoo$Open), FUN = aggregate.candles, candles = yahoo, width = 7, by = 7))

这就像一个魅力，但如果你能提供改进，我会很高兴。难道不能使用聚合函数做某事吗？或者 tidyverse 包让它看起来更干净？

现在对于第 2 点，我找不到没有 for 循环的方法：

aggregate.volume <- function(candles, threshold) {
  Open <- c()
  High <- c()
  Low <- c()
  Close <- c()
  Volume <- c()

  tmpOpen <- -1
  tmpHigh <- 0
  tmpLow <- .Machine$double.xmax
  tmpClose <- 0
  tmpVolume <- 0
  for (i in seq_along(candles$Open)) {
    tmpVolume <- tmpVolume + candles$Volume[i]

    if (tmpVolume < threshold) {
      if (tmpOpen == -1)
        tmpOpen <- candles$Open[i]
      tmpHigh <- max(tmpHigh, candles$High[i])
      tmpLow <- min(tmpLow, candles$Low[i])
      tmpClose <- candles$Close[[i]]
    } else {
      Open <- c(Open, tmpOpen)
      Close <- c(Close, tmpClose)
      High <- c(High, tmpHigh)
      Low <- c(Low, tmpLow)
      Volume <- c(Volume, tmpVolume)

      tmpOpen <- -1
      tmpHigh <- 0
      tmpLow <- .Machine$double.xmax
      tmpClose <- 0
      tmpVolume <- 0
    }
  }

  return(data.frame(Open, High, Low, Close, Volume))
}

yahoo.volume.10m <- aggregate.volume(yahoo, threshold = 1e8)

有没有更优雅/高效的方法（使用聚合函数或 tidyverse/dplyr）？

我询问效率是因为这可以在更大的数据集上完成（例如一分钟蜡烛）。

Answer 1

要使用 tidyverse 中的 group by，我们首先修改 Date 以创建分组变量

library(tidyverse)
library(lubridate)

yahoo <- as.tibble(read.csv("~/Downloads/BTC-USD.csv", na.strings=c("NA","NaN", " ")))
yahoo <- yahoo[order(yahoo$Date),]

yahoo.weekly <- yahoo %>% 
  mutate(week = isoweek(Date), year = isoyear(Date)) %>% 
  group_by(year, week)  %>% 
  summarise("Open" = first(Open), "High" = max(High), "Low" = min(Low), "Close" = last(Close), "Volume" = sum(Volume))

cumsum_group <- function(x, threshold){
  cumsum <- 0
  groups <- rep(0, length(x))

  for (i in 1:length(x)){
    cumsum <- cumsum + x[i]

    if(cumsum >= threshold & i<length(x)){
      i <- i+1
      groups[i] <- 1
      cumsum <- 0
    }
  }
  cumsum(groups)+1
}

yahoo.volume.10m <- yahoo %>%
  mutate(group = cumsum_group(Volume, threshold = 1e8)) %>%
  group_by(group) %>% 
  summarise("Open" = first(Open), "High" = max(High), "Low" = min(Low), "Close" = last(Close), "Volume" = sum(Volume))

cumsum_group 在此创建用于分组到某个阈值的 ID。不幸的是，我也无法考虑阈值“问题”的 cumsum 的变化。