R/to_from_xts.R

In tsbox: Class-Agnostic Time Series

register_class("xts")

# to ---------------------------------------------------------------------------

#' Convert to Class
#' @noRd
ts_xts_dts <- function(x) {
  stopifnot(inherits(x, "dts"))
  stopifnot(requireNamespace("xts"))
  z <- wide_core(combine_id_cols(x))
  xts::xts(x = as.matrix(z[, -1]), order.by = z[[1]])
}


# from -------------------------------------------------------------------------

#' @export
#' @method ts_dts xts
ts_dts.xts <- function(x) {
  stopifnot(requireNamespace("xts"))

  idx <- attr(x, "index")
  tclass <- attr(idx, "tclass")
  attributes(idx) <- NULL

  dta <- as.data.frame(x, row.names = FALSE)
  if (tclass[1] == "Date") {
    time <- as.Date(as.POSIXct(idx, origin = "1970-01-01"))
  } else if (tclass[1] == "POSIXct") {
    time <- as.POSIXct(idx, origin = "1970-01-01")
  } else {
    # if regular, use as.ts to convert to ts
    return(ts_dts(as.ts(zoo::as.zoo(x))))
  }

  dta <- data.table(time = time, dta)
  if (NCOL(dta) == 2L) {
    setnames(dta, c("time", "value"))
  } else {
    dta <- melt(
      dta,
      id.vars = "time", variable.name = "id", variable.factor = FALSE
    )
    setcolorder(dta, c("id", "time", "value"))
  }
  dts_init(dta)
}


# main converter ---------------------------------------------------------------

#' @name ts_ts
#' @export
ts_xts <- function(x) {
  check_ts_boxable(x)
  if (relevant_class(x) == "xts") {
    return(x)
  }
  ts_xts_dts(ts_dts(x))
}