Merge pull request #2 from DavZim/runningmean

Adding a running mean option to ar_plotter

Author: haozhu233

DESCRIPTION

@@ -19,8 +19,11 @@ Imports:
     glue,
     shiny,
     plotly
+Depends:
+    Rcpp (>= 0.12.15)
 Remotes: ropenscilabs/webrockets
 LinkingTo: Rcpp
+RcppModules: RunningMeanModule
 VignetteBuilder: knitr
 Encoding: UTF-8
 RoxygenNote: 6.1.1

R/ar_plotter.R

@@ -9,16 +9,21 @@
 #' process frequency > 25 Hz (40ms delay time) or it might be the case that 
 #' my computer doesn't have enough power. Anyway, I set this option here to
 #' add 40ms delay time to reduce the sampling frequency. 
+#' @param running_mean If an integer larger than 0 is chosen, the running mean 
+#' of each series is computed, effectively smoothing the signals. Default value
+#' is set to 0 (no running mean is calculated)
 #' @inheritParams ar_monitor
 #' 
 #' @export
 ar_plotter <- function(fd, names = NULL, sep_fun = ar_sep_comma,  
                        reduce_freq = TRUE, flush_time = 0.05,
-                       eolchar = "\n", buf_max = 256, timeout = 5000) {
+                       eolchar = "\n", buf_max = 256, timeout = 5000,
+                       running_mean = 0) {
   shiny::runApp(
     ar_app(con = fd, names = names, sep_fun = sep_fun, 
            flush_time = flush_time, reduce_freq = reduce_freq,
-           eolchar = eolchar, buf_max = buf_max, timeout = timeout), 
+           eolchar = eolchar, buf_max = buf_max, timeout = timeout, 
+           running_mean = running_mean), 
     launch.browser = rstudioapi::viewer
   )
 }
@@ -27,7 +32,9 @@ ar_plotter <- function(fd, names = NULL, sep_fun = ar_sep_comma,
 
 ar_app <- function(con, names = NULL, sep_fun = ar_sep_comma, 
                    flush_time = 0.05, reduce_freq = TRUE,
-                   eolchar = "\n", buf_max = 256, timeout = 5000) {
+                   eolchar = "\n", buf_max = 256, timeout = 5000, 
+                   running_mean = 0) {
+  
   message("Flushing Port...")
   ar_flush_hard(con, flush_time)
   first_dot <- ar_read(con, eolchar, buf_max, timeout)
@@ -38,6 +45,14 @@ ar_app <- function(con, names = NULL, sep_fun = ar_sep_comma,
   first_dot <- sep_fun(first_dot)
   signal_vars <- seq(length(first_dot))
 
+  if (running_mean > 0) {
+    rmeans <- vector("list", length(first_dot))
+    for (i in signal_vars) {
+      rmeans[[i]] <- arduinor:::RunningMean$new(running_mean)
+      rmeans[[i]]$insert(first_dot[i])
+    }
+  }
+  
   if (is.null(names)) {
     names(signal_vars) <- paste("Var", signal_vars)
     names(first_dot) <- paste("Var", signal_vars)
@@ -113,6 +128,14 @@ ar_app <- function(con, names = NULL, sep_fun = ar_sep_comma,
       if (rv$state) {
         ar_flush_hard(con, 0.04, FALSE)
         realtime <- sep_fun(ar_read(con, eolchar, buf_max, timeout))
+        
+        if (running_mean > 0) {
+          for (i in seq(length(realtime))) {
+            rmeans[[i]]$insert(realtime[[i]])
+            realtime[[i]] <- rmeans[[i]]$get_mean()
+          }
+        }
+        
         if (input$save) {
           cat(csv_newline(realtime), file = input$file, append = TRUE)
         }

R/zzz.R

@@ -1,3 +1,6 @@
 .onUnload <- function(libpath) {
   library.dynam.unload("arduinor", libpath)
-}
+}
+
+Rcpp::loadModule("RunningMeanModule", TRUE)
+

src/RcppExports.cpp

@@ -65,12 +65,15 @@ BEGIN_RCPP
 END_RCPP
 }
 
+RcppExport SEXP _rcpp_module_boot_RunningMeanModule();
+
 static const R_CallMethodDef CallEntries[] = {
     {"_arduinor_ar_init", (DL_FUNC) &_arduinor_ar_init, 2},
     {"_arduinor_ar_is_open", (DL_FUNC) &_arduinor_ar_is_open, 1},
     {"_arduinor_ar_close", (DL_FUNC) &_arduinor_ar_close, 1},
     {"_arduinor_ar_read", (DL_FUNC) &_arduinor_ar_read, 4},
     {"_arduinor_ar_flush", (DL_FUNC) &_arduinor_ar_flush, 1},
+    {"_rcpp_module_boot_RunningMeanModule", (DL_FUNC) &_rcpp_module_boot_RunningMeanModule, 0},
     {NULL, NULL, 0}
 };
 

src/RunningMean.cpp

@@ -0,0 +1,50 @@
+#include "RunningMean.h"
+
+
+RunningMean::RunningMean() : n(0) {
+  stop("n (size of window) must be supplied");
+}
+
+// Initiates a new Running Mean class of size n (constant)
+RunningMean::RunningMean(int n) : n(n) {
+  if (n <= 0) stop("n (size of window) must be supplied");
+  deq.resize(n);
+  n_values = 0;
+  sum = 0;
+}
+
+// inserts a new value into the internal deque. Deletes the oldest value
+void RunningMean::insert(double v) {
+  if (n == 0) stop("n (size of window) must be larger than zero");
+  
+  // TODO: What happens if we insert a missing value? 
+  if (!R_IsNA(v) && !R_IsNaN(v)) {
+    n_values++;
+    sum += v - deq.back();
+    deq.push_front(v);
+    deq.pop_back();
+  }
+}
+
+// Returns the running mean of the values in the deque
+// if the size is 0, return NA, if the number of already inserted values (n_values)
+// is smaller than the size of the deque, use n_values. This allows the running mean 
+// to return values even if the number of values is smaller than window lengths
+// could also be set to NA if needed...
+double RunningMean::get_mean() {
+  if (n == 0) return NA_REAL;
+  if (n_values < n) return(sum / n_values);
+  return sum / n;
+}
+
+// prints the values of the deque
+void RunningMean::show() {
+  Rcout << "RunningMean object <" << static_cast<const void*>(this) << 
+    "> window size " << n << ", number of inserts " << n_values << "\n" << 
+      deq[0];
+  for (int i = 1; i < n; ++i) {
+    Rcout << " " << deq[i];
+  }
+  Rcout << "\n";
+}
+

src/RunningMean.h

@@ -0,0 +1,55 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+/*
+ * Example R Code
+ * 
+ * # Initiate the Class with a window-length of size 3
+ * obj <- arduinor:::RunningMean$new(3)
+ * 
+ * # insert a new value
+ * obj$insert(1.03)
+ * obj$insert(1.05)
+ * obj$insert(1.04)
+ * 
+ * # inspect the object 
+ * obj
+ * 
+ * # get the running mean
+ * obj$get_mean()
+ * 
+ * # add another value, effectively removing the first insert (1.03)
+ * obj$insert(1.06)
+ * obj
+ * obj$get_mean()
+ * 
+ */
+
+// defines the RunningMean class
+class RunningMean{
+public:
+  RunningMean();
+  RunningMean(int n);
+  
+  void insert(double val);
+  double get_mean();
+  void show();
+  
+private:
+  std::deque<double> deq;
+  const int n;
+  int n_values;
+  double sum;
+};
+
+// Exposes the class
+RCPP_MODULE(RunningMeanModule) {
+  class_<RunningMean>("RunningMean")
+    .default_constructor("Default constructor")
+    .constructor<int>("Constructor with an argument") 
+    .method("insert", &RunningMean::insert)
+    .method("get_mean", &RunningMean::get_mean)
+    .method("show", &RunningMean::show)
+    ;
+}
+