Add as_seriation() to coerce objects to seriation orders

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'

NAMESPACE

@@ -38,6 +38,7 @@ exportMethods("[[")
 exportMethods(aoristic)
 exportMethods(apportion)
 exportMethods(as.data.frame)
+exportMethods(as_seriation)
 exportMethods(assess)
 exportMethods(bootstrap)
 exportMethods(coef)

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
 #'

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)
   }
 )

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)
+    )
+  }
+)