Importing and linking against RcppTskit

gregorgorjanc · gregorgorjanc · commit 523bd7e07528 · 2026-05-04T21:03:05.000+01:00
diff --git a/.gitignore b/.gitignore
@@ -26,5 +26,7 @@ src/*.gcno
 src/**/*.gcno
 src/*.o
 src/*.so
+src/Makevars
+src/Makevars.win
 vignettes/*.html
 vignettes/*.pdf
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -40,9 +40,10 @@ URL: https://github.com/gaynorr/AlphaSimR,
     https://www.edx.org/learn/animal-breeding/the-university-of-edinburgh-breeding-programme-modelling-with-alphasimr
 Encoding: UTF-8
 Depends: R (>= 4.0.0)
-Imports: Rcpp (>= 0.12.7), Rdpack, methods, R6
+Imports: Rcpp (>= 0.12.7), Rdpack, methods, R6, RcppTskit (>= 0.3.0)
 RdMacros: Rdpack
-LinkingTo: Rcpp, RcppArmadillo (>= 0.7.500.0.0), BH, dqrng (>= 0.4.1)
+LinkingTo: Rcpp, RcppArmadillo (>= 0.7.500.0.0), BH, dqrng (>= 0.4.1), RcppTskit
+RoxygenNote: 7.3.3
 Suggests: knitr, rmarkdown, testthat
 VignetteBuilder: knitr
 NeedsCompilation: true
diff --git a/NAMESPACE b/NAMESPACE
@@ -85,6 +85,8 @@ export(randCross)
 export(randCross2)
 export(reduceGenome)
 export(resetPop)
+export(rtsk_table_collection_summary2)
+export(rtsk_treeseq_get_num_individuals2)
 export(runMacs)
 export(runMacs2)
 export(sampleHaplo)
@@ -141,6 +143,7 @@ exportClasses(TraitAE)
 exportClasses(TraitAEG)
 exportClasses(TraitAG)
 import(Rcpp)
+import(RcppTskit)
 importFrom(R6,R6Class)
 importFrom(Rdpack,reprompt)
 importFrom(methods,.hasSlot)
diff --git a/R/AlphaSimR.R b/R/AlphaSimR.R
@@ -2,6 +2,7 @@
 
 #' @useDynLib AlphaSimR, .registration = TRUE
 #' @import Rcpp
+#' @import RcppTskit
 #' @importFrom methods new validObject is .hasSlot slot
 #' @importFrom methods show classLabel
 #' @importFrom stats aggregate var cov2cor lm coef model.matrix
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -399,3 +399,30 @@ MaCS <- function(args, maxSites, inbred, ploidy, nThreads, seed) {
     .Call(`_AlphaSimR_MaCS`, args, maxSites, inbred, ploidy, nThreads, seed)
 }
 
+#' @title Summarise `tskit` table collection
+#' @param tc an external pointer to a \code{tsk_table_collection_t} object.
+#' @return A list.
+#' @examples
+#' ts_file <- system.file("examples", "test.trees", package = "RcppTskit")
+#' tc <- RcppTskit:::tc_load(ts_file)
+#' RcppTskit:::rtsk_table_collection_summary(tc$xptr)
+#' rtsk_table_collection_summary2(tc$xptr)
+#' @export
+rtsk_table_collection_summary2 <- function(tc) {
+    .Call(`_AlphaSimR_rtsk_table_collection_summary2`, tc)
+}
+
+#' @title Get number of individuals in tree sequence
+#' @param ts an external pointer to a \code{tsk_treeseq_t} object.
+#' @return integer number of individuals.
+#' @examples
+#' ts_file <- system.file("examples", "test.trees", package = "RcppTskit")
+#' ts <- RcppTskit::ts_load(ts_file)
+#' ts$num_individuals()
+#' RcppTskit:::rtsk_treeseq_get_num_individuals(ts$xptr)
+#' rtsk_treeseq_get_num_individuals2(ts$xptr)
+#' @export
+rtsk_treeseq_get_num_individuals2 <- function(ts) {
+    .Call(`_AlphaSimR_rtsk_treeseq_get_num_individuals2`, ts)
+}
+
diff --git a/cleanup b/cleanup
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+# Removing Makevars autogenerated via configure from src/Makevars.in
+rm -f src/Makevars
+
+# Removing compilation files
+rm -f src/*.o src/*.so
diff --git a/cleanup.win b/cleanup.win
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+# Removing Makevars autogenerated via configure from src/Makevars.win.in
+rm -f src/Makevars.win
+
+# Removing compilation files
+rm -f src/*.dll
+# TODO: Add other files to be removed here on Windows platform
diff --git a/configure b/configure
@@ -0,0 +1,2 @@
+#!/bin/sh
+"${R_HOME}/bin/Rscript" tools/configure.R
diff --git a/configure.win b/configure.win
@@ -0,0 +1,2 @@
+#!/bin/sh
+"${R_HOME}/bin${R_ARCH_BIN}/Rscript" tools/configure.R
diff --git a/man/rtsk_table_collection_summary2.Rd b/man/rtsk_table_collection_summary2.Rd
diff --git a/man/rtsk_treeseq_get_num_individuals2.Rd b/man/rtsk_treeseq_get_num_individuals2.Rd
diff --git a/src/Makevars.in b/src/Makevars.in
@@ -1,2 +1,2 @@
 PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -DARMA_64BIT_WORD -DBOOST_DISABLE_ASSERTS
-PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS)
+PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) @RCPPTSKIT_LIB@
diff --git a/src/Makevars.win.in b/src/Makevars.win.in
@@ -1,2 +1,2 @@
 PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -DARMA_64BIT_WORD -DBOOST_DISABLE_ASSERTS
-PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS)
+PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) @RCPPTSKIT_LIB@
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -885,6 +885,28 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// rtsk_table_collection_summary2
+Rcpp::List rtsk_table_collection_summary2(const SEXP tc);
+RcppExport SEXP _AlphaSimR_rtsk_table_collection_summary2(SEXP tcSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const SEXP >::type tc(tcSEXP);
+    rcpp_result_gen = Rcpp::wrap(rtsk_table_collection_summary2(tc));
+    return rcpp_result_gen;
+END_RCPP
+}
+// rtsk_treeseq_get_num_individuals2
+int rtsk_treeseq_get_num_individuals2(const SEXP ts);
+RcppExport SEXP _AlphaSimR_rtsk_treeseq_get_num_individuals2(SEXP tsSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const SEXP >::type ts(tsSEXP);
+    rcpp_result_gen = Rcpp::wrap(rtsk_treeseq_get_num_individuals2(ts));
+    return rcpp_result_gen;
+END_RCPP
+}
 
 static const R_CallMethodDef CallEntries[] = {
     {"_AlphaSimR_solveRRBLUP", (DL_FUNC) &_AlphaSimR_solveRRBLUP, 3},
@@ -944,6 +966,8 @@ static const R_CallMethodDef CallEntries[] = {
     {"_AlphaSimR_rngDiagnosticsSampleInt", (DL_FUNC) &_AlphaSimR_rngDiagnosticsSampleInt, 4},
     {"_AlphaSimR_rngDiagnosticsSamplePoisson", (DL_FUNC) &_AlphaSimR_rngDiagnosticsSamplePoisson, 3},
     {"_AlphaSimR_MaCS", (DL_FUNC) &_AlphaSimR_MaCS, 6},
+    {"_AlphaSimR_rtsk_table_collection_summary2", (DL_FUNC) &_AlphaSimR_rtsk_table_collection_summary2, 1},
+    {"_AlphaSimR_rtsk_treeseq_get_num_individuals2", (DL_FUNC) &_AlphaSimR_rtsk_treeseq_get_num_individuals2, 1},
     {NULL, NULL, 0}
 };
 
diff --git a/src/ts.cpp b/src/ts.cpp
@@ -0,0 +1,58 @@
+#include "alphasimr.h"
+#include <RcppTskit.hpp>
+// [[Rcpp::depends(RcppTskit)]]
+// [[Rcpp::plugins(RcppTskit)]]
+
+// TODO: This is just an example - we will replace it later with other
+//       functions working with tree sequences. For example to obtain haplotypes
+//       using https://tskit.dev/tskit/docs/stable/c-api.html#decoding-genotypes
+//
+//       See also ts: Create haplotypes from a tree sequence for downstream
+//       AlphaSimR work (but subsample sites!) #4
+//       https://github.com/HighlanderLab/AlphaSimR/issues/4
+//
+//' @title Summarise `tskit` table collection
+//' @param tc an external pointer to a \code{tsk_table_collection_t} object.
+//' @return A list.
+//' @examples
+//' ts_file <- system.file("examples", "test.trees", package = "RcppTskit")
+//' tc <- RcppTskit:::tc_load(ts_file)
+//' RcppTskit:::rtsk_table_collection_summary(tc$xptr)
+//' rtsk_table_collection_summary2(tc$xptr)
+//' @export
+// [[Rcpp::export]]
+Rcpp::List rtsk_table_collection_summary2(const SEXP tc) {
+  rtsk_table_collection_t tc_xptr(tc);
+  const tsk_table_collection_t *tables = tc_xptr;
+  return Rcpp::List::create(
+      Rcpp::_["num_provenances"] = tables->provenances.num_rows,
+      Rcpp::_["num_populations"] = tables->populations.num_rows,
+      Rcpp::_["num_migrations"] = tables->migrations.num_rows,
+      Rcpp::_["num_individuals"] = tables->individuals.num_rows,
+      Rcpp::_["num_nodes"] = tables->nodes.num_rows,
+      Rcpp::_["num_edges"] = tables->edges.num_rows,
+      Rcpp::_["num_sites"] = tables->sites.num_rows,
+      Rcpp::_["num_mutations"] = tables->mutations.num_rows,
+      Rcpp::_["sequence_length"] = tables->sequence_length,
+      Rcpp::_["has_reference_sequence"] =
+          rtsk_table_collection_has_reference_sequence(tc),
+      Rcpp::_["time_units"] = rtsk_table_collection_get_time_units(tc),
+      Rcpp::_["file_uuid"] = rtsk_table_collection_get_file_uuid(tc),
+      Rcpp::_["has_index"] = rtsk_table_collection_has_index(tc));
+}
+
+//' @title Get number of individuals in tree sequence
+//' @param ts an external pointer to a \code{tsk_treeseq_t} object.
+//' @return integer number of individuals.
+//' @examples
+//' ts_file <- system.file("examples", "test.trees", package = "RcppTskit")
+//' ts <- RcppTskit::ts_load(ts_file)
+//' ts$num_individuals()
+//' RcppTskit:::rtsk_treeseq_get_num_individuals(ts$xptr)
+//' rtsk_treeseq_get_num_individuals2(ts$xptr)
+//' @export
+// [[Rcpp::export]]
+int rtsk_treeseq_get_num_individuals2(const SEXP ts) {
+  rtsk_treeseq_t ts_xptr(ts);
+  return static_cast<int>(tsk_treeseq_get_num_individuals(ts_xptr));
+}
diff --git a/tools/configure.R b/tools/configure.R
@@ -0,0 +1,106 @@
+#!/usr/bin/env Rscript
+
+# Find the RcppTskit library directory and library file
+# and return appropriate linker flags for use in Makevars
+findRcppTskitLib <- function() {
+  libdir <- system.file("libs", package = "RcppTskit")
+  if (!nzchar(libdir)) {
+    # nzchar() checks for non-zero character length
+    stop("Unable to locate the RcppTskit shared library directory!")
+  }
+
+  libdirs <- libdir
+  if (.Platform$OS.type == "windows") {
+    r_arch <- sub("^/", "", .Platform$r_arch)
+    if (nzchar(r_arch)) {
+      libdirs <- c(libdirs, file.path(libdir, r_arch))
+    } else {
+      arch_dirs <- c("x64", "i386")
+      arch_dirs <- arch_dirs[dir.exists(file.path(libdir, arch_dirs))]
+      libdirs <- c(libdirs, file.path(libdir, arch_dirs))
+    }
+    libdirs <- unique(libdirs)
+  }
+
+  if (.Platform$OS.type == "unix") {
+    candidates <- c(
+      "RcppTskit.so", # Unix/Linux
+      "RcppTskit.dylib" # macOS
+    )
+  } else if (.Platform$OS.type == "windows") {
+    candidates <- c(
+      "RcppTskit.dll.a", # MinGW/Rtools (default)
+      "RcppTskit.lib", # MSVC (backup to MinGW/Rtools)
+      "RcppTskit.dll" # DLL (backup to MinGW/Rtools)
+    )
+  } else {
+    stop("Unknown .Platform$OS.type!")
+  }
+  libpaths <- unlist(
+    lapply(libdirs, function(dir) file.path(dir, candidates)),
+    use.names = FALSE
+  )
+  libfile <- libpaths[file.exists(libpaths)][1]
+  if (is.na(libfile) || !nzchar(libfile)) {
+    stop(
+      "Unable to locate the RcppTskit library file in ",
+      paste(libdirs, collapse = ", "),
+      "!"
+    )
+  }
+
+  if (.Platform$OS.type == "unix") {
+    # Unix/Linux/macOS
+    # Embed rpath on so the runtime loader can find RcppTskit.so.
+    ret <- sprintf(
+      "-Wl,-rpath,%s %s",
+      shQuote(dirname(libfile)),
+      shQuote(libfile)
+    )
+  } else if (.Platform$OS.type == "windows") {
+    # Windows
+    ret <- shQuote(libfile)
+  } else {
+    stop("Unknown .Platform$OS.type!")
+  }
+  return(ret)
+}
+
+# Render a Makevars file from a template by replacing placeholders.
+# @param template character path to the template Makevars file
+# @param output character path to the output Makevars file
+renderMakevars <- function(template, output) {
+  if (!file.exists(template)) {
+    stop("Template file does not exist: ", template, "!")
+  }
+  RcppTskitLib <- findRcppTskitLib()
+  lines <- readLines(con = template)
+  lines <- gsub(
+    x = lines,
+    pattern = "@RCPPTSKIT_LIB@",
+    replacement = RcppTskitLib,
+    fixed = TRUE
+  )
+  writeLines(text = lines, con = output)
+  invisible(TRUE)
+}
+
+# renderMakevars(template = "this_should_fail", output = "before_getting_to_output")
+if (.Platform$OS.type == "unix") {
+  # readLines(con = "src/Makevars.in")
+  success <- renderMakevars(
+    template = "src/Makevars.in",
+    output = "src/Makevars"
+  )
+} else if (.Platform$OS.type == "windows") {
+  # readLines(con = "src/Makevars.win.in")
+  success <- renderMakevars(
+    template = "src/Makevars.win.in",
+    output = "src/Makevars.win"
+  )
+} else {
+  stop("Unknown .Platform$OS.type!")
+}
+if (!success) {
+  stop("renderMakevars() failed!")
+}

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+#!/bin/sh`
	`2`	`+"${R_HOME}/bin/Rscript" tools/configure.R`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+#!/bin/sh`
	`2`	`+"${R_HOME}/bin${R_ARCH_BIN}/Rscript" tools/configure.R`