Агрегирование данных с использованием порогового критерия

Question

Давайте рассмотрим финансовые данные Yahoo, которые можно скачать здесь: 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 будет первым значением Open из 7 строк
   • Close будет последним значением Close из 7 строк
   • High будет максимальным значением High из 7 строк
   • Low будет минимальным значением Low из 7 строк
   • Volume будет суммой значений Volume

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

Чтобы использовать group by из tidyverse, мы сначала изменяем нашу дату для создания переменных группировки

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 создает настоящие идентификаторы для группировки до определенного порога.К сожалению, я также не могу думать о вариации cumum для порога «проблема».