R/train_tsrf.R

In FlukeAndFeather/tsrf: Time Series Random Forest Modeling

#' Train a time series random forest
#'
#' @param tsfeats time series features (data.frame) as generated by
#'   \code{\link{extract_features}}
#' @param labels time series labels (vector)
#' @param tsid name of id column(s) in \code{tsfeats} (character)
#'
#' @return train object, as generated by \code{\link[caret]{train}}
#' @export
#'
#' @examples
#' # Generate 10 time series of two different classes, each 100 points long
#' tsnum <- 10
#' tslbl <- factor(rep(c("A", "B"), each = tsnum))
#' tslen <- 100
#' Aval <- replicate(tsnum, rnorm(tslen))
#' Bval <- replicate(tsnum, c(rnorm(tslen / 2), cumsum(rnorm(tslen / 2, 0.1))))
#' tsdat <- data.frame(
#'   id = rep(1:(2 * tsnum), each = tslen),
#'   val = c(as.numeric(Aval), as.numeric(Bval))
#' )
#'
#' # Plot time series
#' plot(seq(tslen), tsdat$val[tsdat$id == 1],
#'      type = "l", col = "#FF000088", ylim = range(tsdat$val))
#' for (i in 2:(tsnum * 2)) {
#'   lines(seq(tslen), tsdat$val[tsdat$id == i],
#'         col = if (i <= tsnum) "#FF000088" else "#0000FF88")
#' }
#'
#' # Extract features
#' tsints <- sample_intervals(tslen)
#' tsfeat <- extract_features(tsdat, "id", tsints)
#'
#' # Split data
#' train_index <- sample(seq(nrow(tsfeat)), 0.9 * nrow(tsfeat))
#' train_feat <- tsfeat[train_index, ]
#' test_feat <- tsfeat[-train_index, ]
#' train_lbl <- tslbl[train_index]
#' test_lbl <- tslbl[-train_index]
#'
#' # Train model
#' tsrf <- train_tsrf(train_feat, train_lbl, "id")
#'
#' # Test predictions
#' pred_feat <- predict(tsrf, test_feat)
#' caret::confusionMatrix(pred_feat, test_lbl)
train_tsrf <- function(tsfeats, tslabels, tsid) {
  stopifnot(
    inherits(tsfeats, "data.frame"),
    is.vector(tslabels) || is.factor(tslabels),
    nrow(tsfeats) == length(tslabels),
    tsid %in% colnames(tsfeats)
  )

  train_data <- cbind(tsfeats[-match(tsid, colnames(tsfeats))], tslabels)
  caret::train(as.factor(tslabels) ~ .,
               data = train_data,
               method = "ranger")
}