From d03ab653a1a168267ebb62be0be0129fb23ba0ad Mon Sep 17 00:00:00 2001
From: nfrerebeau <nicolas.frerebeau@u-bordeaux-montaigne.fr>
Date: Fri, 22 Nov 2024 18:15:02 +0100
Subject: [PATCH] Add as_seriation() to coerce objects to seriation orders

---
 DESCRIPTION            |  1 +
 NAMESPACE              |  1 +
 R/AllGenerics.R        | 21 ++++++++++++++++++++
 R/seriation_average.R  | 28 +-------------------------
 R/seriation_coerce.R   | 41 ++++++++++++++++++++++++++++++++++++++
 man/as_seriation.Rd    | 45 ++++++++++++++++++++++++++++++++++++++++++
 man/assess.Rd          |  1 +
 man/order.Rd           |  1 +
 man/permute.Rd         |  1 +
 man/refine.Rd          |  1 +
 man/seriate_average.Rd |  1 +
 man/seriate_rank.Rd    |  1 +
 12 files changed, 116 insertions(+), 27 deletions(-)
 create mode 100644 R/seriation_coerce.R
 create mode 100644 man/as_seriation.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index b2785a8..e742425 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -68,6 +68,7 @@ Collate:
     'reexport.R'
     'seriation_assess.R'
     'seriation_average.R'
+    'seriation_coerce.R'
     'seriation_permute.R'
     'seriation_rank.R'
     'seriation_refine.R'
diff --git a/NAMESPACE b/NAMESPACE
index c352b85..30efb5c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -38,6 +38,7 @@ exportMethods("[[")
 exportMethods(aoristic)
 exportMethods(apportion)
 exportMethods(as.data.frame)
+exportMethods(as_seriation)
 exportMethods(assess)
 exportMethods(bootstrap)
 exportMethods(coef)
diff --git a/R/AllGenerics.R b/R/AllGenerics.R
index 55d0308..f83cb09 100644
--- a/R/AllGenerics.R
+++ b/R/AllGenerics.R
@@ -887,6 +887,27 @@ setGeneric(
 #   valueClass = "PermutationOrder"
 # )
 
+#' Coerce an \R Object to a Seriation Order
+#'
+#' @param object An \R object.
+#' @param margin A [`numeric`] vector giving the subscripts which the
+#'  rearrangement will be applied over: `1` indicates rows, `2` indicates
+#'  columns, `c(1, 2)` indicates rows then columns, `c(2, 1)` indicates columns
+#'  then rows.
+#' @param axes An [`integer`] vector giving the subscripts of the CA axes to be
+#'  used.
+#' @param ... Currently not used.
+#' @return
+#'  A [`PermutationOrder-class`] object.
+#' @author N. Frerebeau
+#' @family seriation methods
+#' @docType methods
+#' @aliases as_seriation-method
+setGeneric(
+  name = "as_seriation",
+  def = function(object, ...) standardGeneric("as_seriation")
+)
+
 ## Refine ----------------------------------------------------------------------
 #' Refine CA-based Seriation
 #'
diff --git a/R/seriation_average.R b/R/seriation_average.R
index ede459f..2e9f1c7 100644
--- a/R/seriation_average.R
+++ b/R/seriation_average.R
@@ -23,36 +23,10 @@ setMethod(
   signature = c(object = "matrix"),
   definition = function(object, margin = c(1, 2), axes = 1,
                         sup_row = NULL, sup_col = NULL, ...) {
-    ## Validation
-    arkhe::assert_length(axes, 1)
-
-    margin <- as.integer(margin)
-    axes <- as.integer(axes)
-
-    ## Original sequences
-    i <- seq_len(nrow(object))
-    j <- seq_len(ncol(object))
-
     ## Correspondence analysis
     corresp <- dimensio::ca(object, sup_row = sup_row, sup_col = sup_col)
-    coords <- list(
-      rows = dimensio::get_coordinates(corresp, margin = 1),
-      columns = dimensio::get_coordinates(corresp, margin = 2)
-    )
-
-    ## Reorder in case if supplementary observations
-    coords$rows <- coords$rows[order(corresp@rows@order), ]
-    coords$columns <- coords$columns[order(corresp@columns@order), ]
-
-    ## Seriation order
-    row_coords <- if (any(margin == 1)) order(coords$rows[, axes]) else i
-    col_coords <- if (any(margin == 2)) order(coords$columns[, axes]) else j
 
     ## New PermutationOrder object
-    .AveragePermutationOrder(
-      corresp,
-      rows_order = as.integer(row_coords),
-      columns_order = as.integer(col_coords)
-    )
+    as_seriation(corresp, margin = margin, axes = axes)
   }
 )
diff --git a/R/seriation_coerce.R b/R/seriation_coerce.R
new file mode 100644
index 0000000..6a9f9af
--- /dev/null
+++ b/R/seriation_coerce.R
@@ -0,0 +1,41 @@
+#' @include AllClasses.R AllGenerics.R
+NULL
+
+#' @export
+#' @rdname as_seriation
+#' @aliases as_seriation,CA-method
+setMethod(
+  f = "as_seriation",
+  signature = c(object = "CA"),
+  definition = function(object, margin = c(1, 2), axes = 1) {
+    ## Validation
+    arkhe::assert_length(axes, 1)
+
+    margin <- as.integer(margin)
+    axes <- as.integer(axes)
+
+    ## Original sequences
+    data <- dimensio::get_data(object)
+    i <- seq_len(nrow(data))
+    j <- seq_len(ncol(data))
+
+    ## Correspondence analysis
+    rows <- dimensio::get_coordinates(object, margin = 1)
+    cols <- dimensio::get_coordinates(object, margin = 2)
+
+    ## Reorder in case if supplementary observations
+    rows <- rows[order(object@rows@order), ]
+    cols <- cols[order(object@columns@order), ]
+
+    ## Seriation order
+    row_coords <- if (any(margin == 1)) order(rows[, axes]) else i
+    col_coords <- if (any(margin == 2)) order(cols[, axes]) else j
+
+    ## New PermutationOrder object
+    .AveragePermutationOrder(
+      object,
+      rows_order = as.integer(row_coords),
+      columns_order = as.integer(col_coords)
+    )
+  }
+)
diff --git a/man/as_seriation.Rd b/man/as_seriation.Rd
new file mode 100644
index 0000000..639be72
--- /dev/null
+++ b/man/as_seriation.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllGenerics.R, R/seriation_coerce.R
+\docType{methods}
+\name{as_seriation}
+\alias{as_seriation}
+\alias{as_seriation-method}
+\alias{as_seriation,CA-method}
+\title{Coerce an \R Object to a Seriation Order}
+\usage{
+as_seriation(object, ...)
+
+\S4method{as_seriation}{CA}(object, margin = c(1, 2), axes = 1)
+}
+\arguments{
+\item{object}{An \R object.}
+
+\item{...}{Currently not used.}
+
+\item{margin}{A \code{\link{numeric}} vector giving the subscripts which the
+rearrangement will be applied over: \code{1} indicates rows, \code{2} indicates
+columns, \code{c(1, 2)} indicates rows then columns, \code{c(2, 1)} indicates columns
+then rows.}
+
+\item{axes}{An \code{\link{integer}} vector giving the subscripts of the CA axes to be
+used.}
+}
+\value{
+A \code{\linkS4class{PermutationOrder}} object.
+}
+\description{
+Coerce an \R Object to a Seriation Order
+}
+\seealso{
+Other seriation methods: 
+\code{\link{assess}()},
+\code{\link{order}()},
+\code{\link{permute}()},
+\code{\link{refine}()},
+\code{\link{seriate_average}()},
+\code{\link{seriate_rank}()}
+}
+\author{
+N. Frerebeau
+}
+\concept{seriation methods}
diff --git a/man/assess.Rd b/man/assess.Rd
index b190602..62b6661 100644
--- a/man/assess.Rd
+++ b/man/assess.Rd
@@ -76,6 +76,7 @@ Seriation Solutions. \emph{Journal of Archaeological Science}, 40(12): 4552-4559
 }
 \seealso{
 Other seriation methods: 
+\code{\link{as_seriation}()},
 \code{\link{order}()},
 \code{\link{permute}()},
 \code{\link{refine}()},
diff --git a/man/order.Rd b/man/order.Rd
index 4abc346..ef619d0 100644
--- a/man/order.Rd
+++ b/man/order.Rd
@@ -48,6 +48,7 @@ order_columns(indices)
 }
 \seealso{
 Other seriation methods: 
+\code{\link{as_seriation}()},
 \code{\link{assess}()},
 \code{\link{permute}()},
 \code{\link{refine}()},
diff --git a/man/permute.Rd b/man/permute.Rd
index 80854b5..b0716e9 100644
--- a/man/permute.Rd
+++ b/man/permute.Rd
@@ -47,6 +47,7 @@ order_columns(indices)
 }
 \seealso{
 Other seriation methods: 
+\code{\link{as_seriation}()},
 \code{\link{assess}()},
 \code{\link{order}()},
 \code{\link{refine}()},
diff --git a/man/refine.Rd b/man/refine.Rd
index a8c5823..34d9cb3 100644
--- a/man/refine.Rd
+++ b/man/refine.Rd
@@ -77,6 +77,7 @@ Archaeological Science}, 39(8), 2818-2827.
 \code{\link[dimensio:reexports]{dimensio::bootstrap()}}
 
 Other seriation methods: 
+\code{\link{as_seriation}()},
 \code{\link{assess}()},
 \code{\link{order}()},
 \code{\link{permute}()},
diff --git a/man/seriate_average.Rd b/man/seriate_average.Rd
index f3cb122..8913a62 100644
--- a/man/seriate_average.Rd
+++ b/man/seriate_average.Rd
@@ -89,6 +89,7 @@ Challenge}. Berlin Heidelberg: Springer, p. 307-316.
 \code{\link[dimensio:ca]{dimensio::ca()}}
 
 Other seriation methods: 
+\code{\link{as_seriation}()},
 \code{\link{assess}()},
 \code{\link{order}()},
 \code{\link{permute}()},
diff --git a/man/seriate_rank.Rd b/man/seriate_rank.Rd
index cde7f8f..f735f08 100644
--- a/man/seriate_rank.Rd
+++ b/man/seriate_rank.Rd
@@ -77,6 +77,7 @@ Challenge}. Berlin Heidelberg: Springer, p. 307-316.
 }
 \seealso{
 Other seriation methods: 
+\code{\link{as_seriation}()},
 \code{\link{assess}()},
 \code{\link{order}()},
 \code{\link{permute}()},