From 53b2890584e953ff9816a91a8a765708b1fbfd1b Mon Sep 17 00:00:00 2001 From: Gregor Gorjanc Date: Thu, 5 Mar 2026 20:53:34 +0000 Subject: [PATCH] Added rtsk_individual_table_add_row() and tc.individual_table_add_row() Fixes #120 --- RcppTskit/NEWS.md | 3 + RcppTskit/R/Class-TableCollection.R | 49 ++++++ RcppTskit/R/RcppExports.R | 8 + RcppTskit/inst/include/RcppTskit_public.hpp | 5 + RcppTskit/man/TableCollection.Rd | 71 ++++++++ RcppTskit/src/RcppExports.cpp | 27 +++ RcppTskit/src/RcppTskit.cpp | 160 ++++++++++++++++-- RcppTskit/src/tests.cpp | 30 +++- .../tests/testthat/test_TableCollection.R | 137 +++++++++++++++ 9 files changed, 472 insertions(+), 18 deletions(-) diff --git a/RcppTskit/NEWS.md b/RcppTskit/NEWS.md index 5ff9c90..6464aeb 100644 --- a/RcppTskit/NEWS.md +++ b/RcppTskit/NEWS.md @@ -28,6 +28,9 @@ and releases adhere to [Semantic Versioning](https://semver.org/spec/v2.0.0.html - Added `TableCollection$build_index()` to build indexes and `TableCollection$drop_index()` to drop indexes. - Added ``TableCollection$num_*()` getters for the number of rows in the tables. +- Added `rtsk_individual_table_add_row()` and + `TableCollection$individual_table_add_row()` to append individual rows from + \code{R}, mirroring `tsk_individual_table_add_row()`. - TODO ### Changed diff --git a/RcppTskit/R/Class-TableCollection.R b/RcppTskit/R/Class-TableCollection.R index cf830a6..b67d60a 100644 --- a/RcppTskit/R/Class-TableCollection.R +++ b/RcppTskit/R/Class-TableCollection.R @@ -143,6 +143,55 @@ TableCollection <- R6Class( rtsk_table_collection_get_num_individuals(self$xptr) }, + #' @description Add a row to the individuals table. + #' @param flags integer flags for the new individual. + #' @param location numeric vector with the location of the new individual. + #' @param parents integer vector with parent individual IDs (0-based). + #' @param metadata for the new individual; accepts \code{NULL}, + #' a raw vector, or a character of length 1. + #' @details See the \code{tskit Python} equivalent at + #' \url{https://tskit.dev/tskit/docs/stable/python-api.html#tskit.IndividualTable.add_row}. + #' The function casts inputs to the expected class. + #' @return Integer row ID (0-based) of the newly added individual. + #' @examples + #' ts_file <- system.file("examples/test.trees", package = "RcppTskit") + #' tc <- tc_load(ts_file) + #' n_before <- tc$num_individuals() + #' new_id <- tc$individual_table_add_row() + #' new_id <- tc$individual_table_add_row(location = c(5, 8)) + #' new_id <- tc$individual_table_add_row(flags = 0L) + #' new_id <- tc$individual_table_add_row(parents = c(0L, 2L)) + #' new_id <- tc$individual_table_add_row(metadata = "abc") + #' new_id <- tc$individual_table_add_row(metadata = charToRaw("cba")) + #' n_after <- tc$num_individuals() + individual_table_add_row = function( + flags = 0L, + location = NULL, + parents = NULL, + metadata = NULL + ) { + if (is.null(metadata)) { + metadata_raw <- NULL + } else if (is.raw(metadata)) { + metadata_raw <- metadata + } else if ( + is.character(metadata) && length(metadata) == 1L && !is.na(metadata) + ) { + metadata_raw <- charToRaw(metadata) + } else { + stop( + "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) + } + rtsk_individual_table_add_row( + tc = self$xptr, + flags = as.integer(flags), + location = if (is.null(location)) NULL else as.numeric(location), + parents = if (is.null(parents)) NULL else as.integer(parents), + metadata = metadata_raw + ) + }, + #' @description Get the number of nodes in a table collection. #' @return A signed 64 bit integer \code{bit64::integer64}. #' @examples diff --git a/RcppTskit/R/RcppExports.R b/RcppTskit/R/RcppExports.R index e2e2676..e809dba 100644 --- a/RcppTskit/R/RcppExports.R +++ b/RcppTskit/R/RcppExports.R @@ -203,6 +203,10 @@ rtsk_table_collection_metadata_length <- function(tc) { .Call(`_RcppTskit_rtsk_table_collection_metadata_length`, tc) } +rtsk_individual_table_add_row <- function(tc, flags = 0L, location = NULL, parents = NULL, metadata = NULL) { + .Call(`_RcppTskit_rtsk_individual_table_add_row`, tc, flags, location, parents, metadata) +} + test_tsk_bug_assert_c <- function() { invisible(.Call(`_RcppTskit_test_tsk_bug_assert_c`)) } @@ -235,3 +239,7 @@ test_rtsk_table_collection_build_index_forced_error <- function(tc) { invisible(.Call(`_RcppTskit_test_rtsk_table_collection_build_index_forced_error`, tc)) } +test_rtsk_individual_table_add_row_forced_error <- function(tc) { + invisible(.Call(`_RcppTskit_test_rtsk_individual_table_add_row_forced_error`, tc)) +} + diff --git a/RcppTskit/inst/include/RcppTskit_public.hpp b/RcppTskit/inst/include/RcppTskit_public.hpp index eb4b7fc..6d62e09 100644 --- a/RcppTskit/inst/include/RcppTskit_public.hpp +++ b/RcppTskit/inst/include/RcppTskit_public.hpp @@ -57,5 +57,10 @@ void rtsk_table_collection_build_index(SEXP tc, int options = 0); void rtsk_table_collection_drop_index(SEXP tc, 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( + SEXP tc, int flags = 0, + Rcpp::Nullable location = R_NilValue, + Rcpp::Nullable parents = R_NilValue, + Rcpp::Nullable metadata = R_NilValue); #endif diff --git a/RcppTskit/man/TableCollection.Rd b/RcppTskit/man/TableCollection.Rd index cbce99d..9666d08 100644 --- a/RcppTskit/man/TableCollection.Rd +++ b/RcppTskit/man/TableCollection.Rd @@ -73,6 +73,21 @@ tc_file <- system.file("examples/test.trees", package = "RcppTskit") tc <- tc_load(tc_file) tc$num_individuals() +## ------------------------------------------------ +## Method `TableCollection$individual_table_add_row` +## ------------------------------------------------ + +ts_file <- system.file("examples/test.trees", package = "RcppTskit") +tc <- tc_load(ts_file) +n_before <- tc$num_individuals() +new_id <- tc$individual_table_add_row() +new_id <- tc$individual_table_add_row(location = c(5, 8)) +new_id <- tc$individual_table_add_row(flags = 0L) +new_id <- tc$individual_table_add_row(parents = c(0L, 2L)) +new_id <- tc$individual_table_add_row(metadata = "abc") +new_id <- tc$individual_table_add_row(metadata = charToRaw("cba")) +n_after <- tc$num_individuals() + ## ------------------------------------------------ ## Method `TableCollection$num_nodes` ## ------------------------------------------------ @@ -224,6 +239,7 @@ tc \item \href{#method-TableCollection-num_populations}{\code{TableCollection$num_populations()}} \item \href{#method-TableCollection-num_migrations}{\code{TableCollection$num_migrations()}} \item \href{#method-TableCollection-num_individuals}{\code{TableCollection$num_individuals()}} +\item \href{#method-TableCollection-individual_table_add_row}{\code{TableCollection$individual_table_add_row()}} \item \href{#method-TableCollection-num_nodes}{\code{TableCollection$num_nodes()}} \item \href{#method-TableCollection-num_edges}{\code{TableCollection$num_edges()}} \item \href{#method-TableCollection-num_sites}{\code{TableCollection$num_sites()}} @@ -465,6 +481,61 @@ tc$num_individuals() } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TableCollection-individual_table_add_row}{}}} +\subsection{Method \code{individual_table_add_row()}}{ +Add a row to the individuals table. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TableCollection$individual_table_add_row( + flags = 0L, + location = NULL, + parents = NULL, + metadata = NULL +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{flags}}{integer flags for the new individual.} + +\item{\code{location}}{numeric vector with the location of the new individual.} + +\item{\code{parents}}{integer vector with parent individual IDs (0-based).} + +\item{\code{metadata}}{for the new individual; accepts \code{NULL}, +a raw vector, or a character of length 1.} +} +\if{html}{\out{
}} +} +\subsection{Details}{ +See the \code{tskit Python} equivalent at + \url{https://tskit.dev/tskit/docs/stable/python-api.html#tskit.IndividualTable.add_row}. + The function casts inputs to the expected class. +} + +\subsection{Returns}{ +Integer row ID (0-based) of the newly added individual. +} +\subsection{Examples}{ +\if{html}{\out{
}} +\preformatted{ts_file <- system.file("examples/test.trees", package = "RcppTskit") +tc <- tc_load(ts_file) +n_before <- tc$num_individuals() +new_id <- tc$individual_table_add_row() +new_id <- tc$individual_table_add_row(location = c(5, 8)) +new_id <- tc$individual_table_add_row(flags = 0L) +new_id <- tc$individual_table_add_row(parents = c(0L, 2L)) +new_id <- tc$individual_table_add_row(metadata = "abc") +new_id <- tc$individual_table_add_row(metadata = charToRaw("cba")) +n_after <- tc$num_individuals() +} +\if{html}{\out{
}} + +} + } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/RcppTskit/src/RcppExports.cpp b/RcppTskit/src/RcppExports.cpp index f3ae137..ccea595 100644 --- a/RcppTskit/src/RcppExports.cpp +++ b/RcppTskit/src/RcppExports.cpp @@ -534,6 +534,21 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// rtsk_individual_table_add_row +int rtsk_individual_table_add_row(const SEXP tc, const int flags, const Rcpp::Nullable location, const Rcpp::Nullable parents, const Rcpp::Nullable metadata); +RcppExport SEXP _RcppTskit_rtsk_individual_table_add_row(SEXP tcSEXP, SEXP flagsSEXP, SEXP locationSEXP, SEXP parentsSEXP, SEXP metadataSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + Rcpp::traits::input_parameter< const int >::type flags(flagsSEXP); + Rcpp::traits::input_parameter< const Rcpp::Nullable >::type location(locationSEXP); + Rcpp::traits::input_parameter< const Rcpp::Nullable >::type parents(parentsSEXP); + Rcpp::traits::input_parameter< const Rcpp::Nullable >::type metadata(metadataSEXP); + rcpp_result_gen = Rcpp::wrap(rtsk_individual_table_add_row(tc, flags, location, parents, metadata)); + return rcpp_result_gen; +END_RCPP +} // test_tsk_bug_assert_c void test_tsk_bug_assert_c(); RcppExport SEXP _RcppTskit_test_tsk_bug_assert_c() { @@ -612,6 +627,16 @@ BEGIN_RCPP return R_NilValue; END_RCPP } +// test_rtsk_individual_table_add_row_forced_error +void test_rtsk_individual_table_add_row_forced_error(const SEXP tc); +RcppExport SEXP _RcppTskit_test_rtsk_individual_table_add_row_forced_error(SEXP tcSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP); + test_rtsk_individual_table_add_row_forced_error(tc); + return R_NilValue; +END_RCPP +} static const R_CallMethodDef CallEntries[] = { {"_RcppTskit_test_validate_options", (DL_FUNC) &_RcppTskit_test_validate_options, 2}, @@ -661,6 +686,7 @@ static const R_CallMethodDef CallEntries[] = { {"_RcppTskit_rtsk_table_collection_drop_index", (DL_FUNC) &_RcppTskit_rtsk_table_collection_drop_index, 2}, {"_RcppTskit_rtsk_table_collection_summary", (DL_FUNC) &_RcppTskit_rtsk_table_collection_summary, 1}, {"_RcppTskit_rtsk_table_collection_metadata_length", (DL_FUNC) &_RcppTskit_rtsk_table_collection_metadata_length, 1}, + {"_RcppTskit_rtsk_individual_table_add_row", (DL_FUNC) &_RcppTskit_rtsk_individual_table_add_row, 5}, {"_RcppTskit_test_tsk_bug_assert_c", (DL_FUNC) &_RcppTskit_test_tsk_bug_assert_c, 0}, {"_RcppTskit_test_tsk_bug_assert_cpp", (DL_FUNC) &_RcppTskit_test_tsk_bug_assert_cpp, 0}, {"_RcppTskit_test_tsk_trace_error_c", (DL_FUNC) &_RcppTskit_test_tsk_trace_error_c, 0}, @@ -669,6 +695,7 @@ static const R_CallMethodDef CallEntries[] = { {"_RcppTskit_test_rtsk_treeseq_copy_tables_forced_error", (DL_FUNC) &_RcppTskit_test_rtsk_treeseq_copy_tables_forced_error, 1}, {"_RcppTskit_test_rtsk_treeseq_init_forced_error", (DL_FUNC) &_RcppTskit_test_rtsk_treeseq_init_forced_error, 1}, {"_RcppTskit_test_rtsk_table_collection_build_index_forced_error", (DL_FUNC) &_RcppTskit_test_rtsk_table_collection_build_index_forced_error, 1}, + {"_RcppTskit_test_rtsk_individual_table_add_row_forced_error", (DL_FUNC) &_RcppTskit_test_rtsk_individual_table_add_row_forced_error, 1}, {NULL, NULL, 0} }; diff --git a/RcppTskit/src/RcppTskit.cpp b/RcppTskit/src/RcppTskit.cpp index 0d35b0c..392785b 100644 --- a/RcppTskit/src/RcppTskit.cpp +++ b/RcppTskit/src/RcppTskit.cpp @@ -7,6 +7,7 @@ #include #include #include +#include namespace { // namespace to keep the contents local to this file @@ -140,11 +141,44 @@ tsk_flags_t validate_options(const int options, const tsk_flags_t supported, constexpr tsk_size_t kMaxBit64Integer64 = static_cast(std::numeric_limits::max()); +// INTERNAL +// @title Convert \code{Rcpp::Nullable} vector to empty-or-value vector +// @param value nullable vector from \code{R} +// @return Empty vector if \code{NULL}, otherwise converted vector. +template +VectorT nullable_to_vector_or_empty(const Rcpp::Nullable &value) { + if (value.isNull()) { + return VectorT(); + } + return Rcpp::as(value); +} + +// INTERNAL +// @title Convert \code{integer} vector to \code{tsk_id_t} vector +// @param ids \code{integer} values (must not have \code{NA} values). +// @param caller function name. +// @details \code{tsk_id_t} is \code{int32_t} (a standard integer) +// \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_id_t} +// @return ID values cast to \code{tsk_id_t}. +std::vector int_vector_to_tsk_id_vector( + const Rcpp::IntegerVector &ids, + const char *caller = "int_vector_to_tsk_id_vector") { + std::vector out; + out.reserve(ids.size()); + for (const int id : ids) { + if (Rcpp::IntegerVector::is_na(id)) { + Rcpp::stop("NA_integer_ values not allowed in %s", caller); + } + out.push_back(static_cast(id)); + } + return out; +} + // INTERNAL // @title Wrap \code{C tsk_size_t / uint64_t} to \code{R bit64::integer64} // @param value \code{C tsk_size_t / uint64_t} value // @param caller function name -// @details See +// @details \code{tsk_id_t} is \code{uint64_t} // \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_size_t}, // an unsigned 64 bit integer with range from 0 to 2^64 - 1 // (that is, 0 to 18,446,744,073,709,551,615). @@ -172,7 +206,7 @@ SEXP rtsk_wrap_tsk_size_t_as_integer64(const tsk_size_t value, // TEST-ONLY // @title Test helper for validating tskit flags -// @param options integer options +// @param options that will be validated // @param supported integer bitmask for supported options // @return Validated flags as integer. // [[Rcpp::export]] @@ -243,7 +277,7 @@ Rcpp::IntegerVector tskit_version() { // PUBLIC, wrapper for tsk_treeseq_load // @title Load a tree sequence from a file // @param filename a string specifying the full path of the tree sequence file. -// @param options \code{tskit} bitwise flags (see details and note that only +// @param options passed to \code{tskit C} (see details and note that only // \code{TSK_LOAD_SKIP_TABLES} and \code{TSK_LOAD_SKIP_REFERENCE_SEQUENCE}, // but not \code{TSK_NO_INIT}, are supported by this wrapper). // @details This function calls @@ -282,7 +316,7 @@ SEXP rtsk_treeseq_load(const std::string &filename, const int options = 0) { // PUBLIC, wrapper for tsk_table_collection_load // @title Load a table collection from a file // @param filename a string specifying the full path of the tree sequence file. -// @param options \code{tskit} bitwise flags (see details and note that only +// @param options passed to \code{tskit C} (see details and note that only // \code{TSK_LOAD_SKIP_TABLES} and \code{TSK_LOAD_SKIP_REFERENCE_SEQUENCE}, // but not \code{TSK_NO_INIT}, are supported by this wrapper). // @details This function calls @@ -323,7 +357,7 @@ SEXP rtsk_table_collection_load(const std::string &filename, // @param ts an external pointer to tree sequence as a \code{tsk_treeseq_t} // object. // @param filename a string specifying the full path of the tree sequence file. -// @param options \code{tskit} bitwise flags (see details and note that +// @param options passed to \code{tskit C} (see details and note that // these options are currently unused in \code{tskit} and should be \code{0}). // @details This function calls // \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_treeseq_dump}. @@ -350,7 +384,7 @@ void rtsk_treeseq_dump(const SEXP ts, const std::string &filename, // @param tc an external pointer to table collection as a // \code{tsk_table_collection_t} object. // @param filename a string specifying the full path of the tree sequence file. -// @param options \code{tskit} bitwise flags (see details and note that +// @param options passed to \code{tskit C} (see details and note that // these options are currently unused in \code{tskit} and should be \code{0}). // @details This function calls // \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_table_collection_dump}. @@ -377,7 +411,7 @@ void rtsk_table_collection_dump(const SEXP tc, const std::string &filename, // @title Copy a tree sequence's tables into a table collection // @param ts an external pointer to tree sequence as a \code{tsk_treeseq_t} // object. -// @param options \code{tskit} bitwise flags (see details and note that +// @param options passed to \code{tskit C} (see details and note that // this wrapper does not support \code{TSK_NO_INIT}, but supports // \code{TSK_COPY_FILE_UUID}). // @details This function calls @@ -418,7 +452,7 @@ SEXP rtsk_treeseq_copy_tables(const SEXP ts, const int options = 0) { // @title Initialise a tree sequence from a table collection // @param tc an external pointer to table collection as a // \code{tsk_table_collection_t} object. -// @param options \code{tskit} bitwise flags (see details and note that +// @param options passed to \code{tskit C} (see details and note that // this wrapper supports // \code{TSK_TS_INIT_BUILD_INDEXES} and // \code{TSK_TS_INIT_COMPUTE_MUTATION_PARENTS}, but not @@ -1021,9 +1055,8 @@ bool rtsk_table_collection_has_index(const SEXP tc, const int options = 0) { // @title Build indexes for a table collection // @param tc an external pointer to table collection as a // \code{tsk_table_collection_t} object. -// @param options \code{tskit} bitwise flags, currently unused and should be -// set -// to 0 +// @param options passed to \code{tskit C}, currently unused and should be +// set to \code{0}. // @details This function calls // \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_table_collection_build_index}. // @return No return value; called for side effects. @@ -1050,9 +1083,8 @@ void rtsk_table_collection_build_index(const SEXP tc, const int options = 0) { // @title Drop indexes for a table collection // @param tc an external pointer to table collection as a // \code{tsk_table_collection_t} object. -// @param options \code{tskit} bitwise flags, currently unused and should be -// set -// to 0 +// @param options passed to \code{tskit C}, currently unused and should be +// set to \code{0}. // @details This function calls // \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_table_collection_drop_index}. // @return No return value; called for side effects. @@ -1088,9 +1120,8 @@ void rtsk_table_collection_drop_index(const SEXP tc, const int options = 0) { // @title Summary of properties and number of records in a table collection // @param tc an external pointer to table collection as a // \code{tsk_table_collection_t} object. -// @param options \code{tskit} bitwise flags, currently unused and should be -// set -// to 0 +// @param options passed to \code{tskit C}, currently unused and should be +// set to \code{0}. // @details These functions return the summary of properties and number of // records in a table collection, by accessing its elements and/or calling // \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_table_collection_has_index} @@ -1206,3 +1237,98 @@ Rcpp::List rtsk_table_collection_metadata_length(const SEXP tc) { // TODO: Develop rtsk_table_collection_metadata_schema // TODO: Metadata notes if we do anything with metadata #36 // https://github.com/HighlanderLab/RcppTskit/issues/36 + +// PUBLIC, wrapper for tsk_individual_table_add_row +// @title Add a row to the individual table in a table collection +// @param tc an external pointer to table collection as a +// \code{tsk_table_collection_t} object. +// @param flags passed to \code{tskit C}. +// @param location numeric vector with the location of the new individual +// (can be \code{NULL}). +// @param parents integer vector with parent individual IDs +// (can be \code{NULL}). +// @param metadata raw vector with metadata bytes +// (can be \code{NULL}). +// @details This function calls +// \url{https://tskit.dev/tskit/docs/stable/c-api.html#c.tsk_individual_table_add_row} +// on the individuals table of \code{tc}. +// @return The 0-based row ID of the newly added individual. +// @examples +// ts_file <- system.file("examples/test.trees", package = "RcppTskit") +// tc_xptr <- RcppTskit:::rtsk_table_collection_load(ts_file) +// n_before <- RcppTskit:::rtsk_table_collection_get_num_individuals(tc_xptr) +// tc_py <- RcppTskit:::rtsk_table_collection_r_to_py(tc_xptr) +// tc_py$individuals$max_rows +// tc_py$individuals["flags"] +// tc_py$individuals["location"] +// tc_py$individuals["location_offset"] +// tc_py$individuals["parents"] +// tc_py$individuals["parents_offset"] +// tc_py$individuals["metadata"] +// tc_py$individuals["metadata_offset"] +// new_id <- RcppTskit:::rtsk_individual_table_add_row(tc = tc_xptr) +// new_id <- RcppTskit:::rtsk_individual_table_add_row(tc = tc_xptr, +// location = c(5, 8)) +// new_id <- RcppTskit:::rtsk_individual_table_add_row(tc = tc_xptr, flags = 0L, +// location = c(1, 2)) +// new_id <- RcppTskit:::rtsk_individual_table_add_row(tc = tc_xptr, flags = 1L, +// location = c(11, 3)) +// new_id <- RcppTskit:::rtsk_individual_table_add_row(tc = tc_xptr, flags = 2L, +// location = c(7, 8), parents = c(0L)) +// new_id <- RcppTskit:::rtsk_individual_table_add_row(tc = tc_xptr, flags = 3L, +// location = c(2, 11), parents = c(1L, 3L), metadata = charToRaw("abc")) +// n_after <- RcppTskit:::rtsk_table_collection_get_num_individuals(tc_xptr) +// new_id == as.integer(n_before) && n_after == n_before + 3L +// tc_py <- RcppTskit:::rtsk_table_collection_r_to_py(tc_xptr) +// tc_py$individuals$max_rows +// tc_py$individuals["flags"] +// tc_py$individuals["location"] +// tc_py$individuals["location_offset"] +// tc_py$individuals["parents"] +// tc_py$individuals["parents_offset"] +// tc_py$individuals["metadata"] +// tc_py$individuals["metadata_offset"] +// [[Rcpp::export]] +int rtsk_individual_table_add_row( + const SEXP tc, const int flags = 0, + const Rcpp::Nullable location = R_NilValue, + const Rcpp::Nullable parents = R_NilValue, + const Rcpp::Nullable metadata = R_NilValue) { + if (flags < 0) { + Rcpp::stop("rtsk_individual_table_add_row does not support negative flags"); + } + const tsk_flags_t row_flags = static_cast(flags); + rtsk_table_collection_t tc_xptr(tc); + + // Prepare inputs for tskit C tsk_individual_table_add_row() in expected form + const Rcpp::NumericVector location_vec = + nullable_to_vector_or_empty(location); + const tsk_size_t location_length = + static_cast(location_vec.size()); + const double *location_ptr = + location_length > 0 ? REAL(location_vec) : nullptr; + + const Rcpp::IntegerVector parents_in = + nullable_to_vector_or_empty(parents); + const std::vector parents_vec = + int_vector_to_tsk_id_vector(parents_in, "rtsk_individual_table_add_row"); + const tsk_size_t parents_length = static_cast(parents_vec.size()); + const tsk_id_t *parents_ptr = + parents_length > 0 ? parents_vec.data() : nullptr; + + const Rcpp::RawVector metadata_vec = + nullable_to_vector_or_empty(metadata); + const tsk_size_t metadata_length = + static_cast(metadata_vec.size()); + const char *metadata_ptr = + metadata_length > 0 ? reinterpret_cast(RAW(metadata_vec)) + : nullptr; + + const tsk_id_t row_id = tsk_individual_table_add_row( + &tc_xptr->individuals, row_flags, location_ptr, location_length, + parents_ptr, parents_length, metadata_ptr, metadata_length); + if (row_id < 0) { + Rcpp::stop(tsk_strerror(row_id)); + } + return static_cast(row_id); +} diff --git a/RcppTskit/src/tests.cpp b/RcppTskit/src/tests.cpp index c92b5ba..97ce2bf 100644 --- a/RcppTskit/src/tests.cpp +++ b/RcppTskit/src/tests.cpp @@ -96,7 +96,7 @@ SEXP test_rtsk_treeseq_init_forced_error(const SEXP tc) { // TEST-ONLY // @title Force tskit-level error path in -// \code{rtsk_table_collection_build_index} +// \code{rtsk_table_collection_build_index} // @param tc an external pointer to table collection as a // \code{tsk_table_collection_t} object. // @return No return value; called for side effects - testing. @@ -121,3 +121,31 @@ void test_rtsk_table_collection_build_index_forced_error(const SEXP tc) { throw; } } + +// TEST-ONLY +// @title Force tskit-level error path in \code{rtsk_individual_table_add_row} +// @param tc an external pointer to table collection as a +// \code{tsk_table_collection_t} object. +// @return No return value; called for side effects - testing. +// [[Rcpp::export]] +void test_rtsk_individual_table_add_row_forced_error(const SEXP tc) { + rtsk_table_collection_t tc_xptr(tc); + tsk_individual_table_t &individuals = tc_xptr->individuals; + tsk_size_t saved_max_rows = individuals.max_rows; + tsk_size_t saved_max_rows_increment = individuals.max_rows_increment; + individuals.max_rows = 1; + individuals.max_rows_increment = static_cast(TSK_MAX_ID) + 1; + try { + (void)rtsk_individual_table_add_row(tc); + // Lines below not hit by tests because rtsk_individual_table_add_row() + // throws error # nocov start + individuals.max_rows = saved_max_rows; + individuals.max_rows_increment = saved_max_rows_increment; + return; + // # nocov end + } catch (...) { + individuals.max_rows = saved_max_rows; + individuals.max_rows_increment = saved_max_rows_increment; + throw; + } +} diff --git a/RcppTskit/tests/testthat/test_TableCollection.R b/RcppTskit/tests/testthat/test_TableCollection.R index bbbe1fb..9199610 100644 --- a/RcppTskit/tests/testthat/test_TableCollection.R +++ b/RcppTskit/tests/testthat/test_TableCollection.R @@ -276,3 +276,140 @@ test_that("TableCollection index lifecycle and tree_sequence index handling work expect_no_error(tc$build_index()) expect_true(tc$has_index()) }) + +test_that("individual_table_add_row wrapper expands the table collection and handles inputs", { + ts_file <- system.file("examples/test.trees", package = "RcppTskit") + tc_xptr <- rtsk_table_collection_load(ts_file) + + n_before <- rtsk_table_collection_get_num_individuals(tc_xptr) + m_before <- rtsk_table_collection_metadata_length(tc_xptr)[["individuals"]] + + expect_error( + rtsk_individual_table_add_row(tc_xptr, flags = -1L), + regexp = "rtsk_individual_table_add_row does not support negative flags" + ) + + new_id <- rtsk_individual_table_add_row( + tc = tc_xptr, + flags = 0L, + location = c(1.25, -2.5), + metadata = charToRaw("abc") + ) + expect_equal(new_id, as.integer(n_before)) # since IDs are 0-based + expect_equal( + as.integer(rtsk_table_collection_get_num_individuals(tc_xptr)), + as.integer(n_before) + 1L + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["individuals"]]), + as.integer(m_before) + 3L + ) + + tc <- TableCollection$new(xptr = tc_xptr) + n_before_method <- tc$num_individuals() + new_id_method <- tc$individual_table_add_row() + expect_equal(new_id_method, as.integer(n_before_method)) + expect_equal( + as.integer(tc$num_individuals()), + as.integer(n_before_method) + 1L + ) + + tc_xptr <- rtsk_table_collection_load(ts_file) + + n0 <- as.integer(rtsk_table_collection_get_num_individuals(tc_xptr)) + m0 <- as.integer(rtsk_table_collection_metadata_length(tc_xptr)[[ + "individuals" + ]]) + + # Defaults map to NULL in the generated R wrapper and should be accepted. + id0 <- rtsk_individual_table_add_row(tc_xptr) + expect_equal(id0, n0) + expect_equal( + as.integer(rtsk_table_collection_get_num_individuals(tc_xptr)), + n0 + 1L + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["individuals"]]), + m0 + ) + + # Explicit NULL should also be accepted and behave like empty vectors. + id1 <- rtsk_individual_table_add_row( + tc = tc_xptr, + flags = 0L, + location = NULL, + parents = NULL, + metadata = NULL + ) + expect_equal(id1, n0 + 1L) + + # Parent IDs are provided as integer vectors and should be accepted. + id2 <- rtsk_individual_table_add_row( + tc = tc_xptr, + flags = 0L, + parents = c(id0, id1), + location = numeric(), + metadata = raw() + ) + expect_equal(id2, n0 + 2L) + expect_error( + rtsk_individual_table_add_row( + tc = tc_xptr, + flags = 0L, + parents = c(NA_integer_), + location = numeric(), + metadata = raw() + ), + regexp = "NA_integer_ values not allowed in rtsk_individual_table_add_row" + ) + + tc <- TableCollection$new(xptr = tc_xptr) + n_before_method <- as.integer(tc$num_individuals()) + expect_no_error( + tc$individual_table_add_row( + flags = 0L, + location = NULL, + parents = c(id1, id2), + metadata = NULL + ) + ) + expect_equal(as.integer(tc$num_individuals()), n_before_method + 1L) + + m_before_char <- as.integer(rtsk_table_collection_metadata_length(tc$xptr)[[ + "individuals" + ]]) + expect_no_warning(tc$individual_table_add_row(metadata = "abc")) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc$xptr)[["individuals"]]), + m_before_char + 3L + ) + m_before_raw <- as.integer(rtsk_table_collection_metadata_length(tc$xptr)[[ + "individuals" + ]]) + expect_no_error(tc$individual_table_add_row(metadata = charToRaw("xyz"))) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc$xptr)[["individuals"]]), + m_before_raw + 3L + ) + expect_error( + tc$individual_table_add_row(parents = c(NA_integer_)), + regexp = "NA_integer_ values not allowed in rtsk_individual_table_add_row" + ) + expect_error( + test_rtsk_individual_table_add_row_forced_error(tc$xptr), + regexp = "TSK_ERR_TABLE_OVERFLOW" + ) + + expect_error( + tc$individual_table_add_row(metadata = c("a", "b")), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) + expect_error( + tc$individual_table_add_row(metadata = NA_character_), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) + expect_error( + tc$individual_table_add_row(metadata = 1L), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) +})