Implement set_kernel_fun

Author: apulsipher

src/lfmcmc.cpp

@@ -147,7 +147,25 @@ SEXP set_kernel_fun_cpp(
     SEXP lfmcmc,
     cpp11::function fun
 ) {
-    cpp11::stop("Unimplemented");
+
+    LFMCMCKernelFun<TData_default> fun_call = [fun](
+        const std::vector< epiworld_double >& stats_now,
+        const std::vector< epiworld_double >& stats_obs,
+        epiworld_double epsilon,
+        LFMCMC<TData_default>*
+        ) -> epiworld_double {
+
+        auto stats_now_doubles = cpp11::doubles(stats_now);
+        auto stats_obs_doubles = cpp11::doubles(stats_obs);
+
+        return cpp11::as_cpp<epiworld_double>(
+            fun(stats_now_doubles, stats_obs_doubles, epsilon)
+            );
+    };
+
+    WrapLFMCMC(lfmcmc_ptr)(lfmcmc);
+
+    lfmcmc_ptr->set_kernel_fun(fun_call);
 
     return lfmcmc;
 }

vignettes/likelihood-free-mcmc.Rmd

@@ -80,12 +80,23 @@ sumfun <- function(dat) {
   return(dat)
 }
 
+# Define the LFMCMC kernel function
+# - Based on kernel_fun_uniform from lfmcmc-meat.hpp
+kernelfun <- function(stats_now, stats_obs, epsilon) {
+
+  ans <- sum(mapply(function(v1, v2) (v1 - v2)^2,
+    stats_obs,
+    stats_now))
+
+  return(ifelse(sqrt(ans) < epsilon, 1.0, 0.0))
+}
+
 # Create the LFMCMC model using a norm reflective proposal function and a Gaussian kernel function
 lfmcmc_model <- LFMCMC(model_sir) |>
   set_simulation_fun(simfun) |>
   set_summary_fun(sumfun) |>
   use_proposal_norm_reflective() |>
-  use_kernel_fun_gaussian() |>
+  set_kernel_fun(kernelfun) |>
   set_observed_data(obs_data)
 ```