Nothing
##' Rcpp Apply Generator
##'
##' Use this function as a generator for your own \code{apply} functions;
##' that is, functions you would like to apply over rows or columns of a
##' matrix.
##'
##' @importFrom Rcpp sourceCpp
##' @param fun A character string defining the C++ function. It must be
##' in terms of a variable \code{x}, and it must return a \code{double}.
##' \code{x} is a reference to the current row/column being iterated over.
##' @param includes Other C++ libraries to include. For example, to include boost/math.hpp,
##' you could pass c("<boost/math.hpp>"). Rcpp is included by default, unless RcppArmadillo
##' is included as well (since Rcpp is included as part of the RcppArmadillo include)
##' @param depends Other libraries to link to. Linking is done through Rcpp attributes.
##' @param inline boolean; mark this function as inline? This may or may not
##' increase execution speed.
##' @param returnType The return type of your function; must be a scalar that
##' is \code{wrap}pable by Rcpp. Currently, the supported choices are \code{double},
##' \code{int}, and \code{bool}.
##' @param name An internal name for the function.
##' @param file A location to output the file. Defaults to a temporary
##' file as generated by \code{\link{tempfile}()}.
##' @param additional Other C++ code you want to include; e.g. helper functions.
##' This code will be inserted as-is above the code in \code{fun}.
##' @export
##' @examples \dontrun{
##' x <- matrix(1:16, nrow=4)
##' cvApply <- rcpp_apply_generator("return mean(x) / sd(x);")
##' squaredSumApply <- rcpp_apply_generator("
##' double out = 0;
##' for( int i=0; i < x.size(); i++ ) {
##' out += x[i];
##' }
##' out = out*out;
##' return out;
##' ")
##' cvApply(x, 2)
##' apply(x, 2, mean) / apply(x, 2, sd)
##' if( require(microbenchmark) ) {
##' f <- function(x) { mean(x) / sd(x) }
##' microbenchmark( cvApply(x, 2), apply(x, 2, f) )
##' }
##' ## example with bool
##' anyBig <- rcpp_apply_generator( returnType="bool", '
##' return is_true( any( x > 10 ) );
##' ')
##' anyBig(x, 2)
##' anyBig(x, 1)
##' ## example with boost's gcd. silly but demonstrative.
##' ## intended to be applied to matrices with 2 rows and n columns
##' gcdApply <- rcpp_apply_generator( returnType="int",
##' includes="<boost/math/common_factor.hpp>",
##' fun='
##' return boost::math::gcd( (int)x[0], (int)x[1] );
##' ')
##' M <- matrix( c(4, 6, 20, 25, 10, 100), nrow=2 )
##' gcdApply(M, 2)
##' }
rcpp_apply_generator <- function( fun,
includes=NULL,
depends=NULL,
inline=TRUE,
returnType="double",
name=NULL,
file=NULL,
additional=NULL ) {
if( getRversion() < "2.15.1" ||
packageVersion("Rcpp") < "0.10.1"
) {
message("Error: This function requires Rcpp > 0.10.1 and R > 2.15.1")
return( invisible(NULL) )
}
## generate a C++ source file based on 'fun'
if( is.null(file) ) {
cpp_source <- paste( sep="", tempfile(), ".cpp" )
} else {
if( length( grep( "\\.cpp", file ) ) == 0 ) {
file <- paste( sep="", file, ".cpp" )
}
cpp_source <- file
}
cat("C++ source code will be written to", cpp_source, ".\n")
## an environment for the cppSource-exported functions to live in
cpp_env <- new.env()
## internal name for the function
if( is.null(name) ) {
name <- paste( collapse="",
sample( c(letters, LETTERS), size=20, replace=TRUE)
)
}
## open a connection to the file, and ensure we close it after
conn <- file( cpp_source, 'w' )
on.exit( close(conn) )
## determine the Rcpp return type
rcpp_returnType <- switch( returnType,
double="NumericVector",
int="IntegerVector",
bool="LogicalVector",
warning("unrecognized return type")
)
## process the 'depends' argument
include_Rcpp <- TRUE
if( !is.null(depends) ) {
if( "RcppArmadillo" %in% depends ) {
include_Rcpp <- FALSE
}
depends <- paste("// [[Rcpp::depends(", paste(depends, collapse=", "), ")]]",
sep="" )
depends <- paste( sep="", depends, "\n" )
}
## process the 'includes' argument
if( !is.null(includes) ) {
includes <- paste( paste("#include", includes), collapse="\n" )
includes <- paste( includes, "\n", sep="" )
}
## 'cat' our source code out to a file, to later be sourced
cat( file=conn, sep="", paste( sep="", collapse="",
depends,
if( include_Rcpp ) "#include <Rcpp.h>\n",
includes, "\n",
"using namespace Rcpp;\n",
additional,
"\n",
"inline ", returnType, " do_", name, "( const NumericMatrix::Column& x ) {\n", fun, "\n }
// [[Rcpp::export]]
", rcpp_returnType, " ", name, "( NumericMatrix& X ) {
int nCols = X.ncol();
", rcpp_returnType, " out = no_init(nCols);
for( int j=0; j < nCols; j++ ) {
NumericMatrix::Column tmp = X(_, j);
out[j] = do_", name, "( tmp );
}
return out;
}") )
## source the file into the 'cpp_env' environment
cat("Compiling...\n")
sourceCpp( cpp_source, env=cpp_env )
cat("Done!")
## return a function that exposes the compiled code to the user
return( function(X, dim) {
force( cpp_source )
if( dim == 1 ) {
X <- t(X)
}
call <- call(name, X)
return( eval( call, envir=cpp_env) )
})
}
##' @rdname rcpp_apply_generator
##' @export
Rcpp_apply_generator <- rcpp_apply_generator
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.