[Rcpp-commits] r4556 - in pkg/Rcpp: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 3 18:34:50 CEST 2013
Author: jmc
Date: 2013-10-03 18:34:49 +0200 (Thu, 03 Oct 2013)
New Revision: 4556
Added:
pkg/Rcpp/R/classModule.R
pkg/Rcpp/man/classModule.Rd
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/NAMESPACE
pkg/Rcpp/R/RcppClass.R
pkg/Rcpp/R/loadModule.R
pkg/Rcpp/man/setRcppClass.Rd
Log:
New classModule() function, its documentation and small related changes
to setRcppClass and loadModule
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2013-10-03 12:00:23 UTC (rev 4555)
+++ pkg/Rcpp/ChangeLog 2013-10-03 16:34:49 UTC (rev 4556)
@@ -1,3 +1,12 @@
+2013-10-03 John M Chambers <jmc at r-project.org>
+
+ * R/classModule.R: new function to write module file for class
+ * man/classModule.Rd: documentation for new function classModule()
+ * NAMESPACE: export classModule
+ * R/loadModule.R: clean up an error message
+ * R/RcppClass.R: defaults for module consistent w. classModule()
+ * man/setRcppClass.Rd: add defaults, explain need for saveAs
+
2013-10-02 Dirk Eddelbuettel <edd at debian.org>
* inst/include/Rcpp/traits/is_na.h: More fixes thanks to Thomas Tse
Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE 2013-10-03 12:00:23 UTC (rev 4555)
+++ pkg/Rcpp/NAMESPACE 2013-10-03 16:34:49 UTC (rev 4556)
@@ -20,6 +20,7 @@
setRcppClass,
loadRcppClass,
loadModule,
+ classModule,
cppFunction,
evalCpp,
sourceCpp,
Modified: pkg/Rcpp/R/RcppClass.R
===================================================================
--- pkg/Rcpp/R/RcppClass.R 2013-10-03 12:00:23 UTC (rev 4555)
+++ pkg/Rcpp/R/RcppClass.R 2013-10-03 16:34:49 UTC (rev 4556)
@@ -37,7 +37,7 @@
}
loadRcppClass <- function(Class, CppClass = Class,
- module,
+ module = paste0("class_",Class),
fields = character(),
contains = character(),
methods = list(),
@@ -51,22 +51,15 @@
assign(saveAs, value, envir = where)
return(value)
}
- if(!missing(module)) {
- mod <- loadModule(module, NULL, env = where, loadNow = TRUE)
- storage <- get("storage", envir = as.environment(mod))
- if(exists(CppClass, envir = storage, inherits = FALSE)) {
- cppclassinfo <- get(CppClass, envir = storage)
- if(!is(cppclassinfo, "C++Class"))
- stop(gettextf("Object \"%s\" in module \"%s\" is not a C++ class description", CppClass, module))
- }
- else
- stop(gettextf("No object \"%s\" in module \"%s\"", CppClass, module))
- }
- else {
+ mod <- loadModule(module, NULL, env = where, loadNow = TRUE)
+ storage <- get("storage", envir = as.environment(mod))
+ if(exists(CppClass, envir = storage, inherits = FALSE)) {
+ cppclassinfo <- get(CppClass, envir = storage)
if(!is(cppclassinfo, "C++Class"))
- stop("If argument \"module\" is missing, CppClass must be a \"C++Class\" object")
- CppClass <- .CppClassName(cppclassinfo)
+ stop(gettextf("Object \"%s\" in module \"%s\" is not a C++ class description", CppClass, module))
}
+ else
+ stop(gettextf("No object \"%s\" in module \"%s\"", CppClass, module))
allmethods <- .makeCppMethods(methods, cppclassinfo, where)
allfields <- .makeCppFields(fields, cppclassinfo, where)
value <- setRefClass(Class, fields = allfields,
@@ -155,9 +148,10 @@
cat("Field \"", fi, "\":\n", sep = "")
methods::show(field(fi))
}
- }
- )
+ },
+ objectPointer = function()
+ .CppObject$.pointer
+ )
-## </Temporary:>
Added: pkg/Rcpp/R/classModule.R
===================================================================
--- pkg/Rcpp/R/classModule.R (rev 0)
+++ pkg/Rcpp/R/classModule.R 2013-10-03 16:34:49 UTC (rev 4556)
@@ -0,0 +1,197 @@
+.stdHeader <- c(
+ "#include <Rcpp.h>",
+ "using namespace Rcpp ;"
+ )
+
+.asString <- function(what) if(is.character(what)) what else deparse(what)
+
+.strings <- function(expr) {
+ if(is.call(expr) && ! identical(expr[[1]], quote(`::`)))
+ lapply(as.list(expr)[-1], .strings)
+ else
+ .asString(expr)
+}
+
+.specifyItems <- function(what) {
+ what <- as.list(what)
+ wn <- allNames(what)
+ simple <- !nzchar(wn)
+ ## todo: error checking here that unnamed elements are single strings
+ wn[simple] <- as.character(what[simple])
+ names(what) <- wn
+ what[simple] <- list(character())
+ what
+}
+
+.writeFieldFunction <- function(fldi, typei, CppClass, readOnly, ns, con){
+ rootName <- paste0("field_", fldi)
+ writeLines(sprintf(" %s %s_get(%s *obj) { return obj->%s; }\n",
+ typei, rootName, CppClass, fldi), con)
+ value <- "_get"
+ if(!readOnly) {
+ writeLines(sprintf(" void %s_set(%s *obj, %s value) { obj->%s = value; }\n",
+ rootName, CppClass, typei, fldi), con)
+ value <- c(value, "_set")
+ }
+ paste0(ns, "::field_", fldi, value)
+}
+
+.writeMethodFunction <- function(mdi, sigi, CppClass, ns, con) {
+ mName <- paste0("method_", mdi)
+ if(length(sigi) < 1)
+ stop(gettextf("The type signature for method %s for class %s was of length 0: Must at least include the return type",
+ mdi, CppClass))
+ rtnType <- sigi[[1]]
+ sigi <- sigi[-1]
+ if(length(sigi)) {
+ argNames <- paste0("a", seq_along(sigi))
+ args <- paste(" ,", paste(sigi, argNames, collapse = ", "))
+ }
+ else argNames <- args <- ""
+ writeLines(sprintf(" %s %s(%s *obj%s){ return obj->%s(%s); }\n",
+ rtnType, mName, CppClass, args, mdi, argNames), con)
+ paste0(ns, "::",mName)
+}
+
+classModule <- function(class, constructors, fields, methods,
+ file = paste0(CppClass, "Module.cpp"),
+ header = character(),
+ module = paste0("class_",class), CppClass = class,
+ readOnly = character(), rename = character(),
+ Rfile = TRUE) {
+ ## some argument checks
+ ## TODO: checks on constructors, fields, methods
+ if(length(readOnly)) {
+ readOnly <- as.character(readOnly)
+ if(!all(nzchar(readOnly)))
+ stop("argument readOnly should be a vector of non-empty strings")
+ }
+ newnames <- allNames(rename)
+ if(length(rename)) {
+ if(!all(sapply(rename, function(x) is.character(x) && length(x) == 1 && nzchar(x))))
+ stop("argument rename should be a vector of single, non-empty strings")
+ if(!all(nzchar(newnames)))
+ stop("all the elements of argument rename should be non-empty strings")
+ }
+ if(is.character(file)) {
+ ## are we in a package directory? Writable, searchable src subdirectory:
+ if(file.access("src",3)==0)
+ cfile <- file.path("src", file)
+ else
+ cfile <- file
+ con <- file(cfile, "w")
+ on.exit({message(sprintf("Wrote C++ file \"%s\"", cfile)); close(con)})
+ }
+ else
+ con <- file
+ ## and for the R code:
+ if(identical(Rfile, FALSE)) {}
+ else {
+ if(identical(Rfile, TRUE))
+ Rfile <- sprintf("%sClass.R",class)
+ if(is.character(Rfile)) {
+ if(file.access("R",3)==0) # in a package directory
+ Rfile <- file.path("R", Rfile)
+ Rcon <- file(Rfile, "w")
+ msg <- sprintf("Wrote R file \"%s\"",Rfile)
+ on.exit({message(msg); close(Rcon)}, add = TRUE)
+ }
+ else
+ Rcon <- Rfile
+ Rfile <- TRUE
+ }
+ temp <- tempfile()
+ mcon <- file(temp, "w")
+ writeLines(.stdHeader, con)
+ if(length(header))
+ writeLines(header, con)
+ writeLines(c("", sprintf("RCPP_MODULE(%s) {\n",module), ""), mcon)
+ writeLines(sprintf(" class_<%s>(\"%s\")\n", CppClass, class), mcon)
+
+ ## the constructors argument defines a list of vectors of types
+ for( cons in constructors) {
+ if(length(cons) > 1 ||
+ (length(cons) == 1 && nzchar(cons) && !identical(cons, "void")))
+ cons <- paste0("<", paste(cons, collapse = ","),">")
+ else
+ cons = ""
+ writeLines(paste0(" .constructor",cons,"()"),mcon)
+ }
+ writeLines("", mcon)
+ flds <- .specifyItems(fields)
+ nm <- names(flds)
+ rdOnly <- nm %in% readOnly
+ macros <- ifelse(rdOnly, ".field_readonly", ".field")
+ test <- nm %in% rename
+ if(any(test))
+ nm[test] <- newnames[match(nm[test], newnames)]
+ ns <- NULL
+ for(i in seq_along(nm)) {
+ typei <- flds[[i]]
+ nmi <- fldi <- nm[[i]]
+ macroi <- macros[[i]]
+ if(!length(typei) || identical(typei, "")) ## direct field
+ writeLines(sprintf(" %s(\"%s\", &%s::%s)",
+ macroi, nmi, CppClass, fldi), mcon)
+ else { # create a free function, e.g. for an inherited field
+ if(is.null(ns)) { # enclose in a namespace
+ ns <- paste("module",class,"NS", sep = "_")
+ writeLines(sprintf("\nnamespace %s {\n", ns),
+ con)
+ }
+ fldFuns <- .writeFieldFunction(fldi, typei, CppClass, rdOnly[[i]], ns, con)
+ if(rdOnly[[i]])
+ ## NOTE: string 3rd arg. required by problem w. module parsing 10/3/13
+ writeLines(sprintf(" .property(\"%s\", &%s, \"read-only field\")",
+ nmi, fldFuns[[1]]), mcon)
+ else
+ writeLines(sprintf(" .property(\"%s\", &%s, &%s)",
+ nmi, fldFuns[[1]], fldFuns[[2]]), mcon)
+ }
+ }
+ writeLines("", mcon)
+ sigs <- .specifyItems(methods)
+ nm <- mds <- names(sigs)
+ test <- nm %in% rename
+ if(any(test))
+ nm[test] <- newnames[match(nm[test], newnames)]
+ for(i in seq_along(nm)) {
+ sigi <- sigs[[i]]
+ nmi <- nm[[i]]
+ mdi <- mds[[i]]
+ if(!length(sigi) || identical(sigi, "")) # direct method
+ writeLines(sprintf(" .method(\"%s\", &%s::%s)",
+ nmi, CppClass, mdi), mcon)
+ else { # create a free function, e.g. for an inherited method
+ if(is.null(ns)) { # enclose in a namespace
+ ns <- paste("module",class,"NS", sep = "_")
+ writeLines(sprintf("\nnamespace %s {\n", ns),
+ con)
+ }
+ mFun <- .writeMethodFunction(mdi, sigi, CppClass, ns, con)
+ writeLines(sprintf(" .method(\"%s\", &%s)",
+ nmi, mFun), mcon)
+ }
+ }
+
+ writeLines(" ;\n}", mcon)
+ close(mcon)
+ if(!is.null(ns))
+ writeLines(sprintf("} // %s", ns), con) # close namespace
+ writeLines(readLines(file(temp, "r")), con)
+ if(Rfile) {
+ if(missing(CppClass))
+ CppString <- ""
+ else
+ CppString <- paste(",",dQuote(CppClass))
+ if(missing(module))
+ ModString <- ""
+ else
+ ModString <- paste(", module =", dQuote(module))
+ writeLines(sprintf("%s <- setRcppClass(\"%s\"%s%s)",
+ class, class, CppString,ModString), Rcon)
+ }
+}
+
+
+
Modified: pkg/Rcpp/R/loadModule.R
===================================================================
--- pkg/Rcpp/R/loadModule.R 2013-10-03 12:00:23 UTC (rev 4555)
+++ pkg/Rcpp/R/loadModule.R 2013-10-03 16:34:49 UTC (rev 4556)
@@ -74,7 +74,7 @@
if(is(loadM, "error")) {
if(.botched)
return(.DummyModule(module, what))
- stop(gettextf("Unable to load module \"%s\": %s (and not botched session)",
+ stop(gettextf("Unable to load module \"%s\": %s",
as(module, "character"), loadM$message))
}
if(!exists(metaName, envir = env, inherits =FALSE))
Added: pkg/Rcpp/man/classModule.Rd
===================================================================
--- pkg/Rcpp/man/classModule.Rd (rev 0)
+++ pkg/Rcpp/man/classModule.Rd 2013-10-03 16:34:49 UTC (rev 4556)
@@ -0,0 +1,205 @@
+\name{classModule}
+\alias{classModule}
+\title{
+Create an Rcpp Module to Expose a C++ Class in R
+}
+\description{
+The arguments specify a C++ class and some combination of
+constructors, fields and methods to be shared with \R by creating a
+corresponding reference class in \R.
+The information needed in the call to \code{classModule()} is the
+simplest possible in order to create a C++ module for the class; for
+example, fields and methods in this class need only be identified by
+their name.
+Inherited fields and methods can also be included, but more
+information is needed.
+The function writes a C++ source file,
+containing a module definition to expose the class to
+\R, plus one line of \R source to create the corresponding reference
+class.
+}
+
+\usage{
+classModule(class, constructors = , fields = , methods = , file = ,
+ header = , module = , CppClass = class, readOnly = , rename = ,
+ Rfile = TRUE)
+}
+
+\arguments{
+ \item{class}{
+The name of the class in \R. By default, this will be the same as the
+name of the class in C++, unless argument \code{CppClass} is supplied.
+}
+ \item{constructors}{
+A list of the signatures for any of the class constructors to be
+called from \R. Each element of the list gives the data types in C++
+for the arguments to the corresponding constructor. See Details and
+the example.
+}
+ \item{fields, methods}{
+The vector of names for the fields and for the methods to be exposed
+in \R. For inherited fields and methods, type information needs to be
+supplied; see the section \dQuote{Inherited Fields and Methods}.
+}
+ \item{file}{
+Usually, the name for the file on which to write the C++ code, by default
+\code{paste0(CppClass, "Module.cpp")}.
+If the current working directory in \R is the top-level
+directory for a package, the function writes the file in the
+\code{"src"} subdirectory.
+Otherwise the file is written in the working directory.
+
+The argument may also be a connection, already open for writing.
+
+}
+ \item{header}{
+Whatever lines of C++ header information are needed to include the
+definition of the class. Typically this includes a file from the
+package where we are writing the module definition, as in the example below.
+}
+ \item{module}{
+The name for the Rcpp module, by default
+\code{paste0("class_",CppClass)}.
+}
+ \item{CppClass}{
+The name for the class in C++. By default and usually, the intended
+class name in \R.
+}
+ \item{readOnly}{
+Optional vector of field names. These fields will be created as
+read-only in the interface.
+}
+ \item{rename}{
+Optional named character vector, used to name fields or methods
+differently in \R from their C++ name. The elements of the vector are
+the C++ names and the corresponding elements of \code{names(rename)}
+the desired names in \R. So \code{c(.age = "age")} renames the C++
+field or method \code{age} as \code{.age}.
+}
+ \item{Rfile}{
+Controls the writing of a one-line \R command to create the reference
+class corresponding to the C++ module information. By default, this
+will be a file \code{paste0(class, "Class.R")}.
+If the working directory is an \R package source
+directory, the file will be written in the \code{R} subdirectory, otherwise in the working directory itself.
+
+Supplying a character string substitutes that file name for the
+default.
+
+The argument may also be a connection open for
+writing or \code{FALSE} to suppress writing the \R source altogether.
+}
+}
+
+\details{
+The file created by the call to these functions only depends on the
+information in the C++ class supplied. This file is intended to be
+part of the C++ source for an \R package. The file only needs to
+modified when the information changes, either because the class has
+changed or because you want to expose different information to \R. In
+that case you can either recall \code{classModule()} or edit the C++
+file created.
+
+The Rcpp Module mechanism has a number of other optional techniques,
+not covered by \code{classModule()}. These should be entered into the
+C++ file created. See the \dQuote{rcpp-modules} vignette with the
+package for current possibilities.
+
+For fields and methods specified directly in the C++ class,
+the fields and method arguments to \code{classModule()} are character vectors naming the
+corresponding members of the class. For module construction, the
+data types of directly specified fields and of the arguments for the methods are not
+needed.
+
+For \emph{inherited} fields or methods, data type information is
+needed. See the section \dQuote{Inherited Fields and Methods}.
+
+For exposing class constructors, the module needs to know the
+signatures of the constructors to be exposed; each signature is a
+character vector of the corresponding C++ data types.
+
+}
+
+\section{Inherited Fields and Methods}{
+If the C++ class inherits from one or more other classes, the standard
+Rcpp \code{Module} mechanism can not be used to expose inherited
+fields or methods.
+An indirect mechanism is used, generating free functions in C++ to
+expose the inherited members in \R.
+
+This mechanism requires data type information in the call to
+\code{classModule()}.
+This is provided by naming the corresponding element of the
+\code{fields} or \code{methods} argument with the name of the member.
+The actual element of the \code{fields} argument is then the single
+data type of the field.
+
+For the \code{methods} argument the argument will generally need to be
+a named list.
+The corresponding element of the list is the vector of data types for
+the return value and for the arguments, if any, to the method.
+For example, if C++ method \code{foo()} took a single argument of type
+\code{NumericVector} and returned a value of type \code{long}, the
+\code{methods} argument would be \code{list(foo = c("long",
+ "NumericVector"))}.
+
+See the second example below.
+}
+\value{
+Nothing, called for its side effect.
+}
+\author{
+ John Chambers
+}
+\seealso{
+\code{\link{setRcppClass}}, which must be called from some \R source
+in the package.
+}
+\examples{
+\dontrun{
+### Given the following C++ class, defined in file PopBD.h,
+### the call to classModule() shown below will write a file
+### src/PopBDModule.cpp containing a corresponding module definition.
+### class PopBD {
+### public:
+### PopBD(void);
+### PopBD(NumericVector initBirth, NumericVector initDeath);
+###
+### std::vector<double> birth;
+### std::vector<double> death;
+### std::vector<int> lineage;
+### std::vector<long> size;
+### void evolve(int);
+###
+### };
+### A file R/PopBDClass.R will be written containing the one line:
+### PopBD <- setRcppClass("PopBD")
+###
+### The call below exposes the lineage and size fields, read-only,
+### and the evolve() method.
+
+classModule("PopBD",
+ constructors =
+ list("", c("NumericVector", "NumericVector")),
+ fields = c("lineage", "size"),
+ methods = "evolve",
+ header = '#include "PopBD.h"',
+ readOnly = c("lineage", "size"))
+
+### Example with inheritance: the class PopCount inherits from
+### the previous class, and adds a method table(). It has the same
+### constructors as the previous class.
+### To expose the table() method, and the inherited evolve() method and size field:
+
+classModule("PopCount",
+ constructors =
+ list("", c("NumericVector", "NumericVector")),
+ fields = c(size = "std::vector<long>"),
+ methods = list("table", evolve = c("void", "int")),
+ header = '#include "PopCount.h"',
+ readOnly = "size")
+}
+}
+
+\keyword{ programming }
+\keyword{ classes }
Modified: pkg/Rcpp/man/setRcppClass.Rd
===================================================================
--- pkg/Rcpp/man/setRcppClass.Rd 2013-10-03 12:00:23 UTC (rev 4555)
+++ pkg/Rcpp/man/setRcppClass.Rd 2013-10-03 16:34:49 UTC (rev 4556)
@@ -7,14 +7,15 @@
}
\description{
A class is defined that includes the fields and methods of a C++ class
-defined, usually in this package. The \R{} class can include new
-methods and fields, such as for prototyping new computations for the
-C++ class.
+defined, usually in this package. For most applications, it is
+recommended to call
+\code{\link{classModule}()} to write files in the package with a call to \code{setRcppClass()} and the
+C++ module code required. See Details.
}
\usage{
-setRcppClass(Class, CppClass, module, fields = list(), contains = ,
+setRcppClass(Class, CppClass = , module = , fields = list(), contains = ,
methods = , saveAs = Class, where = , ...)
-loadRcppClass(Class, CppClass, module, fields = character(),
+loadRcppClass(Class, CppClass = , module = , fields = character(),
contains = character(),
methods = , saveAs = Class, where = , ...)
}
@@ -30,19 +31,30 @@
\item{module}{
The Rcpp module in which the class is defined. The module does not
have to be loaded separately; \code{setRcppClass()} will arrange to
-load the module.
+load the module. By default, \code{"class_"} followed by the C++ class
+name.
}
\item{fields, contains, methods}{
Additional fields, superclasses and method definitions in \R{} that
extend the C++ class. These arguments are passed on to
\code{\link{setRefClass}()}.
-See Details for the implementation of methods.
+See Details for recommendations.
}
\item{saveAs}{
Save a generator object for the class in the package's namespace under
this name. By default, the generator object has the name of the
class. To avoid saving any generator object, supply this argument as
\code{NULL}.
+
+(This argument is currently needed because the actual class definition
+must take place at package load time, to include C++ pointer
+information.
+Therefore the
+value returned by \code{setRcppClass()} when called during package
+installation is not the generator object returned by
+\code{setRefClass()}.
+We may be able to hack
+around this problem in the future.)
}
\item{where}{
The environment in which to save the class definition. By default,
More information about the Rcpp-commits
mailing list