R/psi_cost_matrix.R

In distantia: Advanced Toolset for Efficient Time Series Dissimilarity Analysis

#' Cost Matrix
#'
#' @description
#' Demonstration function to compute a cost matrix from a distance matrix.
#'
#' @param dist_matrix (required, numeric matrix). Distance matrix generated by [psi_distance_matrix()]. Default: NULL
#' @inheritParams distantia
#' @return numeric matrix
#' @examples
#' #distance metric
#' d <- "euclidean"
#'
#' #use diagonals in least cost computations
#' diagonal <- TRUE
#'
#' #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
#' )
#'
#' #cost matrix
#' cost_matrix <- psi_cost_matrix(
#'   dist_matrix = dist_matrix,
#'   diagonal = diagonal
#' )
#'
#' if(interactive()){
#'   utils_matrix_plot(
#'     m = cost_matrix
#'     )
#' }
#' @autoglobal
#' @export
#' @family psi_demo
psi_cost_matrix <- function(
    dist_matrix = NULL,
    diagonal = TRUE
){

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

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

  #diagonal is TRUE
  if(diagonal == TRUE){

    m <- cost_matrix_diagonal_weighted_cpp(
      dist_matrix = dist_matrix
    )


  } else {

    m <- cost_matrix_orthogonal_cpp(
      dist_matrix = dist_matrix
    )

  }

  #adding names
  dimnames(m) <- dimnames(dist_matrix)

  #adding attributes

  attr(x = m, which = "y_time") <- attributes(dist_matrix)$y_time
  attr(x = m, which = "x_time") <- attributes(dist_matrix)$x_time
  attr(x = m, which = "y_name") <- attributes(dist_matrix)$y_name
  attr(x = m, which = "x_name") <- attributes(dist_matrix)$x_name
  attr(x = m, which = "type") <- "cost"
  attr(x = m, which = "distance") <- attributes(dist_matrix)$distance

  m

}