From 89c489ee39c1d85826de9e1bb6e5239b9e2d7b16 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <w.l.netto@medisin.uio.no>
Date: Wed, 23 Oct 2024 11:08:53 +0200
Subject: [PATCH] Added `list_to_cube()`

Helps with #11.
---
 R/RcppExports.R                |  4 ++++
 src/RcppExports.cpp            | 11 +++++++++++
 src/init.c                     |  2 ++
 src/misc.cpp                   | 24 ++++++++++++++++++++++++
 tests/testthat/test-misc_cpp.R |  6 ++++++
 5 files changed, 47 insertions(+)

diff --git a/R/RcppExports.R b/R/RcppExports.R
index efb2372..0fbd2aa 100644
--- 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
index f7659d4..ddd28ac 100644
--- 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
index 4a0b5b0..c88fdf8 100644
--- 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
index 4764523..ec95e52 100644
--- 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
index 50d0d8c..27bba2e 100644
--- 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)))
+})