[Rcpp-commits] r3023 - in pkg/Rcpp: . inst/examples inst/examples/OpenMP
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 27 15:58:47 CEST 2011
Author: edd
Date: 2011-04-27 15:58:47 +0200 (Wed, 27 Apr 2011)
New Revision: 3023
Added:
pkg/Rcpp/inst/examples/OpenMP/
pkg/Rcpp/inst/examples/OpenMP/Makefile
pkg/Rcpp/inst/examples/OpenMP/check.R
pkg/Rcpp/inst/examples/OpenMP/piWithInterrupts.cpp
Modified:
pkg/Rcpp/ChangeLog
Log:
beginnings of a new example contributed by Peter
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2011-04-26 18:57:56 UTC (rev 3022)
+++ pkg/Rcpp/ChangeLog 2011-04-27 13:58:47 UTC (rev 3023)
@@ -1,11 +1,16 @@
+2011-04-27 Dirk Eddelbuettel <edd at debian.org>
+
+ * inst/examples/OpenMP/piWithInterrupts.cpp: Beginnings of new
+ contributed example on OpenMP as well as user interrupt handling
+
2011-04-26 Romain Francois <romain at r-enthusiasts.com>
- * inst/include/Rcpp/sugar/functions/mean.h: new sugar function: mean
-
- * inst/include/Rcpp/sugar/functions/var.h: new sugar function: var
-
- * inst/include/Rcpp/sugar/functions/sd.h: new sugar function: sd
-
+ * inst/include/Rcpp/sugar/functions/mean.h: new sugar function: mean
+
+ * inst/include/Rcpp/sugar/functions/var.h: new sugar function: var
+
+ * inst/include/Rcpp/sugar/functions/sd.h: new sugar function: sd
+
2011-04-19 Dirk Eddelbuettel <edd at debian.org>
* inst/doc/Rcpp-FAQ/Rcpp-FAQ.Rnw: New example setting row and column
@@ -24,10 +29,11 @@
2011-04-12 Romain Francois <romain at r-enthusiasts.com>
- * inst/unitTests/testRcppModules/src/stdVector.cpp: compiler disambiguation
+ * inst/unitTests/testRcppModules/src/stdVector.cpp: compiler
+ disambiguation
- * src/r_cast.cpp: use a callback to R's "as.character" instead of calling
- Rf_coerceVector, which did not work as expected for factors
+ * src/r_cast.cpp: use a callback to R's "as.character" instead of
+ calling Rf_coerceVector, which did not work as expected for factors
2011-04-11 Romain Francois <romain at r-enthusiasts.com>
Added: pkg/Rcpp/inst/examples/OpenMP/Makefile
===================================================================
--- pkg/Rcpp/inst/examples/OpenMP/Makefile (rev 0)
+++ pkg/Rcpp/inst/examples/OpenMP/Makefile 2011-04-27 13:58:47 UTC (rev 3023)
@@ -0,0 +1,30 @@
+
+## comment this out if you need a different version of R,
+## and set set R_HOME accordingly as an environment variable
+R_HOME := $(shell R RHOME)
+
+## include headers and libraries for R
+RCPPFLAGS := $(shell $(R_HOME)/bin/R CMD config --cppflags)
+RLDFLAGS := $(shell $(R_HOME)/bin/R CMD config --ldflags)
+
+## include headers and libraries for Rcpp interface classes
+RCPPINCL := $(shell echo 'Rcpp:::CxxFlags()' | $(R_HOME)/bin/R --vanilla --slave)
+RCPPLIBS := $(shell echo 'Rcpp:::LdFlags()' | $(R_HOME)/bin/R --vanilla --slave)
+
+## OpenMP
+OPENMPFLAGS := -fopenmp
+
+c_sources := $(wildcard *.c)
+c_sharedlibs := $(patsubst %.c,%.o,$(c_sources))
+
+cpp_sources := $(wildcard *.cpp)
+cpp_sharedlibs := $(patsubst %.cpp,%.o,$(cpp_sources))
+
+all : $(c_sharedlibs) $(cpp_sharedlibs)
+
+%.o : %.c
+ R CMD SHLIB $<
+
+%.o : %.cpp
+ PKG_CPPFLAGS="$(RCPPFLAGS) $(RCPPINCL) $(OPENMPFLAGS)" PKG_LIBS="$(RLDFLAGS) $(RCPPLIBS) $(OPENMPFLAGS)" R CMD SHLIB $<
+
Added: pkg/Rcpp/inst/examples/OpenMP/check.R
===================================================================
--- pkg/Rcpp/inst/examples/OpenMP/check.R (rev 0)
+++ pkg/Rcpp/inst/examples/OpenMP/check.R 2011-04-27 13:58:47 UTC (rev 3023)
@@ -0,0 +1,5 @@
+
+dyn.load("piWithInterrupts.so")
+#res <- .Call("PiLeibniz", n=1e9, frequency=1e6)
+res <- .Call("PiLeibniz", n=1e9, frequency=1e6)
+print(res, digits=10)
Added: pkg/Rcpp/inst/examples/OpenMP/piWithInterrupts.cpp
===================================================================
--- pkg/Rcpp/inst/examples/OpenMP/piWithInterrupts.cpp (rev 0)
+++ pkg/Rcpp/inst/examples/OpenMP/piWithInterrupts.cpp 2011-04-27 13:58:47 UTC (rev 3023)
@@ -0,0 +1,134 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+
+#include <Rcpp.h>
+
+#ifdef _OPENMP
+#include <omp.h>
+#endif
+
+#include <R_ext/Utils.h>
+
+/**
+ * Base class for interrupt exceptions thrown when user
+ * interrupts are detected.
+ */
+class interrupt_exception : public std::exception {
+public:
+ /**
+ * Constructor.
+ * @param[in] message A description of event that
+ * caused this exception.
+ */
+ interrupt_exception(std::string message)
+ : detailed_message(message)
+ {};
+
+ /**
+ * Virtual destructor. Needed to avoid "looser throw specification" errors.
+ */
+ virtual ~interrupt_exception() throw() {};
+
+ /**
+ * Obtain a description of the exception.
+ * @return Description.
+ */
+ virtual const char* what() const throw() {
+ return detailed_message.c_str();
+ }
+
+ /**
+ * String with details on the error.
+ */
+ std::string detailed_message;
+};
+
+/**
+ * Do the actual check for an interrupt.
+ * @attention This method should never be called directly.
+ * @param[in] dummy Dummy argument.
+ */
+static inline void check_interrupt_impl(void* /*dummy*/) {
+ R_CheckUserInterrupt();
+}
+
+/**
+ * Call this method to check for user interrupts.
+ * This is based on the results of a discussion on the
+ * R-devel mailing list, suggested by Simon Urbanek.
+ * @attention This method must not be called by any other
+ * thread than the master thread. If called from within
+ * an OpenMP parallel for loop, make sure to check
+ * for omp_get_thread_num()==0 before calling this method!
+ * @return True, if a user interrupt has been detected.
+ */
+inline bool check_interrupt() {
+ return (R_ToplevelExec(check_interrupt_impl, NULL) == FALSE);
+}
+
+/**
+ * Compute pi using the Leibniz formula
+ * (a very inefficient approach).
+ * @param[in] n Number of summands
+ * @param[in] frequency Check for interrupts after
+ * every @p frequency loop cycles.
+ */
+RcppExport SEXP PiLeibniz(SEXP n, SEXP frequency)
+{
+ BEGIN_RCPP
+
+ // cast parameters
+ int n_cycles = Rcpp::as<int>(n);
+ int interrupt_check_frequency = Rcpp::as<int>(frequency);
+
+ // user interrupt flag
+ bool interrupt = false;
+
+ double pi = 0;
+#ifdef _OPENMP
+#pragma omp parallel for \
+ shared(interrupt_check_frequency, n_cycles, interrupt) \
+ reduction(+:pi)
+#endif
+ for (int i=0; i<n_cycles; i+=interrupt_check_frequency) {
+ // check for user interrupt
+ if (interrupt) {
+ continue;
+ }
+
+#ifdef _OPENMP
+ if (omp_get_thread_num() == 0) // only in master thread!
+#endif
+ if (check_interrupt()) {
+ interrupt = true;
+ }
+
+ // do actual computations
+ int j_end = std::min(i+interrupt_check_frequency, n_cycles);
+ for (int j=i; j<j_end; ++j) {
+ double summand = 1.0 / (double)(2*j + 1);
+ if (j % 2 == 0) {
+ pi += summand;
+ }
+ else {
+ pi -= summand;
+ }
+ }
+ }
+
+ // additional check, in case frequency was too large
+ if (check_interrupt()) {
+ interrupt = true;
+ }
+
+ // throw exception if interrupt occurred
+ if (interrupt) {
+ throw interrupt_exception("The computation of pi was interrupted.");
+ }
+
+ pi *= 4.0;
+
+ // result list
+ return Rcpp::wrap(pi);
+
+ END_RCPP
+}
More information about the Rcpp-commits
mailing list