---
title: "A Comparison of Seriation Methods"
author: "Michael Hahsler"
output:
  rmarkdown::html_vignette
vignette: >
    %\VignetteIndexEntry{A Comparison of Seriation Methods}
    %\VignetteEngine{knitr::rmarkdown}
    %\VignetteEncoding{UTF-8}  
---

# Introduction

This document compares the seriation methods available in the package `seriation` using 
a sample of 30 flowers from the popular Iris dataset and randomizes the order of the objects.

```{r}
set.seed(1234)
library("seriation")

data("iris")
x <- as.matrix(iris[sample(nrow(iris), 30), -5])
d <- dist(x)
```

# Distance seriation

We first register more seriation methods. Some of these methods require installing additional packages.

```{r}
#| message: false
register_DendSer()
register_optics()
register_smacof()
```

The following methods will be used (a few slow methods are skipped).

```{r}
methods <- sort(list_seriation_methods("dist"))
methods <- setdiff(methods, c("BBURCG", "BBWRCG", "Enumerate", "GSA", "SGD", "SGLS"))
methods 
```

Details about the method can be found in the [manual page for `seriate()`](https://mhahsler.r-universe.dev/seriation/doc/manual.html#seriate).

We use a loop to run the function `seriate()` with each method and calculate criterion measures which indicate how good the order is.

```{r}
#| message: false
orders <- list()
criterion <- list()
for (m in methods) {
  cat(m)
  tm <- system.time(orders[[m]] <- seriate(d, method = m))
  criterion[[m]] <- data.frame(time = tm[1]+tm[2], rbind(criterion(d, orders[[m]]))) 
  cat(" took", tm[1]+tm[2], "sec.\n")
}

criterion <- do.call(rbind, criterion)
```

We align the seriation orders. The reason is that an order 1, 2, 3 and 3, 2, 1 are equivalent and just an artifact of the algorithm. Aligning will reverse some orders so they are better aligned. Then we sort the orders from best to worst according to a popular seriation criterion measure called `Gradient_weighted`.

```{r}
orders <- ser_align(orders)
best_to_worse <- order(criterion[["Gradient_weighted"]], decreasing = TRUE)

orders <- orders[best_to_worse]
criterion <- criterion[best_to_worse, ]
```

## Comparison between methods

We can compare the seriation methods by how similar the orders are that they produce (measured using Spearman). The following code calculates distances between orders and then performs hierarchical clustering.

```{r}
#| out-width: 100%
#| fig-align: "center"

dst <- ser_dist(orders) 
hc <- permute(hclust(dst), order = "OLO", dist = dst)
plot(hc)
```

The reordered dendrogram clearly shows a group of methods based on hierarchical clustering focused on path length and another group that tries to optimize the other seriation measures.

Here is a table to compare the seriation methods on different criterion measures. Use the interactive table to sort the methods given different measures. Note that some are maximized and some should be minimized. Details about the measures can be found in the [manual page for `criterion()`](https://mhahsler.r-universe.dev/seriation/doc/manual.html#criterion).

```{r}
library(DT)
datatable(round(criterion, 2), extensions = "FixedColumns",
    options = list(paging = TRUE, searching = TRUE, info = FALSE,
      sort = TRUE, scrollX = TRUE, fixedColumns = list(leftColumns = 1))) %>%
    formatRound(columns = colnames(criterion) , mark = "", digits=1)
```

## Visualize the results

Plot the reordered dissimilarity matrices. Dark blocks along the main diagonal mean that the order reveals a "cluster" of similar objects. The Iris dataset contains three species, but two of them are very similar, so we expect to see one smaller block and one larger block.

```{r}
#| fig-asp: 1
#| fig-show: hold
#| out-width: 50%
#| layout-ncol: 2 
for (n in names(orders))
  pimage(d, orders[[n]], main = n , key = FALSE)
```

# Matrix seriation

Matrix seriation reorders rows and columns of a data matrix. We perform the same steps as for distances in the previous section.

```{r}
methods <- sort(list_seriation_methods("matrix"))

# AOE if for correlation matrices only
methods <- setdiff(methods, c("AOE"))
methods 
```

Performing seriation.

```{r, fig.height= 5}
orders <- list()
criterion <- list()
for (m in methods) {
  cat(m)
  tm <- system.time(orders[[m]] <- seriate(x, method = m))
  criterion[[m]] <- data.frame(time = tm[1]+tm[2], rbind(criterion(x, orders[[m]])))
  cat(" took", tm[1]+tm[2], "sec.\n")
}

criterion <- do.call(rbind, criterion)
```

## Comparison between methods

```{r}
datatable(round(criterion, 2), extensions = "FixedColumns",
    options = list(paging = TRUE, searching = TRUE, info = FALSE,
      sort = TRUE, scrollX = TRUE, fixedColumns = list(leftColumns = 1))) %>%
    formatRound(columns = colnames(criterion) , mark = "", digits = 1)
```

## Visualize the results

```{r}
best_to_worse <- order(criterion[["Moore_stress"]], decreasing = FALSE)

orders <- orders[best_to_worse]
criterion <- criterion[best_to_worse, ]
```

```{r}
#| fig-asp: 1
#| fig-show: hold
#| out-width: 50%
#| layout-ncol: 2 
for (n in names(orders))
  pimage(x, orders[[n]], main = n , key = FALSE)
```

##