Add simplify() for table collection

Author: LynxJinyangii

RcppTskit/.Rbuildignore

@@ -5,6 +5,9 @@
 ^[.]?air[.]toml$
 ^[.]?jarl[.]toml$
 ^\.Rproj\.user$
+^\.idea$
+^src/\.idea$
+^src/tskit/\.idea$
 ^\.\.$
 ^\.clang-format$
 ^\.covrignore$

RcppTskit/NEWS.md

@@ -53,6 +53,9 @@ and releases adhere to [Semantic Versioning](https://semver.org/spec/v2.0.0.html
   to retrieve node-table rows by 0-based row index.
 - Added `rtsk_table_collection_sort()` and `TableCollection$sort()` to sort
   table collections.
+- Added `rtsk_table_collection_simplify()` and
+  `TableCollection$simplify()` to simplify table collections, with C-level
+  options at low level and Python-style arguments at the R6 level.
 - Added low-level variant iterators
   (`rtsk_variant_iterator_init()`/`rtsk_variant_iterator_next()`) and a
   user-facing `TreeSequence$variants()` method to iterate over decoded
@@ -74,7 +77,7 @@ and releases adhere to [Semantic Versioning](https://semver.org/spec/v2.0.0.html
   `pointer` to `xptr`.
 - Ensured `TableCollection$tree_sequence()` matches `tskit Python` API:
   it now builds indexes on the `TableCollection`, if indexes are not present.
-- Refined integer validation behavior across scalar and optional vector inputs.
+- Refined integer validation behaviour across scalar and optional vector inputs.
 - We now use `bit64::integer64` (signed 64 bit integer) instead of `int` aiming
   to approach `tsk_size_t` in `tskit C` (unsigned 64 bit integer); in low-level
   `rtsk_treeseq_get_num_*()` wrappers and count/metadata-length fields.

RcppTskit/R/Class-TableCollection.R

@@ -131,6 +131,165 @@ TableCollection <- R6Class(
       )
     },
 
+    #' @description Simplify this table collection in place.
+    #' @param samples optional integer vector of node IDs to retain as samples.
+    #'   If \code{NULL}, use nodes currently marked with sample flags.
+    #' @param reduce_to_site_topology logical; if \code{TRUE}, keep only
+    #'   topology needed for trees containing sites.
+    #' @param filter_populations optional logical; if \code{NULL}, treated as
+    #'   \code{TRUE}.
+    #' @param filter_individuals optional logical; if \code{NULL}, treated as
+    #'   \code{TRUE}.
+    #' @param filter_sites optional logical; if \code{NULL}, treated as
+    #'   \code{TRUE}.
+    #' @param filter_nodes optional logical; if \code{NULL}, treated as
+    #'   \code{TRUE}.
+    #' @param update_sample_flags optional logical; if \code{NULL}, treated as
+    #'   \code{TRUE}.
+    #' @param keep_unary logical; if \code{TRUE}, keep unary nodes.
+    #' @param keep_unary_in_individuals optional logical; if \code{NULL},
+    #'   treated as \code{FALSE}.
+    #' @param keep_input_roots logical; if \code{TRUE}, keep input roots.
+    #' @param record_provenance logical; if \code{TRUE}, append a provenance row
+    #'   describing the simplify command.
+    #' @param filter_zero_mutation_sites deprecated alias for
+    #'   \code{filter_sites}.
+    #' @details See the \code{tskit Python} equivalent at
+    #'   \url{https://tskit.dev/tskit/docs/stable/python-api.html#tskit.TableCollection.simplify}.
+    #' @return Integer vector mapping input node IDs to simplified node IDs.
+    #'   Dropped nodes map to \code{-1}.
+    #' @examples
+    #' ts_file <- system.file("examples/test.trees", package = "RcppTskit")
+    #' tc <- tc_load(ts_file)
+    #' node_map <- tc$simplify(samples = c(0L, 1L, 2L, 3L))
+    #' is.integer(node_map)
+    simplify = function(
+      samples = NULL,
+      reduce_to_site_topology = FALSE,
+      filter_populations = NULL,
+      filter_individuals = NULL,
+      filter_sites = NULL,
+      filter_nodes = NULL,
+      update_sample_flags = NULL,
+      keep_unary = FALSE,
+      keep_unary_in_individuals = NULL,
+      keep_input_roots = FALSE,
+      record_provenance = TRUE,
+      filter_zero_mutation_sites = NULL
+    ) {
+      if (!is.null(samples)) {
+        validate_optional_integer_vector_arg(samples, "samples")
+        samples <- as.integer(samples)
+      }
+      validate_logical_arg(reduce_to_site_topology, "reduce_to_site_topology")
+      validate_logical_arg(keep_unary, "keep_unary")
+      validate_logical_arg(keep_input_roots, "keep_input_roots")
+      validate_logical_arg(record_provenance, "record_provenance")
+
+      if (!is.null(filter_zero_mutation_sites)) {
+        validate_logical_arg(
+          filter_zero_mutation_sites,
+          "filter_zero_mutation_sites"
+        )
+        if (
+          !is.null(filter_sites) &&
+            !identical(filter_sites, filter_zero_mutation_sites)
+        ) {
+          stop("filter_sites and filter_zero_mutation_sites are inconsistent!")
+        }
+        warning(
+          "filter_zero_mutation_sites is deprecated; use filter_sites",
+          call. = FALSE
+        )
+        filter_sites <- filter_zero_mutation_sites
+      }
+
+      resolve_optional_logical <- function(value, name, default) {
+        if (is.null(value)) {
+          return(default)
+        }
+        validate_logical_arg(value, name)
+        return(value)
+      }
+
+      filter_populations <- resolve_optional_logical(
+        filter_populations,
+        "filter_populations",
+        TRUE
+      )
+      filter_individuals <- resolve_optional_logical(
+        filter_individuals,
+        "filter_individuals",
+        TRUE
+      )
+      filter_sites <- resolve_optional_logical(
+        filter_sites,
+        "filter_sites",
+        TRUE
+      )
+      filter_nodes <- resolve_optional_logical(
+        filter_nodes,
+        "filter_nodes",
+        TRUE
+      )
+      update_sample_flags <- resolve_optional_logical(
+        update_sample_flags,
+        "update_sample_flags",
+        TRUE
+      )
+      keep_unary_in_individuals <- resolve_optional_logical(
+        keep_unary_in_individuals,
+        "keep_unary_in_individuals",
+        FALSE
+      )
+
+      if (keep_unary && keep_unary_in_individuals) {
+        stop("keep_unary and keep_unary_in_individuals cannot both be TRUE!")
+      }
+
+      options <- 0L
+      if (filter_sites) {
+        options <- bitwOr(options, bitwShiftL(1L, 0))
+      }
+      if (filter_populations) {
+        options <- bitwOr(options, bitwShiftL(1L, 1))
+      }
+      if (filter_individuals) {
+        options <- bitwOr(options, bitwShiftL(1L, 2))
+      }
+      if (reduce_to_site_topology) {
+        options <- bitwOr(options, bitwShiftL(1L, 3))
+      }
+      if (keep_unary) {
+        options <- bitwOr(options, bitwShiftL(1L, 4))
+      }
+      if (keep_input_roots) {
+        options <- bitwOr(options, bitwShiftL(1L, 5))
+      }
+      if (keep_unary_in_individuals) {
+        options <- bitwOr(options, bitwShiftL(1L, 6))
+      }
+      if (!filter_nodes) {
+        options <- bitwOr(options, bitwShiftL(1L, 7))
+      }
+      if (!update_sample_flags) {
+        options <- bitwOr(options, bitwShiftL(1L, 8))
+      }
+
+      node_map <- rtsk_table_collection_simplify(
+        tc = self$xptr,
+        samples = samples,
+        options = options
+      )
+
+      if (record_provenance) {
+        self$provenance_table_add_row(
+          record = "{\"command\":\"simplify\",\"TODO\":\"add simplify parameters\"}"
+        )
+      }
+      return(node_map)
+    },
+
     #' @description Get the number of provenances in a table collection.
     #' @return A signed 64 bit integer \code{bit64::integer64}.
     #' @examples

RcppTskit/R/RcppExports.R

@@ -223,6 +223,10 @@ rtsk_table_collection_sort <- function(tc, edge_start = 0L, site_start = 0L, mut
     invisible(.Call(`_RcppTskit_rtsk_table_collection_sort`, tc, edge_start, site_start, mutation_start, options))
 }
 
+rtsk_table_collection_simplify <- function(tc, samples = NULL, options = 0L) {
+    .Call(`_RcppTskit_rtsk_table_collection_simplify`, tc, samples, options)
+}
+
 rtsk_table_collection_summary <- function(tc) {
     .Call(`_RcppTskit_rtsk_table_collection_summary`, tc)
 }

RcppTskit/inst/include/RcppTskit_public.hpp

@@ -64,6 +64,9 @@ void rtsk_table_collection_build_index(SEXP tc, int options = 0);
 void rtsk_table_collection_drop_index(SEXP tc, int options = 0);
 void rtsk_table_collection_sort(SEXP tc, int edge_start = 0, int site_start = 0,
                                 int mutation_start = 0, int options = 0);
+Rcpp::IntegerVector rtsk_table_collection_simplify(
+    SEXP tc, Rcpp::Nullable<Rcpp::IntegerVector> samples = R_NilValue,
+    int options = 0);
 Rcpp::List rtsk_table_collection_summary(SEXP tc);
 Rcpp::List rtsk_table_collection_metadata_length(SEXP tc);
 int rtsk_individual_table_add_row(