From 3f7192c900785cadf7db67e33655c3723a1bf40c Mon Sep 17 00:00:00 2001 From: LynxJinyangii Date: Mon, 16 Mar 2026 10:58:09 +0000 Subject: [PATCH 1/3] save work --- RcppTskit/NEWS.md | 9 + RcppTskit/R/Class-TableCollection.R | 140 ++++++ RcppTskit/R/RcppExports.R | 8 + RcppTskit/inst/include/RcppTskit_public.hpp | 6 + RcppTskit/man/TableCollection.Rd | 154 +++++++ RcppTskit/src/RcppExports.cpp | 34 ++ RcppTskit/src/RcppTskit.cpp | 164 +++++++ .../tests/testthat/test_TableCollection.R | 415 ++++++++++++++++++ 8 files changed, 930 insertions(+) diff --git a/RcppTskit/NEWS.md b/RcppTskit/NEWS.md index 6464aeb..84e0505 100644 --- a/RcppTskit/NEWS.md +++ b/RcppTskit/NEWS.md @@ -31,6 +31,15 @@ and releases adhere to [Semantic Versioning](https://semver.org/spec/v2.0.0.html - 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()`. +- Added `rtsk_node_table_add_row()` and `TableCollection$node_table_add_row()` + to append node rows from \code{R}, mirroring `tsk_node_table_add_row()`. +- Added `rtsk_edge_table_add_row()` and `TableCollection$edge_table_add_row()` + to append edge rows from \code{R}, mirroring `tsk_edge_table_add_row()`. +- `TableCollection$node_table_add_row()` now maps `population = NULL` and + `individual = NULL` to `-1` (`TSK_NULL`) for R-level convenience. +- `rtsk_edge_table_add_row()` and `TableCollection$edge_table_add_row()` now + validate `left`/`right` more explicitly (non-`NA`, finite, and `left < right`) + and require scalar `parent`/`child` IDs. - TODO ### Changed diff --git a/RcppTskit/R/Class-TableCollection.R b/RcppTskit/R/Class-TableCollection.R index b67d60a..16fadd4 100644 --- a/RcppTskit/R/Class-TableCollection.R +++ b/RcppTskit/R/Class-TableCollection.R @@ -202,6 +202,60 @@ TableCollection <- R6Class( rtsk_table_collection_get_num_nodes(self$xptr) }, + #' @description Add a row to the nodes table. + #' @param flags integer flags for the new node. + #' @param time numeric time value for the new node. + #' @param population integer population row ID (0-based, or \code{-1}); + #' \code{NULL} maps to \code{-1}. + #' @param individual integer individual row ID (0-based, or \code{-1}); + #' \code{NULL} maps to \code{-1}. + #' @param metadata for the new node; 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.NodeTable.add_row}. + #' The function casts inputs to the expected class. + #' @return Integer row ID (0-based) of the newly added node. + #' @examples + #' ts_file <- system.file("examples/test.trees", package = "RcppTskit") + #' tc <- tc_load(ts_file) + #' n_before <- tc$num_nodes() + #' new_id <- tc$node_table_add_row() + #' new_id <- tc$node_table_add_row(time = 2.5) + #' new_id <- tc$node_table_add_row(flags = 1L, time = 3.5, population = 0L) + #' new_id <- tc$node_table_add_row(flags = 1L, time = 4.5, individual = 0L) + #' new_id <- tc$node_table_add_row(metadata = "abc") + #' new_id <- tc$node_table_add_row(metadata = charToRaw("cba")) + #' n_after <- tc$num_nodes() + node_table_add_row = function( + flags = 0L, + time = 0, + population = -1L, + individual = -1L, + 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_node_table_add_row( + tc = self$xptr, + flags = as.integer(flags), + time = as.numeric(time), + population = if (is.null(population)) -1L else as.integer(population), + individual = if (is.null(individual)) -1L else as.integer(individual), + metadata = metadata_raw + ) + }, + #' @description Get the number of edges in a table collection. #' @return A signed 64 bit integer \code{bit64::integer64}. #' @examples @@ -212,6 +266,92 @@ TableCollection <- R6Class( rtsk_table_collection_get_num_edges(self$xptr) }, + #' @description Add a row to the edges table. + #' @param left numeric scalar left coordinate for the new edge. + #' @param right numeric scalar right coordinate for the new edge. + #' @param parent integer scalar parent node row ID (0-based). + #' @param child integer scalar child node row ID (0-based). + #' @param metadata for the new edge; 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.EdgeTable.add_row}. + #' The function casts inputs to the expected class. + #' @return Integer row ID (0-based) of the newly added edge. + #' @examples + #' ts_file <- system.file("examples/test.trees", package = "RcppTskit") + #' tc <- tc_load(ts_file) + #' parent <- 0L + #' child <- 1L + #' n_before <- tc$num_edges() + #' new_id <- tc$edge_table_add_row( + #' left = 0, right = 1, parent = parent, child = child + #' ) + #' new_id <- tc$edge_table_add_row( + #' left = 1, right = 2, parent = parent, child = child, metadata = "abc" + #' ) + #' new_id <- tc$edge_table_add_row( + #' left = 2, right = 3, parent = parent, child = child, metadata = charToRaw("cba") + #' ) + #' n_after <- tc$num_edges() + edge_table_add_row = function( + left, + right, + parent, + child, + metadata = NULL + ) { + if ( + is.null(left) || + length(left) != 1L || + !is.numeric(left) || + is.na(left) || + !is.finite(left) + ) { + stop("left must be a non-NA finite numeric scalar!") + } + if ( + is.null(right) || + length(right) != 1L || + !is.numeric(right) || + is.na(right) || + !is.finite(right) + ) { + stop("right must be a non-NA finite numeric scalar!") + } + if (as.numeric(left) >= as.numeric(right)) { + stop("left must be strictly less than right!") + } + if ( + is.null(parent) || length(parent) != 1L || is.na(as.integer(parent)) + ) { + stop("parent must be a non-NA integer scalar!") + } + if (is.null(child) || length(child) != 1L || is.na(as.integer(child))) { + stop("child must be a non-NA integer scalar!") + } + 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_edge_table_add_row( + tc = self$xptr, + left = as.numeric(left), + right = as.numeric(right), + parent = as.integer(parent), + child = as.integer(child), + metadata = metadata_raw + ) + }, + #' @description Get the number of sites 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 e809dba..026b403 100644 --- a/RcppTskit/R/RcppExports.R +++ b/RcppTskit/R/RcppExports.R @@ -207,6 +207,14 @@ rtsk_individual_table_add_row <- function(tc, flags = 0L, location = NULL, paren .Call(`_RcppTskit_rtsk_individual_table_add_row`, tc, flags, location, parents, metadata) } +rtsk_node_table_add_row <- function(tc, flags = 0L, time = 0, population = -1L, individual = -1L, metadata = NULL) { + .Call(`_RcppTskit_rtsk_node_table_add_row`, tc, flags, time, population, individual, metadata) +} + +rtsk_edge_table_add_row <- function(tc, left, right, parent, child, metadata = NULL) { + .Call(`_RcppTskit_rtsk_edge_table_add_row`, tc, left, right, parent, child, metadata) +} + test_tsk_bug_assert_c <- function() { invisible(.Call(`_RcppTskit_test_tsk_bug_assert_c`)) } diff --git a/RcppTskit/inst/include/RcppTskit_public.hpp b/RcppTskit/inst/include/RcppTskit_public.hpp index 6d62e09..4ae29cd 100644 --- a/RcppTskit/inst/include/RcppTskit_public.hpp +++ b/RcppTskit/inst/include/RcppTskit_public.hpp @@ -62,5 +62,11 @@ int rtsk_individual_table_add_row( Rcpp::Nullable location = R_NilValue, Rcpp::Nullable parents = R_NilValue, Rcpp::Nullable metadata = R_NilValue); +int rtsk_node_table_add_row( + SEXP tc, int flags = 0, double time = 0, int population = -1, + int individual = -1, Rcpp::Nullable metadata = R_NilValue); +int rtsk_edge_table_add_row( + SEXP tc, double left, double right, int parent, int child, + Rcpp::Nullable metadata = R_NilValue); #endif diff --git a/RcppTskit/man/TableCollection.Rd b/RcppTskit/man/TableCollection.Rd index 9666d08..9086a90 100644 --- a/RcppTskit/man/TableCollection.Rd +++ b/RcppTskit/man/TableCollection.Rd @@ -96,6 +96,21 @@ tc_file <- system.file("examples/test.trees", package = "RcppTskit") tc <- tc_load(tc_file) tc$num_nodes() +## ------------------------------------------------ +## Method `TableCollection$node_table_add_row` +## ------------------------------------------------ + +ts_file <- system.file("examples/test.trees", package = "RcppTskit") +tc <- tc_load(ts_file) +n_before <- tc$num_nodes() +new_id <- tc$node_table_add_row() +new_id <- tc$node_table_add_row(time = 2.5) +new_id <- tc$node_table_add_row(flags = 1L, time = 3.5, population = 0L) +new_id <- tc$node_table_add_row(flags = 1L, time = 4.5, individual = 0L) +new_id <- tc$node_table_add_row(metadata = "abc") +new_id <- tc$node_table_add_row(metadata = charToRaw("cba")) +n_after <- tc$num_nodes() + ## ------------------------------------------------ ## Method `TableCollection$num_edges` ## ------------------------------------------------ @@ -104,6 +119,26 @@ tc_file <- system.file("examples/test.trees", package = "RcppTskit") tc <- tc_load(tc_file) tc$num_edges() +## ------------------------------------------------ +## Method `TableCollection$edge_table_add_row` +## ------------------------------------------------ + +ts_file <- system.file("examples/test.trees", package = "RcppTskit") +tc <- tc_load(ts_file) +parent <- 0L +child <- 1L +n_before <- tc$num_edges() +new_id <- tc$edge_table_add_row( + left = 0, right = 1, parent = parent, child = child +) +new_id <- tc$edge_table_add_row( + left = 1, right = 2, parent = parent, child = child, metadata = "abc" +) +new_id <- tc$edge_table_add_row( + left = 2, right = 3, parent = parent, child = child, metadata = charToRaw("cba") +) +n_after <- tc$num_edges() + ## ------------------------------------------------ ## Method `TableCollection$num_sites` ## ------------------------------------------------ @@ -241,7 +276,9 @@ tc \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-node_table_add_row}{\code{TableCollection$node_table_add_row()}} \item \href{#method-TableCollection-num_edges}{\code{TableCollection$num_edges()}} +\item \href{#method-TableCollection-edge_table_add_row}{\code{TableCollection$edge_table_add_row()}} \item \href{#method-TableCollection-num_sites}{\code{TableCollection$num_sites()}} \item \href{#method-TableCollection-num_mutations}{\code{TableCollection$num_mutations()}} \item \href{#method-TableCollection-sequence_length}{\code{TableCollection$sequence_length()}} @@ -559,6 +596,66 @@ tc$num_nodes() } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TableCollection-node_table_add_row}{}}} +\subsection{Method \code{node_table_add_row()}}{ +Add a row to the nodes table. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TableCollection$node_table_add_row( + flags = 0L, + time = 0, + population = -1L, + individual = -1L, + metadata = NULL +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{flags}}{integer flags for the new node.} + +\item{\code{time}}{numeric time value for the new node.} + +\item{\code{population}}{integer population row ID (0-based, or \code{-1}); +\code{NULL} maps to \code{-1}.} + +\item{\code{individual}}{integer individual row ID (0-based, or \code{-1}); +\code{NULL} maps to \code{-1}.} + +\item{\code{metadata}}{for the new node; 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.NodeTable.add_row}. + The function casts inputs to the expected class. +} + +\subsection{Returns}{ +Integer row ID (0-based) of the newly added node. +} +\subsection{Examples}{ +\if{html}{\out{
}} +\preformatted{ts_file <- system.file("examples/test.trees", package = "RcppTskit") +tc <- tc_load(ts_file) +n_before <- tc$num_nodes() +new_id <- tc$node_table_add_row() +new_id <- tc$node_table_add_row(time = 2.5) +new_id <- tc$node_table_add_row(flags = 1L, time = 3.5, population = 0L) +new_id <- tc$node_table_add_row(flags = 1L, time = 4.5, individual = 0L) +new_id <- tc$node_table_add_row(metadata = "abc") +new_id <- tc$node_table_add_row(metadata = charToRaw("cba")) +n_after <- tc$num_nodes() +} +\if{html}{\out{
}} + +} + } \if{html}{\out{
}} \if{html}{\out{}} @@ -582,6 +679,63 @@ tc$num_edges() } +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-TableCollection-edge_table_add_row}{}}} +\subsection{Method \code{edge_table_add_row()}}{ +Add a row to the edges table. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{TableCollection$edge_table_add_row(left, right, parent, child, metadata = NULL)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{left}}{numeric scalar left coordinate for the new edge.} + +\item{\code{right}}{numeric scalar right coordinate for the new edge.} + +\item{\code{parent}}{integer scalar parent node row ID (0-based).} + +\item{\code{child}}{integer scalar child node row ID (0-based).} + +\item{\code{metadata}}{for the new edge; 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.EdgeTable.add_row}. + The function casts inputs to the expected class. +} + +\subsection{Returns}{ +Integer row ID (0-based) of the newly added edge. +} +\subsection{Examples}{ +\if{html}{\out{
}} +\preformatted{ts_file <- system.file("examples/test.trees", package = "RcppTskit") +tc <- tc_load(ts_file) +parent <- 0L +child <- 1L +n_before <- tc$num_edges() +new_id <- tc$edge_table_add_row( + left = 0, right = 1, parent = parent, child = child +) +new_id <- tc$edge_table_add_row( + left = 1, right = 2, parent = parent, child = child, metadata = "abc" +) +new_id <- tc$edge_table_add_row( + left = 2, right = 3, parent = parent, child = child, metadata = charToRaw("cba") +) +n_after <- tc$num_edges() +} +\if{html}{\out{
}} + +} + } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/RcppTskit/src/RcppExports.cpp b/RcppTskit/src/RcppExports.cpp index ccea595..2e457ad 100644 --- a/RcppTskit/src/RcppExports.cpp +++ b/RcppTskit/src/RcppExports.cpp @@ -549,6 +549,38 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// rtsk_node_table_add_row +int rtsk_node_table_add_row(const SEXP tc, const int flags, const double time, const int population, const int individual, const Rcpp::Nullable metadata); +RcppExport SEXP _RcppTskit_rtsk_node_table_add_row(SEXP tcSEXP, SEXP flagsSEXP, SEXP timeSEXP, SEXP populationSEXP, SEXP individualSEXP, 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 double >::type time(timeSEXP); + Rcpp::traits::input_parameter< const int >::type population(populationSEXP); + Rcpp::traits::input_parameter< const int >::type individual(individualSEXP); + Rcpp::traits::input_parameter< const Rcpp::Nullable >::type metadata(metadataSEXP); + rcpp_result_gen = Rcpp::wrap(rtsk_node_table_add_row(tc, flags, time, population, individual, metadata)); + return rcpp_result_gen; +END_RCPP +} +// rtsk_edge_table_add_row +int rtsk_edge_table_add_row(const SEXP tc, const double left, const double right, const int parent, const int child, const Rcpp::Nullable metadata); +RcppExport SEXP _RcppTskit_rtsk_edge_table_add_row(SEXP tcSEXP, SEXP leftSEXP, SEXP rightSEXP, SEXP parentSEXP, SEXP childSEXP, 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 double >::type left(leftSEXP); + Rcpp::traits::input_parameter< const double >::type right(rightSEXP); + Rcpp::traits::input_parameter< const int >::type parent(parentSEXP); + Rcpp::traits::input_parameter< const int >::type child(childSEXP); + Rcpp::traits::input_parameter< const Rcpp::Nullable >::type metadata(metadataSEXP); + rcpp_result_gen = Rcpp::wrap(rtsk_edge_table_add_row(tc, left, right, parent, child, 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() { @@ -687,6 +719,8 @@ static const R_CallMethodDef CallEntries[] = { {"_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_rtsk_node_table_add_row", (DL_FUNC) &_RcppTskit_rtsk_node_table_add_row, 6}, + {"_RcppTskit_rtsk_edge_table_add_row", (DL_FUNC) &_RcppTskit_rtsk_edge_table_add_row, 6}, {"_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}, diff --git a/RcppTskit/src/RcppTskit.cpp b/RcppTskit/src/RcppTskit.cpp index 392785b..e38e676 100644 --- a/RcppTskit/src/RcppTskit.cpp +++ b/RcppTskit/src/RcppTskit.cpp @@ -4,6 +4,7 @@ // they are synced! #define RCPPTSKIT_IMPL #include +#include #include #include #include @@ -1332,3 +1333,166 @@ int rtsk_individual_table_add_row( } return static_cast(row_id); } + +// PUBLIC, wrapper for tsk_node_table_add_row +// @title Add a row to the node 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 time numeric time value for the new node. +// @param population integer population row ID (0-based, or \code{-1}). +// @param individual integer individual row ID (0-based, or \code{-1}). +// @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_node_table_add_row} +// on the nodes table of \code{tc}. +// @return The 0-based row ID of the newly added node. +// @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_nodes(tc_xptr) +// tc_py <- RcppTskit:::rtsk_table_collection_r_to_py(tc_xptr) +// tc_py$nodes$max_rows +// tc_py$nodes["flags"] +// tc_py$nodes["time"] +// tc_py$nodes["population"] +// tc_py$nodes["individual"] +// tc_py$nodes["metadata"] +// tc_py$nodes["metadata_offset"] +// new_id <- RcppTskit:::rtsk_node_table_add_row(tc = tc_xptr) +// new_id <- RcppTskit:::rtsk_node_table_add_row(tc = tc_xptr, time = 1.5) +// new_id <- RcppTskit:::rtsk_node_table_add_row( +// tc = tc_xptr, flags = 1L, time = 2.25, population = 0L +// ) +// new_id <- RcppTskit:::rtsk_node_table_add_row( +// tc = tc_xptr, flags = 1L, time = 3.5, individual = 0L, +// metadata = charToRaw("abc") +// ) +// n_after <- RcppTskit:::rtsk_table_collection_get_num_nodes(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$nodes$max_rows +// tc_py$nodes["flags"] +// tc_py$nodes["time"] +// tc_py$nodes["population"] +// tc_py$nodes["individual"] +// tc_py$nodes["metadata"] +// tc_py$nodes["metadata_offset"] +// [[Rcpp::export]] +int rtsk_node_table_add_row( + const SEXP tc, const int flags = 0, const double time = 0, + const int population = -1, const int individual = -1, + const Rcpp::Nullable metadata = R_NilValue) { + if (flags < 0) { + Rcpp::stop("rtsk_node_table_add_row does not support negative flags"); + } + if (Rcpp::IntegerVector::is_na(population)) { + Rcpp::stop("population must not be NA_integer_ in rtsk_node_table_add_row"); + } + if (Rcpp::IntegerVector::is_na(individual)) { + Rcpp::stop("individual must not be NA_integer_ in rtsk_node_table_add_row"); + } + const tsk_flags_t row_flags = static_cast(flags); + const tsk_id_t row_population = static_cast(population); + const tsk_id_t row_individual = static_cast(individual); + rtsk_table_collection_t tc_xptr(tc); + + 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_node_table_add_row(&tc_xptr->nodes, row_flags, time, row_population, + row_individual, metadata_ptr, metadata_length); + if (row_id < 0) { + Rcpp::stop(tsk_strerror(row_id)); + } + return static_cast(row_id); +} + +// PUBLIC, wrapper for tsk_edge_table_add_row +// @title Add a row to the edge table in a table collection +// @param tc an external pointer to table collection as a +// \code{tsk_table_collection_t} object. +// @param left numeric scalar left coordinate for the new edge. +// @param right numeric scalar right coordinate for the new edge. +// @param parent integer parent node row ID (0-based). +// @param child integer child node row ID (0-based). +// @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_edge_table_add_row} +// on the edges table of \code{tc}. +// @return The 0-based row ID of the newly added edge. +// @examples +// ts_file <- system.file("examples/test.trees", package = "RcppTskit") +// tc_xptr <- RcppTskit:::rtsk_table_collection_load(ts_file) +// parent <- 0L +// child <- 1L +// n_before <- RcppTskit:::rtsk_table_collection_get_num_edges(tc_xptr) +// m_before <- +// RcppTskit:::rtsk_table_collection_metadata_length(tc_xptr)[["edges"]] new_id +// <- RcppTskit:::rtsk_edge_table_add_row( +// tc = tc_xptr, left = 0, right = 1, parent = parent, child = child +// ) +// new_id <- RcppTskit:::rtsk_edge_table_add_row( +// tc = tc_xptr, left = 1, right = 2, parent = parent, child = child, +// metadata = charToRaw("abc") +// ) +// n_after <- RcppTskit:::rtsk_table_collection_get_num_edges(tc_xptr) +// m_after <- +// RcppTskit:::rtsk_table_collection_metadata_length(tc_xptr)[["edges"]] new_id +// == as.integer(n_before) && n_after == n_before + 2L && m_after == m_before + +// 3L +// [[Rcpp::export]] +int rtsk_edge_table_add_row( + const SEXP tc, const double left, const double right, const int parent, + const int child, + const Rcpp::Nullable metadata = R_NilValue) { + if (Rcpp::NumericVector::is_na(left)) { + Rcpp::stop("left must not be NA_real_ in rtsk_edge_table_add_row"); + } + if (Rcpp::NumericVector::is_na(right)) { + Rcpp::stop("right must not be NA_real_ in rtsk_edge_table_add_row"); + } + if (!std::isfinite(left)) { + Rcpp::stop("left must be finite in rtsk_edge_table_add_row"); + } + if (!std::isfinite(right)) { + Rcpp::stop("right must be finite in rtsk_edge_table_add_row"); + } + if (!(left < right)) { + Rcpp::stop( + "left must be strictly less than right in rtsk_edge_table_add_row"); + } + if (Rcpp::IntegerVector::is_na(parent)) { + Rcpp::stop("parent must not be NA_integer_ in rtsk_edge_table_add_row"); + } + if (Rcpp::IntegerVector::is_na(child)) { + Rcpp::stop("child must not be NA_integer_ in rtsk_edge_table_add_row"); + } + const tsk_id_t row_parent = static_cast(parent); + const tsk_id_t row_child = static_cast(child); + rtsk_table_collection_t tc_xptr(tc); + + 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_edge_table_add_row(&tc_xptr->edges, left, right, row_parent, + row_child, metadata_ptr, metadata_length); + if (row_id < 0) { + Rcpp::stop(tsk_strerror(row_id)); + } + return static_cast(row_id); +} diff --git a/RcppTskit/tests/testthat/test_TableCollection.R b/RcppTskit/tests/testthat/test_TableCollection.R index 9199610..3136eca 100644 --- a/RcppTskit/tests/testthat/test_TableCollection.R +++ b/RcppTskit/tests/testthat/test_TableCollection.R @@ -413,3 +413,418 @@ test_that("individual_table_add_row wrapper expands the table collection and han regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" ) }) + +test_that("node_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_nodes(tc_xptr) + m_before <- rtsk_table_collection_metadata_length(tc_xptr)[["nodes"]] + + expect_error( + rtsk_node_table_add_row(tc_xptr, flags = -1L), + regexp = "rtsk_node_table_add_row does not support negative flags" + ) + + new_id <- rtsk_node_table_add_row( + tc = tc_xptr, + flags = 1L, + time = 1.25, + population = 0L, + individual = 0L, + 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_nodes(tc_xptr)), + as.integer(n_before) + 1L + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["nodes"]]), + as.integer(m_before) + 3L + ) + + tc <- TableCollection$new(xptr = tc_xptr) + n_before_method <- tc$num_nodes() + new_id_method <- tc$node_table_add_row() + expect_equal(new_id_method, as.integer(n_before_method)) + expect_equal( + as.integer(tc$num_nodes()), + as.integer(n_before_method) + 1L + ) + + tc_xptr <- rtsk_table_collection_load(ts_file) + + n0 <- as.integer(rtsk_table_collection_get_num_nodes(tc_xptr)) + m0 <- as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["nodes"]]) + + # Defaults map to NULL in the generated R wrapper and should be accepted. + id0 <- rtsk_node_table_add_row(tc_xptr) + expect_equal(id0, n0) + expect_equal( + as.integer(rtsk_table_collection_get_num_nodes(tc_xptr)), + n0 + 1L + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["nodes"]]), + m0 + ) + + # Explicit NULL metadata should also be accepted. + id1 <- rtsk_node_table_add_row( + tc = tc_xptr, + flags = 0L, + time = 2.5, + population = -1L, + individual = -1L, + metadata = NULL + ) + expect_equal(id1, n0 + 1L) + + expect_error( + rtsk_node_table_add_row( + tc = tc_xptr, + flags = 0L, + population = NA_integer_ + ), + regexp = "population must not be NA_integer_ in rtsk_node_table_add_row" + ) + expect_error( + rtsk_node_table_add_row( + tc = tc_xptr, + flags = 0L, + individual = NA_integer_ + ), + regexp = "individual must not be NA_integer_ in rtsk_node_table_add_row" + ) + + tc <- TableCollection$new(xptr = tc_xptr) + n_before_method <- as.integer(tc$num_nodes()) + expect_no_error( + tc$node_table_add_row( + flags = 1L, + time = 3.5, + population = 0L, + individual = -1L, + metadata = NULL + ) + ) + expect_equal(as.integer(tc$num_nodes()), n_before_method + 1L) + expect_no_error(tc$node_table_add_row(population = NULL, individual = NULL)) + expect_equal(as.integer(tc$num_nodes()), n_before_method + 2L) + + m_before_char <- as.integer(rtsk_table_collection_metadata_length(tc$xptr)[[ + "nodes" + ]]) + expect_no_warning(tc$node_table_add_row(metadata = "abc")) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc$xptr)[["nodes"]]), + m_before_char + 3L + ) + m_before_raw <- as.integer(rtsk_table_collection_metadata_length(tc$xptr)[[ + "nodes" + ]]) + expect_no_error(tc$node_table_add_row(metadata = charToRaw("xyz"))) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc$xptr)[["nodes"]]), + m_before_raw + 3L + ) + expect_error( + tc$node_table_add_row(population = NA_integer_), + regexp = "population must not be NA_integer_ in rtsk_node_table_add_row" + ) + expect_error( + tc$node_table_add_row(individual = NA_integer_), + regexp = "individual must not be NA_integer_ in rtsk_node_table_add_row" + ) + expect_error( + tc$node_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$node_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$node_table_add_row(metadata = 1L), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) +}) + +test_that("edge_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) + expect_gt(as.integer(rtsk_table_collection_get_num_nodes(tc_xptr)), 1L) + parent <- 0L + child <- 1L + + n_before <- rtsk_table_collection_get_num_edges(tc_xptr) + m_before <- rtsk_table_collection_metadata_length(tc_xptr)[["edges"]] + + new_id <- rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = 1, + parent = parent, + child = child, + 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_edges(tc_xptr)), + as.integer(n_before) + 1L + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["edges"]]), + as.integer(m_before) + 3L + ) + + tc <- TableCollection$new(xptr = tc_xptr) + n_before_method <- tc$num_edges() + new_id_method <- tc$edge_table_add_row( + left = 1, + right = 2, + parent = parent, + child = child + ) + expect_equal(new_id_method, as.integer(n_before_method)) + expect_equal( + as.integer(tc$num_edges()), + as.integer(n_before_method) + 1L + ) + + tc_xptr <- rtsk_table_collection_load(ts_file) + parent <- 0L + child <- 1L + + n0 <- as.integer(rtsk_table_collection_get_num_edges(tc_xptr)) + m0 <- as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["edges"]]) + + # Explicit NULL metadata should be accepted. + id0 <- rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = 1, + parent = parent, + child = child, + metadata = NULL + ) + expect_equal(id0, n0) + expect_equal( + as.integer(rtsk_table_collection_get_num_edges(tc_xptr)), + n0 + 1L + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc_xptr)[["edges"]]), + m0 + ) + + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = NA_real_, + right = 1, + parent = parent, + child = child + ), + regexp = "left must not be NA_real_ in rtsk_edge_table_add_row" + ) + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = NA_real_, + parent = parent, + child = child + ), + regexp = "right must not be NA_real_ in rtsk_edge_table_add_row" + ) + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = Inf, + right = 1, + parent = parent, + child = child + ), + regexp = "left must be finite in rtsk_edge_table_add_row" + ) + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = 0, + parent = parent, + child = child + ), + regexp = "left must be strictly less than right in rtsk_edge_table_add_row" + ) + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = 1, + parent = NA_integer_, + child = child + ), + regexp = "parent must not be NA_integer_ in rtsk_edge_table_add_row" + ) + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = 1, + parent = parent, + child = NA_integer_ + ), + regexp = "child must not be NA_integer_ in rtsk_edge_table_add_row" + ) + + tc <- TableCollection$new(xptr = tc_xptr) + n_before_method <- as.integer(tc$num_edges()) + expect_no_error( + tc$edge_table_add_row( + left = 2, + right = 3, + parent = parent, + child = child, + metadata = NULL + ) + ) + expect_equal(as.integer(tc$num_edges()), n_before_method + 1L) + + m_before_char <- as.integer(rtsk_table_collection_metadata_length(tc$xptr)[[ + "edges" + ]]) + expect_no_warning( + tc$edge_table_add_row( + left = 3, + right = 4, + parent = parent, + child = child, + metadata = "abc" + ) + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc$xptr)[["edges"]]), + m_before_char + 3L + ) + m_before_raw <- as.integer(rtsk_table_collection_metadata_length(tc$xptr)[[ + "edges" + ]]) + expect_no_error( + tc$edge_table_add_row( + left = 4, + right = 5, + parent = parent, + child = child, + metadata = charToRaw("xyz") + ) + ) + expect_equal( + as.integer(rtsk_table_collection_metadata_length(tc$xptr)[["edges"]]), + m_before_raw + 3L + ) + expect_error( + tc$edge_table_add_row( + left = NULL, + right = 6, + parent = parent, + child = child + ), + regexp = "left must be a non-NA finite numeric scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = c(5, 6), + right = 6, + parent = parent, + child = child + ), + regexp = "left must be a non-NA finite numeric scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = NULL, + parent = parent, + child = child + ), + regexp = "right must be a non-NA finite numeric scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = 6, + parent = parent, + child = child + ), + regexp = "left must be strictly less than right!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = 7, + parent = NULL, + child = child + ), + regexp = "parent must be a non-NA integer scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = 7, + parent = parent, + child = NULL + ), + regexp = "child must be a non-NA integer scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = 5, + right = 6, + parent = NA_integer_, + child = child + ), + regexp = "parent must be a non-NA integer scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = 5, + right = 6, + parent = parent, + child = NA_integer_ + ), + regexp = "child must be a non-NA integer scalar!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = 7, + parent = parent, + child = child, + metadata = c("a", "b") + ), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = 7, + parent = parent, + child = child, + metadata = NA_character_ + ), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) + expect_error( + tc$edge_table_add_row( + left = 6, + right = 7, + parent = parent, + child = child, + metadata = 1L + ), + regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" + ) +}) From 7b33b49067f797aee8ae2071f1bb68acde4e26e4 Mon Sep 17 00:00:00 2001 From: LynxJinyangii Date: Mon, 16 Mar 2026 11:10:20 +0000 Subject: [PATCH 2/3] Add .gitignore to exclude IDE files --- RcppTskit/.gitignore | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 RcppTskit/.gitignore diff --git a/RcppTskit/.gitignore b/RcppTskit/.gitignore new file mode 100644 index 0000000..3ada9ff --- /dev/null +++ b/RcppTskit/.gitignore @@ -0,0 +1,2 @@ +.idea/ +src/.idea/ From d577744643d819454e2abcefdca1c8617ded137b Mon Sep 17 00:00:00 2001 From: LynxJinyangii Date: Thu, 19 Mar 2026 12:03:37 +0000 Subject: [PATCH 3/3] Address review comments --- RcppTskit/NEWS.md | 5 -- RcppTskit/R/Class-TableCollection.R | 9 ++- RcppTskit/R/RcppExports.R | 8 +++ RcppTskit/man/TableCollection.Rd | 9 ++- RcppTskit/src/RcppExports.cpp | 22 +++++++ RcppTskit/src/tests.cpp | 57 +++++++++++++++++++ .../tests/testthat/test_TableCollection.R | 18 ++++++ 7 files changed, 119 insertions(+), 9 deletions(-) diff --git a/RcppTskit/NEWS.md b/RcppTskit/NEWS.md index ad3672a..8a62977 100644 --- a/RcppTskit/NEWS.md +++ b/RcppTskit/NEWS.md @@ -35,11 +35,6 @@ and releases adhere to [Semantic Versioning](https://semver.org/spec/v2.0.0.html to append node rows from \code{R}, mirroring `tsk_node_table_add_row()`. - Added `rtsk_edge_table_add_row()` and `TableCollection$edge_table_add_row()` to append edge rows from \code{R}, mirroring `tsk_edge_table_add_row()`. -- `TableCollection$node_table_add_row()` now maps `population = NULL` and - `individual = NULL` to `-1` (`TSK_NULL`) for R-level convenience. -- `rtsk_edge_table_add_row()` and `TableCollection$edge_table_add_row()` now - validate `left`/`right` more explicitly (non-`NA`, finite, and `left < right`) - and require scalar `parent`/`child` IDs. - TODO ### Changed diff --git a/RcppTskit/R/Class-TableCollection.R b/RcppTskit/R/Class-TableCollection.R index 16fadd4..80dd49e 100644 --- a/RcppTskit/R/Class-TableCollection.R +++ b/RcppTskit/R/Class-TableCollection.R @@ -213,7 +213,9 @@ TableCollection <- R6Class( #' 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.NodeTable.add_row}. - #' The function casts inputs to the expected class. + #' The function casts inputs to the expected class. For convenience, + #' \code{population = NULL} and \code{individual = NULL} are mapped to + #' \code{-1} (\code{TSK_NULL}). #' @return Integer row ID (0-based) of the newly added node. #' @examples #' ts_file <- system.file("examples/test.trees", package = "RcppTskit") @@ -275,7 +277,10 @@ TableCollection <- R6Class( #' 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.EdgeTable.add_row}. - #' The function casts inputs to the expected class. + #' The function casts inputs to the expected class. Inputs are validated: + #' \code{left} and \code{right} must be finite numeric scalars with + #' \code{left < right}, and \code{parent} and \code{child} must be + #' non-\code{NA} integer scalars. #' @return Integer row ID (0-based) of the newly added edge. #' @examples #' ts_file <- system.file("examples/test.trees", package = "RcppTskit") diff --git a/RcppTskit/R/RcppExports.R b/RcppTskit/R/RcppExports.R index 026b403..aa3e2d1 100644 --- a/RcppTskit/R/RcppExports.R +++ b/RcppTskit/R/RcppExports.R @@ -251,3 +251,11 @@ test_rtsk_individual_table_add_row_forced_error <- function(tc) { invisible(.Call(`_RcppTskit_test_rtsk_individual_table_add_row_forced_error`, tc)) } +test_rtsk_node_table_add_row_forced_error <- function(tc) { + invisible(.Call(`_RcppTskit_test_rtsk_node_table_add_row_forced_error`, tc)) +} + +test_rtsk_edge_table_add_row_forced_error <- function(tc) { + invisible(.Call(`_RcppTskit_test_rtsk_edge_table_add_row_forced_error`, tc)) +} + diff --git a/RcppTskit/man/TableCollection.Rd b/RcppTskit/man/TableCollection.Rd index 9086a90..513f731 100644 --- a/RcppTskit/man/TableCollection.Rd +++ b/RcppTskit/man/TableCollection.Rd @@ -633,7 +633,9 @@ a raw vector, or a character of length 1.} \subsection{Details}{ See the \code{tskit Python} equivalent at \url{https://tskit.dev/tskit/docs/stable/python-api.html#tskit.NodeTable.add_row}. - The function casts inputs to the expected class. + The function casts inputs to the expected class. For convenience, + \code{population = NULL} and \code{individual = NULL} are mapped to + \code{-1} (\code{TSK_NULL}). } \subsection{Returns}{ @@ -708,7 +710,10 @@ a raw vector, or a character of length 1.} \subsection{Details}{ See the \code{tskit Python} equivalent at \url{https://tskit.dev/tskit/docs/stable/python-api.html#tskit.EdgeTable.add_row}. - The function casts inputs to the expected class. + The function casts inputs to the expected class. Inputs are validated: + \code{left} and \code{right} must be finite numeric scalars with + \code{left < right}, and \code{parent} and \code{child} must be + non-\code{NA} integer scalars. } \subsection{Returns}{ diff --git a/RcppTskit/src/RcppExports.cpp b/RcppTskit/src/RcppExports.cpp index 2e457ad..185d8bb 100644 --- a/RcppTskit/src/RcppExports.cpp +++ b/RcppTskit/src/RcppExports.cpp @@ -669,6 +669,26 @@ BEGIN_RCPP return R_NilValue; END_RCPP } +// test_rtsk_node_table_add_row_forced_error +void test_rtsk_node_table_add_row_forced_error(const SEXP tc); +RcppExport SEXP _RcppTskit_test_rtsk_node_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_node_table_add_row_forced_error(tc); + return R_NilValue; +END_RCPP +} +// test_rtsk_edge_table_add_row_forced_error +void test_rtsk_edge_table_add_row_forced_error(const SEXP tc); +RcppExport SEXP _RcppTskit_test_rtsk_edge_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_edge_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}, @@ -730,6 +750,8 @@ static const R_CallMethodDef CallEntries[] = { {"_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}, + {"_RcppTskit_test_rtsk_node_table_add_row_forced_error", (DL_FUNC) &_RcppTskit_test_rtsk_node_table_add_row_forced_error, 1}, + {"_RcppTskit_test_rtsk_edge_table_add_row_forced_error", (DL_FUNC) &_RcppTskit_test_rtsk_edge_table_add_row_forced_error, 1}, {NULL, NULL, 0} }; diff --git a/RcppTskit/src/tests.cpp b/RcppTskit/src/tests.cpp index 97ce2bf..eb13a02 100644 --- a/RcppTskit/src/tests.cpp +++ b/RcppTskit/src/tests.cpp @@ -149,3 +149,60 @@ void test_rtsk_individual_table_add_row_forced_error(const SEXP tc) { throw; } } + +// TEST-ONLY +// @title Force tskit-level error path in \code{rtsk_node_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_node_table_add_row_forced_error(const SEXP tc) { + rtsk_table_collection_t tc_xptr(tc); + tsk_node_table_t &nodes = tc_xptr->nodes; + tsk_size_t saved_max_rows = nodes.max_rows; + tsk_size_t saved_max_rows_increment = nodes.max_rows_increment; + nodes.max_rows = 1; + nodes.max_rows_increment = static_cast(TSK_MAX_ID) + 1; + try { + (void)rtsk_node_table_add_row(tc); + // Lines below not hit by tests because rtsk_node_table_add_row() + // throws error # nocov start + nodes.max_rows = saved_max_rows; + nodes.max_rows_increment = saved_max_rows_increment; + return; + // # nocov end + } catch (...) { + nodes.max_rows = saved_max_rows; + nodes.max_rows_increment = saved_max_rows_increment; + throw; + } +} + +// TEST-ONLY +// @title Force tskit-level error path in \code{rtsk_edge_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_edge_table_add_row_forced_error(const SEXP tc) { + rtsk_table_collection_t tc_xptr(tc); + tsk_edge_table_t &edges = tc_xptr->edges; + tsk_size_t saved_max_rows = edges.max_rows; + tsk_size_t saved_max_rows_increment = edges.max_rows_increment; + edges.max_rows = 1; + edges.max_rows_increment = static_cast(TSK_MAX_ID) + 1; + try { + (void)rtsk_edge_table_add_row(tc, 0, 1, static_cast(edges.parent[0]), + static_cast(edges.child[0]), R_NilValue); + // Lines below not hit by tests because rtsk_edge_table_add_row() + // throws error # nocov start + edges.max_rows = saved_max_rows; + edges.max_rows_increment = saved_max_rows_increment; + return; + // # nocov end + } catch (...) { + edges.max_rows = saved_max_rows; + edges.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 3136eca..f31751a 100644 --- a/RcppTskit/tests/testthat/test_TableCollection.R +++ b/RcppTskit/tests/testthat/test_TableCollection.R @@ -549,6 +549,10 @@ test_that("node_table_add_row wrapper expands the table collection and handles i tc$node_table_add_row(metadata = 1L), regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" ) + expect_error( + test_rtsk_node_table_add_row_forced_error(tc$xptr), + regexp = "TSK_ERR_TABLE_OVERFLOW" + ) }) test_that("edge_table_add_row wrapper expands the table collection and handles inputs", { @@ -649,6 +653,16 @@ test_that("edge_table_add_row wrapper expands the table collection and handles i ), regexp = "left must be finite in rtsk_edge_table_add_row" ) + expect_error( + rtsk_edge_table_add_row( + tc = tc_xptr, + left = 0, + right = Inf, + parent = parent, + child = child + ), + regexp = "right must be finite in rtsk_edge_table_add_row" + ) expect_error( rtsk_edge_table_add_row( tc = tc_xptr, @@ -827,4 +841,8 @@ test_that("edge_table_add_row wrapper expands the table collection and handles i ), regexp = "metadata must be NULL, a raw vector, or a length-1 non-NA character string!" ) + expect_error( + test_rtsk_edge_table_add_row_forced_error(tc$xptr), + regexp = "TSK_ERR_TABLE_OVERFLOW" + ) })