Avoid arma::cube

smeekes · May 17, 2023 · cff25f2 · cff25f2
1 parent 67f0faf
commit cff25f2
Show file tree

Hide file tree

Showing 7 changed files with 163 additions and 167 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: bootUR
 Type: Package
 Title: Bootstrap Unit Root Tests
-Version: 1.0.1
+Version: 1.0.2
 Authors@R: c(
    person("Stephan", "Smeekes", email = "s.smeekes@maastrichtuniversity.nl", role = c("cre", "aut"), 
    comment = c(ORCID = "0000-0002-0157-639X")),

diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,7 @@
-## Version 1.0.1
+## Version 1.0.2
 
 ### Bug Fixes
-* Fixed the CRAN check Additional Issues.
+* Fixed the CRAN check Additional Issues LTO warnings by avoiding the use of arma::cube in C++ code.
 
 ## Version 1.0.0
 

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -17,12 +17,12 @@ bootstrap_cpp <- function(B, u, e, boot, l, s, ar, ar_est, y0, pmin, pmax, ic, d
     .Call(`_bootUR_bootstrap_cpp`, B, u, e, boot, l, s, ar, ar_est, y0, pmin, pmax, ic, dc, detr, ic_scale, h_rs, range, joint, do_parallel, show_progress)
 }
 
-scaling_factors_cpp <- function(u, prob) {
-    .Call(`_bootUR_scaling_factors_cpp`, u, prob)
+scaling_factors_cpp <- function(u, D, prob) {
+    .Call(`_bootUR_scaling_factors_cpp`, u, D, prob)
 }
 
-union_tests_cpp <- function(t, s) {
-    .Call(`_bootUR_union_tests_cpp`, t, s)
+union_tests_cpp <- function(t, D, s) {
+    .Call(`_bootUR_union_tests_cpp`, t, D, s)
 }
 
 union_test_cpp <- function(t, s) {

diff --git a/R/auxiliary.R b/R/auxiliary.R
@@ -97,12 +97,15 @@ do_tests_and_bootstrap <- function(data, boot_sqt_test, boot_ur_test, level, boo
   u_boot[is.nan(u_boot)] <- NA
   res <- panel_est$res
   ar_est <- panel_est$par[-1, , drop = FALSE]
-  t_star <- bootstrap_cpp(B = B, boot = boot, u = u_boot, e = res, l = l, s = s_DWB,
+  t_star_mat <- bootstrap_cpp(B = B, boot = boot, u = u_boot, e = res, l = l, s = s_DWB,
                           ar = ar_AWB, ar_est = ar_est, y0 = matrix(0, ncol = N),
                           pmin = min_lag, pmax = max_lag, ic = ic, dc = dc, detr = detr_int,
                           ic_scale = criterion_scale, h_rs = h_rs, range = range_nonmiss,
                           joint = joint, show_progress = show_progress,
                           do_parallel = do_parallel)
+
+  D <- length(dc) * length(detr_int)
+  t_star <- array(t_star_mat, dim = c(B, D * N))
 
   tests <- adf_tests_panel_cpp(data, pmin = min_lag, pmax = max_lag, ic = ic,
                                dc = dc, detr = detr_int, ic_scale = criterion_scale,
@@ -112,19 +115,16 @@ do_tests_and_bootstrap <- function(data, boot_sqt_test, boot_ur_test, level, boo
   lags_ind <- tests$lags   # Selected lag lengths
 
   pvals <- matrix(iADF_cpp(matrix(tests_ind, nrow = 1),
-                  matrix(t_star, nrow = B)), nrow = N, ncol = 4, byrow = TRUE)
+                           matrix(t_star, nrow = B)), nrow = N, ncol = D, byrow = TRUE)
   if (union) {
-    pvals <- matrix(iADF_cpp(matrix(tests_ind, nrow = 1),
-                             matrix(t_star, nrow = B)), nrow = N, ncol = 4, byrow = TRUE)
-    scaling <- scaling_factors_cpp(t_star, level)
+    scaling <- scaling_factors_cpp(t_star, D, level)
     if (N > 1) {
-      test_stats_star <- union_tests_cpp(t_star, scaling)
-      test_stats <- union_tests_cpp(array(tests_ind, dim = c(1, length(dc) * length(detr_int), N)),
+      test_stats_star <- union_tests_cpp(t_star, D, scaling)
+      test_stats <- union_tests_cpp(array(tests_ind, dim = c(1, D * N)), D,
                                     scaling)
     } else {
-      test_stats_star <- union_test_cpp(t_star[, , 1], scaling)
-      test_stats <- union_test_cpp(array(tests_ind,
-                                         dim = c(1, length(dc) * length(detr_int))), scaling)
+      test_stats_star <- union_test_cpp(t_star, scaling)
+      test_stats <- union_test_cpp(array(tests_ind, dim = c(1, D)), scaling)
     }
   } else {
     pvals <- matrix(iADF_cpp(matrix(tests_ind, nrow = 1),

diff --git a/R/bootURtests.R b/R/bootURtests.R
@@ -155,7 +155,7 @@ boot_ur <- function(data, data_name = NULL, bootstrap = "AWB", B = 1999, block_l
                                            function(x,y){paste0(x, "/", y)})))
   } else { # No union test
     iADFout <- iADF_cpp(test_i = matrix(inputs$indiv_test_stats[1, ], nrow = 1),
-                        t_star = matrix(inputs$t_star[ , 1, ], nrow = B))
+                        t_star = matrix(inputs$t_star, nrow = B))
     iADFout <- cbind(t(inputs$indiv_par_est), t(inputs$indiv_test_stats), iADFout)
     # Parameter estimates, tstats and p-values
 
@@ -513,7 +513,7 @@ boot_fdr <- function(data, data_name = NULL, bootstrap = "AWB", B = 1999, block_
                                            function(x,y){paste0(x, "/", y)})))
   } else { # No Union Tests
     bFDRout <- FDR_cpp(test_i = matrix(inputs$indiv_test_stats[1, ], nrow = 1),
-                       t_star = inputs$t_star[ , 1,], level = inputs$level)
+                       t_star = inputs$t_star, level = inputs$level)
     estimates <- t(inputs$indiv_par_est)
     tstats <- drop(inputs$tests_i[1, ])
     method_name <- paste0(bootstrap, " bootstrap ", inputs$inputs$name, " tests (with " ,
@@ -683,7 +683,7 @@ boot_sqt <- function(data, data_name = NULL, steps = 0:NCOL(data), bootstrap = "
   } else { # No Union Tests
     BSQTout <- BSQT_cpp(pvec = inputs$p_vec,
                         test_i = matrix(inputs$indiv_test_stats[1, ], nrow = 1),
-                        t_star = inputs$t_star[ , 1,], level = inputs$level)
+                        t_star = inputs$t_star, level = inputs$level)
     estimates <- t(inputs$indiv_par_est)
     tstats <- drop(inputs$indiv_test_stats)
     method_name <- paste0(bootstrap, " bootstrap sequential quantile ",

diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -71,7 +71,7 @@ BEGIN_RCPP
 END_RCPP
 }
 // bootstrap_cpp
-arma::cube bootstrap_cpp(const int& B, const arma::mat& u, const arma::mat& e, const int& boot, const int& l, const arma::mat& s, const double& ar, const arma::mat& ar_est, const arma::mat& y0, const int& pmin, const int& pmax, const int& ic, const arma::vec& dc, const arma::vec& detr, const bool& ic_scale, const double& h_rs, const arma::umat& range, const bool& joint, const bool& do_parallel, const bool& show_progress);
+arma::mat bootstrap_cpp(const int& B, const arma::mat& u, const arma::mat& e, const int& boot, const int& l, const arma::mat& s, const double& ar, const arma::mat& ar_est, const arma::mat& y0, const int& pmin, const int& pmax, const int& ic, const arma::vec& dc, const arma::vec& detr, const bool& ic_scale, const double& h_rs, const arma::umat& range, const bool& joint, const bool& do_parallel, const bool& show_progress);
 RcppExport SEXP _bootUR_bootstrap_cpp(SEXP BSEXP, SEXP uSEXP, SEXP eSEXP, SEXP bootSEXP, SEXP lSEXP, SEXP sSEXP, SEXP arSEXP, SEXP ar_estSEXP, SEXP y0SEXP, SEXP pminSEXP, SEXP pmaxSEXP, SEXP icSEXP, SEXP dcSEXP, SEXP detrSEXP, SEXP ic_scaleSEXP, SEXP h_rsSEXP, SEXP rangeSEXP, SEXP jointSEXP, SEXP do_parallelSEXP, SEXP show_progressSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
@@ -101,26 +101,28 @@ BEGIN_RCPP
 END_RCPP
 }
 // scaling_factors_cpp
-arma::mat scaling_factors_cpp(const arma::cube& u, const double& prob);
-RcppExport SEXP _bootUR_scaling_factors_cpp(SEXP uSEXP, SEXP probSEXP) {
+arma::mat scaling_factors_cpp(const arma::mat& u, const int& D, const double& prob);
+RcppExport SEXP _bootUR_scaling_factors_cpp(SEXP uSEXP, SEXP DSEXP, SEXP probSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
-    Rcpp::traits::input_parameter< const arma::cube& >::type u(uSEXP);
+    Rcpp::traits::input_parameter< const arma::mat& >::type u(uSEXP);
+    Rcpp::traits::input_parameter< const int& >::type D(DSEXP);
     Rcpp::traits::input_parameter< const double& >::type prob(probSEXP);
-    rcpp_result_gen = Rcpp::wrap(scaling_factors_cpp(u, prob));
+    rcpp_result_gen = Rcpp::wrap(scaling_factors_cpp(u, D, prob));
     return rcpp_result_gen;
 END_RCPP
 }
 // union_tests_cpp
-arma::mat union_tests_cpp(const arma::cube& t, arma::mat& s);
-RcppExport SEXP _bootUR_union_tests_cpp(SEXP tSEXP, SEXP sSEXP) {
+arma::mat union_tests_cpp(const arma::mat& t, const int& D, arma::mat& s);
+RcppExport SEXP _bootUR_union_tests_cpp(SEXP tSEXP, SEXP DSEXP, SEXP sSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
-    Rcpp::traits::input_parameter< const arma::cube& >::type t(tSEXP);
+    Rcpp::traits::input_parameter< const arma::mat& >::type t(tSEXP);
+    Rcpp::traits::input_parameter< const int& >::type D(DSEXP);
     Rcpp::traits::input_parameter< arma::mat& >::type s(sSEXP);
-    rcpp_result_gen = Rcpp::wrap(union_tests_cpp(t, s));
+    rcpp_result_gen = Rcpp::wrap(union_tests_cpp(t, D, s));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -199,8 +201,8 @@ static const R_CallMethodDef CallEntries[] = {
     {"_bootUR_adf_tests_panel_cpp", (DL_FUNC) &_bootUR_adf_tests_panel_cpp, 9},
     {"_bootUR_adf_panel_bootstrap_dgp_cpp", (DL_FUNC) &_bootUR_adf_panel_bootstrap_dgp_cpp, 10},
     {"_bootUR_bootstrap_cpp", (DL_FUNC) &_bootUR_bootstrap_cpp, 20},
-    {"_bootUR_scaling_factors_cpp", (DL_FUNC) &_bootUR_scaling_factors_cpp, 2},
-    {"_bootUR_union_tests_cpp", (DL_FUNC) &_bootUR_union_tests_cpp, 2},
+    {"_bootUR_scaling_factors_cpp", (DL_FUNC) &_bootUR_scaling_factors_cpp, 3},
+    {"_bootUR_union_tests_cpp", (DL_FUNC) &_bootUR_union_tests_cpp, 3},
     {"_bootUR_union_test_cpp", (DL_FUNC) &_bootUR_union_test_cpp, 2},
     {"_bootUR_BSQT_cpp", (DL_FUNC) &_bootUR_BSQT_cpp, 4},
     {"_bootUR_iADF_cpp", (DL_FUNC) &_bootUR_iADF_cpp, 2},