// [[Rcpp::plugins(cpp11)]] #include using namespace Rcpp; // Rcpp containers typedef Rcpp::NumericMatrix nm; typedef Rcpp::NumericVector nv; typedef Rcpp::IntegerMatrix im; typedef Rcpp::IntegerVector iv; typedef Rcpp::LogicalMatrix lm; typedef Rcpp::LogicalVector lv; // Standard containers typedef std::vector svb; typedef std::vector svi; typedef std::vector svu; typedef std::vector svd; // Equality check functions. // [[Rcpp::export]] svi test_auto_conversion_std_int(const svi& v) { return v; } // [[Rcpp::export]] svi test_as_conversion_std_int(const lv& v) { svi v2 = as(v); return v2; } // [[Rcpp::export]] svi test_manual_conversion_std_int(const nv& v) { svi v2(v.begin(),v.end()); return v2; } // [[Rcpp::export]] svd test_auto_conversion_std_dbl(const svd& v) { return v; } // [[Rcpp::export]] svd test_as_conversion_std_dbl(const lv& v) { svd v2 = as(v); return v2; } // [[Rcpp::export]] svd test_manual_conversion_std_dbl(const nv& v) { svd v2(v.begin(),v.end()); return v2; } // Benchmarking functions. // // Rcpp container funcs... // Matrices don't have a "size()" in Rcpp, so just return ncol. // [[Rcpp::export]] size_t rcpp_lm(const lm& v) {return v.ncol();} // [[Rcpp::export]] size_t rcpp_lv(const lv& v) {return v.size();} // [[Rcpp::export]] size_t rcpp_im(const im& v) {return v.ncol();} // [[Rcpp::export]] size_t rcpp_iv(const iv& v) {return v.size();} // [[Rcpp::export]] size_t rcpp_nm(const nm& v) {return v.ncol();} // [[Rcpp::export]] size_t rcpp_nv(const nv& v) {return v.size();} // Standard container funcs... // [[Rcpp::export]] size_t std_bool(const svb& v) {return v.size();} // [[Rcpp::export]] size_t std_int(const svi& v) {return v.size();} // [[Rcpp::export]] size_t std_uint(const svu& v) {return v.size();} // [[Rcpp::export]] size_t std_dbl(const svd& v) {return v.size();} // Standard container funcs promoted types... // [[Rcpp::export]] size_t std_bool_promote_int(const svb& v) { svi v2(v.begin(), v.end()); return std_int(v2); } // [[Rcpp::export]] size_t std_bool_promote_uint(const svb& v) { svu v2(v.begin(), v.end()); return std_uint(v2); } // [[Rcpp::export]] size_t std_bool_promote_dbl(const svb& v) { svd v2(v.begin(), v.end()); return std_dbl(v2); } // [[Rcpp::export]] size_t std_int_promote_uint(const svi& v) { svu v2(v.begin(), v.end()); return std_uint(v2); } // [[Rcpp::export]] size_t std_int_promote_dbl(const svi& v) { svd v2(v.begin(), v.end()); return std_dbl(v2); } // Rcpp container funcs to std promoted types... // [[Rcpp::export]] size_t rcpp_lm_promote_std_bool(const lm& v) { svb v2(v.begin(), v.end()); return std_bool(v2); } // [[Rcpp::export]] size_t rcpp_lm_promote_std_int(const im& v) { svi v2(v.begin(), v.end()); return std_int(v2); } // [[Rcpp::export]] size_t rcpp_lv_promote_std_int(const iv& v) { svi v2(v.begin(), v.end()); return std_int(v2); } // [[Rcpp::export]] size_t rcpp_lm_promote_std_dbl(const im& v) { svd v2(v.begin(), v.end()); return std_dbl(v2); } // [[Rcpp::export]] size_t rcpp_lv_promote_std_dbl(const iv& v) { svd v2(v.begin(), v.end()); return std_dbl(v2); } // [[Rcpp::export]] size_t rcpp_im_promote_std_dbl(const im& v) { svd v2(v.begin(), v.end()); return std_dbl(v2); } // [[Rcpp::export]] size_t rcpp_iv_promote_std_dbl(const iv& v) { svd v2(v.begin(), v.end()); return std_dbl(v2); } // [[Rcpp::export]] NumericVector return_std_dbl_lv(const nv& v) { svd v2(v.begin(), v.end()); return wrap(v2); } /*** R library(microbenchmark) times <- 500 rows <- 1500 cols <- 1000 l_vec <- rep( c(T,F,NA), rows * cols / 3) n_vec <- as.numeric(l_vec) i_vec <- as.integer(l_vec) l_mat <- matrix(l_vec, rows, cols) n_mat <- matrix(n_vec, rows, cols) i_mat <- matrix(i_vec, rows, cols) benchmark_as_tested_for_equality <- function() { bmr <- microbenchmark( test_auto_conversion_std_int(l_vec), test_as_conversion_std_int(l_vec), test_manual_conversion_std_int(l_vec), test_auto_conversion_std_dbl(l_vec), test_as_conversion_std_dbl(l_vec), test_manual_conversion_std_dbl(l_vec), times=times) print(bmr, order = "median", unit = "us") } declared_direct <- function() { bmr <- microbenchmark( rcpp_lm(l_mat), rcpp_lv(l_vec), rcpp_im( i_mat), rcpp_iv(i_vec), rcpp_nm(n_mat), rcpp_nv(n_vec), times = 1000) print(bmr, order = "median", unit = "us") } declared_std_like_types <- function() { bmr <- microbenchmark( std_bool(l_mat), std_bool(l_vec), std_int(i_mat), std_int(i_vec), std_dbl(n_mat), std_dbl(n_vec), times = times) print(bmr, order="median", unit="us") } declared_promoted_r <- function() { bmr <- microbenchmark( rcpp_im(l_mat), rcpp_iv(l_vec), rcpp_nm(l_mat), rcpp_nv(l_vec), rcpp_nm(i_mat), rcpp_nv(i_vec), times=times) print(bmr, order="median", unit="us") } declared_promoted_std <- function() { bmr <- microbenchmark( std_int(l_mat), std_int(l_vec), std_dbl(l_mat), std_dbl(l_vec), std_dbl(i_mat), std_dbl(i_vec), times=times) print(bmr, order="median", unit="us") } declared_std_like_types_promoted_using_std_promotion <- function() { bmr <- microbenchmark( std_bool_promote_int(l_mat), std_bool_promote_int(l_vec), std_bool_promote_dbl(l_mat), std_bool_promote_dbl(l_vec), std_int_promote_dbl(i_mat), std_int_promote_dbl(i_vec), times=times) print(bmr, order="median", unit="us") } declared_promoted_r_to_std_like_type <- function() { bmr <- microbenchmark( rcpp_lm_promote_std_bool(l_mat), rcpp_lm_promote_std_int(l_mat), rcpp_lv_promote_std_int(l_vec), rcpp_lm_promote_std_dbl(l_mat), rcpp_lv_promote_std_dbl(l_vec), rcpp_im_promote_std_dbl(i_mat), rcpp_iv_promote_std_dbl(i_vec), times=times) print(bmr, order="median", unit="us") } small_l_vec <- c(T,F,NA) small_i_vec <- as.integer(small_l_vec) small_n_vec <- as.numeric(small_l_vec) all( identical(small_i_vec, test_auto_conversion_std_int(small_l_vec)), identical(small_i_vec, test_as_conversion_std_int(small_l_vec)), identical(small_i_vec, test_manual_conversion_std_int(small_l_vec)) ) all( identical(small_n_vec, test_auto_conversion_std_dbl(small_l_vec)), identical(small_n_vec, test_as_conversion_std_dbl(small_l_vec)), identical(small_n_vec, test_manual_conversion_std_dbl(small_l_vec)) ) # Includes copy time benchmark_as_tested_for_equality() # Use "size" only for return... declared_direct() declared_std_like_types() declared_promoted_r() declared_promoted_std() declared_std_like_types_promoted_using_std_promotion() declared_promoted_r_to_std_like_type() */