improve StatFunc

qddyy · Dec 19, 2024 · e9ade53 · e9ade53
1 parent a3e1ed2
commit e9ade53
Showing 1 changed file with 20 additions and 23 deletions.
diff --git a/src/pmt_interface.cpp b/src/pmt_interface.cpp
@@ -7,9 +7,6 @@ using namespace Rcpp;
 
 #include <type_traits>
 
-template <unsigned i>
-using tag_t = std::integral_constant<unsigned, i>;
-
 template <unsigned n>
 constexpr auto Rf_lang = nullptr;
 
@@ -19,30 +16,30 @@ constexpr auto Rf_lang<2> = Rf_lang2;
 template <>
 constexpr auto Rf_lang<3> = Rf_lang3;
 
-template <unsigned n_shared>
+template <bool sharing_args>
 class StatFunc : public Function {
 public:
     using Function::Function;
 
     template <typename... Args>
     auto operator()(Args&&... args) const
     {
-        return _invoke(tag_t<n_shared>(), std::forward<Args>(args)...);
+        return _invoke(std::integral_constant<bool, sharing_args>(), std::forward<Args>(args)...);
     }
 
 private:
     template <typename... Args>
-    auto _invoke(tag_t<0>, Args&&... args) const
+    auto _invoke(std::false_type, Args&&... args) const
     {
         return [r_closure = Function(Function::operator()(std::forward<Args>(args)...))](auto&&... args) {
             return as<double>(r_closure(std::forward<decltype(args)>(args)...));
         };
     }
 
-    template <unsigned n = n_shared, typename... Args>
-    auto _invoke(tag_t<n>, Args&&... args) const
+    template <typename... Args>
+    auto _invoke(std::true_type, Args&&... args) const
     {
-        return [r_call = RObject(Rf_lang<n + 1>(Function::operator()(std::forward<Args>(args)...), std::forward<Args>(args)...))](auto&&...) {
+        return [r_call = Shield<SEXP>(Rf_lang<sizeof...(args) + 1>(Function::operator()(std::forward<Args>(args)...), std::forward<Args>(args)...))](auto&&...) {
             return as<double>(Rcpp_fast_eval(r_call, R_GlobalEnv));
         };
     }
@@ -59,8 +56,8 @@ SEXP twosample_pmt(
     const bool progress)
 {
     return progress ?
-        impl_twosample_pmt<true, StatFunc<2>>(clone(x), clone(y), statistic_func, n_permu) :
-        impl_twosample_pmt<false, StatFunc<2>>(clone(x), clone(y), statistic_func, n_permu);
+        impl_twosample_pmt<true, StatFunc<true>>(clone(x), clone(y), statistic_func, n_permu) :
+        impl_twosample_pmt<false, StatFunc<true>>(clone(x), clone(y), statistic_func, n_permu);
 }
 
 #include "pmt/impl_ksample_pmt.hpp"
@@ -74,8 +71,8 @@ SEXP ksample_pmt(
     const bool progress)
 {
     return progress ?
-        impl_ksample_pmt<true, StatFunc<2>>(data, clone(group), statistic_func, n_permu) :
-        impl_ksample_pmt<false, StatFunc<2>>(data, clone(group), statistic_func, n_permu);
+        impl_ksample_pmt<true, StatFunc<true>>(data, clone(group), statistic_func, n_permu) :
+        impl_ksample_pmt<false, StatFunc<true>>(data, clone(group), statistic_func, n_permu);
 }
 
 #include "pmt/impl_multcomp_pmt.hpp"
@@ -91,8 +88,8 @@ SEXP multcomp_pmt(
     const bool progress)
 {
     return progress ?
-        impl_multcomp_pmt<true, StatFunc<0>>(group_i, group_j, data, clone(group), statistic_func, n_permu) :
-        impl_multcomp_pmt<false, StatFunc<0>>(group_i, group_j, data, clone(group), statistic_func, n_permu);
+        impl_multcomp_pmt<true, StatFunc<false>>(group_i, group_j, data, clone(group), statistic_func, n_permu) :
+        impl_multcomp_pmt<false, StatFunc<false>>(group_i, group_j, data, clone(group), statistic_func, n_permu);
 }
 
 #include "pmt/impl_paired_pmt.hpp"
@@ -106,8 +103,8 @@ SEXP paired_pmt(
     const bool progress)
 {
     return progress ?
-        impl_paired_pmt<true, StatFunc<2>>(clone(x), clone(y), statistic_func, n_permu) :
-        impl_paired_pmt<false, StatFunc<2>>(clone(x), clone(y), statistic_func, n_permu);
+        impl_paired_pmt<true, StatFunc<true>>(clone(x), clone(y), statistic_func, n_permu) :
+        impl_paired_pmt<false, StatFunc<true>>(clone(x), clone(y), statistic_func, n_permu);
 }
 
 #include "pmt/impl_rcbd_pmt.hpp"
@@ -120,8 +117,8 @@ SEXP rcbd_pmt(
     const bool progress)
 {
     return progress ?
-        impl_rcbd_pmt<true, StatFunc<1>>(clone(data), statistic_func, n_permu) :
-        impl_rcbd_pmt<false, StatFunc<1>>(clone(data), statistic_func, n_permu);
+        impl_rcbd_pmt<true, StatFunc<true>>(clone(data), statistic_func, n_permu) :
+        impl_rcbd_pmt<false, StatFunc<true>>(clone(data), statistic_func, n_permu);
 }
 
 #include "pmt/impl_association_pmt.hpp"
@@ -135,8 +132,8 @@ SEXP association_pmt(
     const bool progress)
 {
     return progress ?
-        impl_association_pmt<true, StatFunc<2>>(clone(x), clone(y), statistic_func, n_permu) :
-        impl_association_pmt<false, StatFunc<2>>(clone(x), clone(y), statistic_func, n_permu);
+        impl_association_pmt<true, StatFunc<true>>(clone(x), clone(y), statistic_func, n_permu) :
+        impl_association_pmt<false, StatFunc<true>>(clone(x), clone(y), statistic_func, n_permu);
 }
 
 #include "pmt/impl_table_pmt.hpp"
@@ -150,6 +147,6 @@ SEXP table_pmt(
     const bool progress)
 {
     return progress ?
-        impl_table_pmt<true, StatFunc<1>>(clone(row), clone(col), statistic_func, n_permu) :
-        impl_table_pmt<false, StatFunc<1>>(clone(row), clone(col), statistic_func, n_permu);
+        impl_table_pmt<true, StatFunc<true>>(clone(row), clone(col), statistic_func, n_permu) :
+        impl_table_pmt<false, StatFunc<true>>(clone(row), clone(col), statistic_func, n_permu);
 }