Added list_to_cube()

Helps with #11.
ocbe-uio · Oct 23, 2024 · 89c489e · 89c489e
1 parent 75bb7fb
commit 89c489e
Show file tree

Hide file tree

Showing 5 changed files with 47 additions and 0 deletions.
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -17,6 +17,10 @@ list_to_matrix <- function(r_list) {
     .Call(`_BayesSurvive_list_to_matrix`, r_list)
 }
 
+list_to_cube <- function(r_list) {
+    .Call(`_BayesSurvive_list_to_cube`, r_list)
+}
+
 settingInterval_cpp <- function(y, delta_, s_, J_) {
     .Call(`_BayesSurvive_settingInterval_cpp`, y, delta_, s_, J_)
 }

diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -71,6 +71,17 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// list_to_cube
+arma::cube list_to_cube(Rcpp::List r_list);
+RcppExport SEXP _BayesSurvive_list_to_cube(SEXP r_listSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< Rcpp::List >::type r_list(r_listSEXP);
+    rcpp_result_gen = Rcpp::wrap(list_to_cube(r_list));
+    return rcpp_result_gen;
+END_RCPP
+}
 // settingInterval_cpp
 Rcpp::List settingInterval_cpp(const arma::vec y, const arma::vec delta_, const arma::vec s_, const unsigned int J_);
 RcppExport SEXP _BayesSurvive_settingInterval_cpp(SEXP ySEXP, SEXP delta_SEXP, SEXP s_SEXP, SEXP J_SEXP) {

diff --git a/src/init.c b/src/init.c
@@ -16,6 +16,7 @@ extern SEXP _BayesSurvive_updateBH_list_cpp(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP,
 extern SEXP _BayesSurvive_updateRP_genomic_cpp(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP _BayesSurvive_UpdateGamma_cpp(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP _BayesSurvive_list_to_matrix(SEXP);
+extern SEXP _BayesSurvive_list_to_cube  (SEXP);
 extern SEXP _BayesSurvive_UpdateRPlee11_cpp(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 
 static const R_CallMethodDef CallEntries[] = {
@@ -27,6 +28,7 @@ static const R_CallMethodDef CallEntries[] = {
   {"_BayesSurvive_updateRP_genomic_cpp", (DL_FUNC) &_BayesSurvive_updateRP_genomic_cpp, 12},
   {"_BayesSurvive_UpdateGamma_cpp",      (DL_FUNC) &_BayesSurvive_UpdateGamma_cpp,       7},
   {"_BayesSurvive_list_to_matrix",       (DL_FUNC) &_BayesSurvive_list_to_matrix,        1},
+  {"_BayesSurvive_list_to_cube",         (DL_FUNC) &_BayesSurvive_list_to_cube,          1},
   {"_BayesSurvive_UpdateRPlee11_cpp",    (DL_FUNC) &_BayesSurvive_UpdateRPlee11_cpp,     6},
   {NULL, NULL, 0}
 };

diff --git a/src/misc.cpp b/src/misc.cpp
@@ -3,6 +3,7 @@
 
 // [[Rcpp::export]]
 arma::mat list_to_matrix(Rcpp::List r_list) {
+  // Converts a *list of vectors* into a matrix
   // Determine the number of columns (length of the list)
   int n_cols = r_list.size();
 
@@ -20,3 +21,26 @@ arma::mat list_to_matrix(Rcpp::List r_list) {
 
   return result;
 }
+
+//[[Rcpp::export]]
+arma::cube list_to_cube(Rcpp::List r_list) {
+  // Converts a *list of matrices* into a cube
+
+  // Determine the number of slices (length of the list)
+  int n_slices = r_list.size();
+
+  // Determine the number of rows (length of the first matrix in the list)
+  int n_rows = Rcpp::as<arma::mat>(r_list[0]).n_rows;
+  int n_cols = Rcpp::as<arma::mat>(r_list[0]).n_cols;
+
+  // Initialize the cube
+  arma::cube result(n_rows, n_cols, n_slices);
+
+  // Fill the cube
+  for (int g = 0; g < n_slices; ++g) {
+    arma::mat mat = Rcpp::as<arma::mat>(r_list[g]);
+    result.slice(g) = mat;
+  }
+
+  return result;
+}
diff --git a/tests/testthat/test-misc_cpp.R b/tests/testthat/test-misc_cpp.R
@@ -3,3 +3,9 @@ test_that("list_to_matrix works", {
   result_matrix <- list_to_matrix(r_list)
   expect_equal(result_matrix, matrix(1:9, nrow = 3, ncol = 3))
 })
+
+test_that("list_to_cube works", {
+  r_list <- list(matrix(1:6, 3), matrix(7:12, 3), matrix(13:18, 3))
+  result_cube <- list_to_cube(r_list)
+  expect_equal(result_cube, array(1:18, dim = c(3, 2, 3)))
+})