R/psi_cost_path.R

In BlasBenito/distantia: Advanced Toolset for Efficient Time Series Dissimilarity Analysis

#' Least Cost Path
#'
#' @description
#' Demonstration function to compute the least cost path within a least cost matrix.
#'
#'
#' @param dist_matrix (required, numeric matrix) Distance matrix generated by [psi_distance_matrix()]. Default: NULL
#' @param cost_matrix (required, numeric matrix) Cost matrix generated from the distance matrix with [psi_cost_matrix()]. Default: NULL
#' @inheritParams distantia
#' @return data frame
#' @export
#' @examples
#' #distance metric
#' d <- "euclidean"
#'
#' #simulate two irregular time series
#' x <- zoo_simulate(
#'   name = "x",
#'   rows = 100,
#'   seasons = 2,
#'   seed = 1
#' )
#'
#' y <- zoo_simulate(
#'   name = "y",
#'   rows = 80,
#'   seasons = 2,
#'   seed = 2
#' )
#'
#' if(interactive()){
#'   zoo_plot(x = x)
#'   zoo_plot(x = y)
#' }
#'
#' #distance matrix
#' dist_matrix <- psi_distance_matrix(
#'   x = x,
#'   y = y,
#'   distance = d
#' )
#'
#' #diagonal least cost path
#' #------------------------
#'
#' cost_matrix <- psi_cost_matrix(
#'   dist_matrix = dist_matrix,
#'   diagonal = TRUE
#' )
#'
#' cost_path <- psi_cost_path(
#'   dist_matrix = dist_matrix,
#'   cost_matrix = cost_matrix,
#'   diagonal = TRUE
#' )
#'
#' if(interactive()){
#'   utils_matrix_plot(
#'     m = cost_matrix,
#'     path = cost_path
#'     )
#' }
#'
#'
#' #orthogonal least cost path
#' #--------------------------
#' cost_matrix <- psi_cost_matrix(
#'   dist_matrix = dist_matrix,
#'   diagonal = FALSE
#' )
#'
#' cost_path <- psi_cost_path(
#'   dist_matrix = dist_matrix,
#'   cost_matrix = cost_matrix,
#'   diagonal = FALSE
#' )
#'
#' if(interactive()){
#'   utils_matrix_plot(
#'     m = cost_matrix,
#'     path = cost_path
#'   )
#' }
#' @autoglobal
#' @family psi_demo
psi_cost_path <- function(
    dist_matrix = NULL,
    cost_matrix = NULL,
    diagonal = TRUE,
    bandwidth = 1
){

  dist_matrix <- utils_check_args_matrix(
    m = dist_matrix,
    arg_name = "dist_matrix"
  )

  cost_matrix <- utils_check_args_matrix(
    m = cost_matrix,
    arg_name = "cost_matrix"
  )

  if(is.logical(diagonal) == FALSE){
    stop("distantia::psi_cost_path(): argument 'diagonal' must be logical (TRUE or FALSE).", call. = FALSE)
  }

  if(diagonal == FALSE){

    if(bandwidth >= 1){

      path <- cost_path_orthogonal_cpp(
        dist_matrix = dist_matrix,
        cost_matrix = cost_matrix
      )

    } else {

      path <- cost_path_orthogonal_bandwidth_cpp(
        dist_matrix = dist_matrix,
        cost_matrix = cost_matrix,
        bandwidth = bandwidth
      )

    }

  } else {

    if(bandwidth >= 1){

      path <- cost_path_diagonal_cpp(
        dist_matrix = dist_matrix,
        cost_matrix = cost_matrix
      )

    } else {

      path <- cost_path_diagonal_bandwidth_cpp(
        dist_matrix = dist_matrix,
        cost_matrix = cost_matrix,
        bandwidth = bandwidth
      )

    }

  }

  attr(x = path, which = "y_name") <- attributes(dist_matrix)$y_name
  attr(x = path, which = "x_name") <- attributes(dist_matrix)$x_name
  attr(x = path, which = "type") <- "cost_path"
  attr(x = path, which = "distance") <- attributes(dist_matrix)$distance


  path

}