R/bitbay_aggregate.R

In majkamichal/BitBayR: R Public API Client to BitBay Crypto-Currency Exhange

#' Aggregate BitBay transactions
#'
#' \code{bitbay_aggregate} aggregates BitBay transactions by
#' \code{aggr_time}-time interval. If in a given time interval there are no
#' transactions (count is 0) then the last available "Close" value is used.
#'
#' @param data object of class \code{bitbay_transactions} generated by
#' \code{bitbay_trades} or \code{bitbay_trades_from_date} functions.
#'
#' @param aggr_time a numeric vector of length 1 with seconds
#'
#' @return A time series object of class \code{zoo} and \code{xts} with
#' following columns:
#' \code{Open}, \code{High}, \code{Low}, \code{Close}, \code{Mean}, \code{Median},
#' \code{Volume_total}, \code{volume_buy}, \code{Volume_sell}, \code{Count}
#'
#' (Each column name has a \code{coin_currency.} prefix)
#'
#' @author Michal Majka
#'
#' @seealso \code{\link{bitbay_orderbook}}, \code{\link{bitbay_trades}},
#'          \code{\link{bitbay_trades_from_date}}\code{\link{bitbay_profit}}
#'
#' @references BitBay:
#' \url{https://bitbay.net/en/home}
#'
#' @references BitBay Public API:
#' \url{https://bitbay.net/en/api-publiczne}
#'
#' @examples
#'
#' \dontrun{
#' data <- bitbay_trades(pair = "BTC/USD", last_trades = 200)
#'
#' aggr_data_1min <- bitbay_aggregate(data, aggr_time = 60)
#' aggr_data_15min <- bitbay_aggregate(data, aggr_time = 15 * 60)
#' aggr_data_1h <- bitbay_aggregate(data, aggr_time = 60 * 60)
#' }
#' @export bitbay_aggregate



bitbay_aggregate <- function(data, aggr_time = 1 * 60) {

    # Warning if the aggregation time is longer than the whole time span of the data!

    if (aggr_time <= 0)
        stop("'aggr_time' must be positive")

    data$new_date <- structure(unclass(data$Date) + (aggr_time - unclass(data$Date) %% aggr_time),
                               class = c("POSIXct", "POSIXt")) - aggr_time

    aggr <- by(data = data, INDICES = data$new_date, function(x) {

        price <- x[["Price"]]
        query <- tapply(x$new_date, x$Date) == 1
        open_ind <- if (length(which(query)) == 1) {
            1
        } else if (length(which(query & if (any(x$Order == "sell")) { x$Order == "sell" } else { TRUE })) > 0) {
            utils::tail(which(query & if (any(x$Order == "sell")) { x$Order == "sell" } else { TRUE }), 1)
        } else { utils::tail(which(query), 1) }

        c("Open" = price[open_ind],
          "High" = max(price),
          "Low" = min(price),
          "Close" = utils::tail(price, 1),
          "Mean" = mean(price),
          "Median" = stats::median(price),
          "Volume_total" = sum(x$Volume),
          "Volume_buy" = sum(x$Volume[x$Order == "buy"]),
          "Volume_sell" = sum(x$Volume[x$Order == "sell"]),
          "Count" = length(price))
    })
    aggr <- as.data.frame(do.call(rbind, aggr))

    from <- as.POSIXct(rownames(aggr)[1], origin = "1970-01-01")
    to <- as.POSIXct(utils::tail(rownames(aggr), 1), origin = "1970-01-01")
    full_seq <- data.frame(Date = seq.POSIXt(from, to, by = aggr_time))

    aggr$Date <- as.POSIXct(rownames(aggr), origin = "1970-01-01")
    aggr <- merge(aggr, full_seq, by = "Date", all.y = TRUE)

    close <- aggr$Close
    not_na <- !is.na(close)
    new_close <- c(close[not_na][1], close[not_na])[cumsum(not_na) + 1]

    vars <- c("Volume_buy", "Volume_sell", "Volume_total", "Count")
    aggr[is.na(aggr[ ,"Count"]), vars] <- 0

    aggr$Close <- new_close

    vars2 <- c("Open", "Low", "High")
    if (nrow(aggr[aggr[ ,"Count"] == 0, vars2]) != 0)
        aggr[aggr[ ,"Count"] == 0, vars2] <- new_close[aggr[ ,"Count"] == 0]

    mean <- aggr$Mean
    not_na_mean <- !is.na(mean)
    aggr$Mean <- c(mean[not_na_mean][1], mean[not_na_mean])[cumsum(not_na_mean) + 1]

    median <- aggr$Median
    not_na_median <- !is.na(median)
    aggr$Median <- c(median[not_na_median][1], median[not_na_median])[cumsum(not_na_median) + 1]

    pair <- strsplit(attributes(data)$pair, "/")[[1]]
    names(aggr) <- paste0(paste0(pair[1], "_", pair[2]), ".", names(aggr))

    aggr <- xts::xts(x = aggr[-1], order.by = aggr[[1]])

    attr(aggr, "pair") <- attributes(data)$pair
    attr(aggr, "download_time") <- attributes(data)$download_time
    attr(aggr, "class") <- c(class(aggr), "bitbay_aggr_transactions")

    aggr
}