Trims Blocks from a Least Cost Path

In orthogonal least cost paths (when diagonals are ignored), long straight segments (a.k.a "blocks") may appear in highly dissimilar sections of the time series. Blocks inflate psi dissimilarity scores, making pairs of time series seem more dissimilar than they actually are. This demonstration function identifies and removes blocks, resulting in fairer dissimilarity analyses.

Usage

psi_cost_path_ignore_blocks(path = NULL)

Arguments

path

(required, data frame) least cost path produced by psi_cost_path(). Default: NULL

Value

data frame

See also

Other psi_demo: distance(), distances, psi_auto_distance(), psi_auto_sum(), psi_cost_matrix(), psi_cost_path(), psi_cost_path_sum(), psi_distance_lock_step(), psi_distance_matrix(), psi_equation()

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
)

#orthogonal least cost matrix
cost_matrix <- psi_cost_matrix(
  dist_matrix = dist_matrix,
  diagonal = FALSE
)

#orthogonal least cost path
cost_path <- psi_cost_path(
  dist_matrix = dist_matrix,
  cost_matrix = cost_matrix,
  diagonal = FALSE
)

#cost path details
nrow(cost_path)
#> [1] 179

psi_cost_path_sum(
  path = cost_path
)
#> [1] 60.83981

#notice blocks as long straight lines
if(interactive()){
  utils_matrix_plot(
    m = cost_matrix,
    path = cost_path
  )
}

#removing blocks
cost_path_no_blocks <- psi_cost_path_ignore_blocks(
  path = cost_path
)

#much smaller size
nrow(cost_path_no_blocks)
#> [1] 31

#much smaller distance sum
psi_cost_path_sum(
  path = cost_path_no_blocks
)
#> [1] 7.609695

#but the path shape is preserved
if(interactive()){
  utils_matrix_plot(
    m = cost_matrix,
    path = cost_path_no_blocks
  )
}

#x and y to tsl
tsl <- list(
  x = x,
  y = y
)

#psi score with blocks
distantia(
  tsl = tsl,
  diagonal = FALSE,
  ignore_blocks = FALSE
)$psi
#> [1] 7.221858

#psi score without blocks
distantia(
  tsl = tsl,
  diagonal = FALSE,
  ignore_blocks = TRUE
)$psi
#> [1] 1.701404