[Rd] Implementing a "plugin" paradigm with R methods
Janko Thyson
janko.thyson.rstuff at googlemail.com
Wed Aug 24 18:18:08 CEST 2011
Hi Martin,
thanks a lot again for your suggestions! I played around a bit with it
today and this is the solution that I like the most.
The main extensions compared to your code are:
1) Using Reference Classes (I don't know, but I just like them somehow ;-))
1) Basing method dispatch for plugin methods on multiple signature
arguments to ensure transparency/minimize the risk of name clashes for
plugins
2) Hide as much definition details for signature argument classes from
the user as possible (see 'apiClassesEnsure()' and 'pluginObjectCreate()')
One neat thing would be to get around the warnings when defining plugin
methods ('apiClassesEnsure()' which takes care of setting formal classes
for signature arguments is called at 'run time' when calling
'foo()', so the formal classes are not there yet). But I guess I just
have to turn them off temporarily when sourcing in methods from a directory.
It'd be cool if you could tell me what you think of that approach!
Regards,
Janko
#-------------------------------------------------------------------------------
# APPROACH 6 r-devel
#-------------------------------------------------------------------------------
# Set system environments
.HIVE <- new.env()
.HIVE$.protected <- new.env()
.HIVE$.protected$classes <- new.env()
#+++++
# Define plugin class providing all necessary signature arguments for
method
# dispatch of plugin methods
setRefClass("Plugin",
fields=list(
ns="character", # Namespace
link="character", # Name of the function/method for which the
plugin is intended
mount="character", # 'Mounting point' within the link
function. Possibly the linked function can be open for plugins at
different 'sections'
plugin="character", # Name of the plugin method
src="character" # Main input for plugin method
),
methods=list(
# Processes plugins based on fields signature fields above
pluginProcess=function(...){
pluginProcessRef(.self=.self, ...)
}
)
)
#+++++
# Define a function that takes care of 'registering' the classes needed for
# the signature fields above in order to follow a clean method dispatch
# paradigm based on formal classes
apiClassesEnsure <- function(src, do.overwrite=FALSE,...){
out <- sapply(src, function(x.src){
if(!isClass(x.src)){
x.src <- paste("API_", x.src, sep="")
}
if( !exists(x.src, envir=.HIVE$.protected$classes,
inherits=FALSE) |
do.overwrite
){
cat(paste("apiClassesEnsure/assigning class '", x.src,
"' to '.HIVE$.protected$classes'", sep=""), sep="\n")
if(!isClass(x.src)){
expr <- substitute(
setClass(
Class=CLASS,
contains="NULL",
where=ENVIR
),
list(CLASS=x.src, ENVIR=.HIVE$.protected$classes)
)
eval(expr)
eval(substitute(
assign(CLASS, expr, envir=ENVIR),
list(CLASS=x.src, ENVIR=.HIVE$.protected$classes)
))
} else {
eval(substitute(
assign(CLASS, CLASS, envir=ENVIR),
list(CLASS=x.src, ENVIR=.HIVE$.protected$classes)
))
}
}
out <- x.src
return(out)
})
return(out)
}
#+++++
# Define a function that creates plugin objects
pluginObjectCreate <- function(ns=NULL, link=NULL, mount=NULL, plugin=NULL,
src=NULL, do.overwrite=FALSE){
out <- new("Plugin")
out$initFields(
ns=apiClassesEnsure(src=ns, do.overwrite=do.overwrite),
link=apiClassesEnsure(src=link, do.overwrite=do.overwrite),
mount=apiClassesEnsure(src=mount, do.overwrite=do.overwrite),
plugin=apiClassesEnsure(src=plugin, do.overwrite=do.overwrite),
src=src
)
apiClassesEnsure(src=class(src), do.overwrite=do.overwrite)
return(out)
}
pluginObjectCreate()
pluginObjectCreate()$ns
pluginObjectCreate()$link
pluginObjectCreate()$pluginProcess
#+++++
# Set generics
setGeneric(name="pluginProcessRef", signature=c(".self"),
function(.self, ...) standardGeneric("pluginProcessRef")
)
setGeneric(name="pluginExecute",
signature=c("ns", "link", "mount", "plugin", "src"),
function(ns, link, mount, plugin, src, ...)
standardGeneric("pluginExecute")
)
#+++++
# Set method for 'pluginProcessRef'.
# The method has two modi operandi:
# 1) 'do.explicit.clss = FALSE' implies that plugin methods have been
defined
# based on the 'unprocessed' class names for signature arguments, i.e.
# 'signature(ns="mypkg", link="foo", mount="default", plugin="punct",
# src="character")'
# instead of
# 'signature(ns="API_mypkg", link="API_foo", mount="API_default",
# plugin="API_punct", src="character")'
# 2) 'do.explicit.clss = TRUE' implies the use of the 'processed' class
names
setMethod(
f=pluginProcessRef,
signature=c(.self="Plugin"),
function(.self, do.explicit.clss=FALSE, ...){
out <- NULL
if(length(.self$ns)){
if(!do.explicit.clss){
rgx.subst <- "API_"
ns <- gsub(rgx.subst, "", .self$ns)
names(ns) <- NULL
link <- gsub(rgx.subst, "", .self$link)
names(link) <- NULL
mount <- gsub(rgx.subst, "", .self$mount)
names(mount) <- NULL
plugin <- gsub(rgx.subst, "", .self$plugin)
names(plugin) <- NULL
if(!existsMethod(
f="pluginExecute",
signature=c(ns=ns, link=link, mount=mount,
plugin=plugin,
src=class(.self$src))
)){
stop("Invalid plugin")
}
.pluginExecute <- selectMethod(
"pluginExecute",
signature=c(ns=ns, link=link, mount=mount,
plugin=plugin,
src=class(.self$src)),
useInherited=c(ns=FALSE, link=FALSE, mount=FALSE,
plugin=FALSE,
src=TRUE)
)
out <- .pluginExecute(src=.self$src)
} else {
out <- pluginExecute(ns=new(.self$ns),
link=new(.self$link),
mount=new(.self$mount), plugin=new(.self$plugin),
src=.self$src)
}
}
return(out)
}
)
#+++++
# Define the actual plugin methods. For illustration, one using a implicit
# and the other using explicit class names notation for signature arguments.
# Unfortunately I don't know how to avoid warnings at this point; guess
I can't
setMethod(f=pluginExecute, signature=c(ns="mypkg", link="objectModify",
mount="default", plugin="punct",src="character"),
function(ns, link, mount, plugin, src, ...){
out <- gsub("[[:punct:]]", "", src)
}
)
setMethod(f=pluginExecute, signature=c(ns="API_mypkg",
link="API_objectModify",
mount="API_default", plugin="API_digit", src="character"),
function(ns, link, mount, plugin, src, ...){
out <- gsub("[[:digit:]]", "", src)
}
)
showMethods("pluginExecute")
#+++++
# Define the function/method that should be open for plugins
foo <- function(plugin=pluginObjectCreate(), do.explicit.clss=FALSE, ...){
cat("Here: computations before plugin", sep="\n")
cat(paste("Calling plugin '", class(plugin), "'", sep=""), sep="\n")
out <- plugin$pluginProcess(do.explicit.clss=do.explicit.clss)
cat("Here: computations after plugin", sep="\n")
return(out)
}
#+++++
# Apply
foo()
foo( plugin=pluginObjectCreate(ns="mypkg", link="objectModify",
mount="default",
plugin="punct", src="string___123"))
foo(plugin=pluginObjectCreate(ns="mypkg", link="objectModify",
mount="default",
plugin="digit", src="string123"))
# No such plugin method as explicit class names have been used for 'digit
foo(plugin=pluginObjectCreate(ns="mypkg", link="objectModify",
mount="default",
plugin="digit", src="string123"), do.explicit.clss=TRUE)
# /APPROACH 6 r-devel ----------
On 24.08.2011 06:37, Martin Morgan wrote:
> On 08/23/2011 03:02 PM, Janko Thyson wrote:
>> Dear list,
>>
>> I was wondering how to best implement some sort of a "plugin" paradigm
>> using R methods and the dispatcher:
>> Say we have a function/method ('foo') that does something useful, but
>> that should be open for extension in ONE specific area by OTHERS using
>> my package. Of course they could go ahead and write a whole new 'foo'
>
> One possibility is to write class / method pairs. The classes extend
> 'Plugin', and the methods are on generic 'plug', with the infrastructure
>
> ## Approach 1: class / method pairs
> setClass("Plugin")
>
> setClass("DefaultPlugin", contains="Plugin")
>
> DefaultPlugin <- function() new("DefaultPlugin")
>
> setGeneric("plug",
> function(plugin, src) standardGeneric("plug"),
> signature="plugin",
> valueClass="character")
>
> setMethod(plug, "Plugin", function(plugin, src) {
> src
> })
>
> foo <- function(src, plugin=DefaultPlugin()) {
> plug(plugin, src)
> }
>
> This is extended by writing class / method pairs
>
> setClass("Punct", contains="Plugin")
>
> Punct <- function() new("Punct")
>
> setMethod(plug, "Punct", function(plugin, src) {
> gsub("[[:punct:]]", "", src)
> })
>
>
> setClass("Digit", contains="Plugin")
>
> Digit <- function() new("Digit")
>
> setMethod(plug, "Digit", function(plugin, src) {
> gsub("[[:digit:]]", "", src)
> })
>
> The classes could have slots with state, accessible within the method.
> An easier-on-the-user approach might have the Plugin class contain or
> have slots of class "function". The user would only be obliged to
> provide an appropriate function.
>
> ## Approach 2:
> setClass("Plugin", prototype=prototype(function(src) {
> src
> }), contains="function")
>
> Plugin <- function() new("Plugin")
>
> setGeneric("foo",
> function(src, plugin) standardGeneric("foo"))
>
> setMethod(foo, c("character", "missing"),
> function(src, plugin) foo(src, Plugin()))
>
> setMethod(foo, c("character", "Plugin"),
> function(src, plugin) plugin(src))
>
> ## 'Developer' classes
> setClass("Punct", prototype=prototype(function(src) {
> gsub("[[:punct:]]", "", src)
> }), contains="Plugin")
>
> Punct <- function() new("Punct")
>
> setClass("Digit", prototype=prototype(function(src) {
> gsub("[[:digit:]]", "", src)
> }), contains="Plugin")
>
> Digit <- function() new("Digit")
>
> ## General-purpose 'user' class
> setClass("User", contains="Plugin")
>
> User <- function(fun) new("User", fun)
>
> This could have syntax checking in the validity method to catch some
> mistakes early. In the S3 world, this is the approach taken by glm for
> its 'family' argument, for instance str(gaussian().
>
> Martin
>
>> method including the features they'd like to see, but that's not really
>> necessary. Rather, they should be able to just write a new "plugin"
>> method for that part of 'foo' that I'd like to open for such plugins.
>>
>> The way I chose below works, but generates warnings as my method has
>> signature arguments that don't correspond to formal classes (which is
>> totally fine). Of course I could go ahead and make sure that such
>> "dummy" classes exist, but I was wondering if there's a better way.
>>
>> It'd be great if anyone could let me know how they handle "plugin"
>> scenarios based on some sort of method dispatch!
>>
>> Thanks,
>> Janko
>>
>> ##### CODE EXAMPLE #####
>>
>> setGeneric(name="foo", signature=c("src"), function(src, ...)
>> standardGeneric("foo"))
>> setGeneric(name="plugin", signature=c("src", "link", "plugin"),
>> function(src, link, plugin, ...) standardGeneric("plugin")
>> )
>> setMethod(f="plugin", signature=signature(src="character", link="foo",
>> plugin="punct"),
>> function(src, link, plugin, ...){
>> out <- gsub("[[:punct:]]", "", src)
>> return(out)
>> }
>> )
>> setMethod(f="plugin", signature=signature(src="character", link="foo",
>> plugin="digit"),
>> function(src, link, plugin, ...){
>> out <- gsub("[[:digit:]]", "", src)
>> return(out)
>> }
>> )
>> setMethod(f="foo", signature=signature(src="character"),
>> function(src, plugin=NULL, ...){
>> if(!is.null(plugin)){
>> if(!existsMethod(f="plugin",
>> signature=c(src=class(src), link="foo", plugin=plugin)
>> )){
>> stop("Invalid plugin")
>> }
>> .plugin <- selectMethod(
>> "plugin",
>> signature=c(src=class(src), link="foo", plugin=plugin),
>> useInherited=c(src=TRUE, plugin=FALSE)
>> )
>> out <- .plugin(src=src)
>> } else {
>> out <- paste("Hello world: ", src, sep="")
>> }
>> return(out)
>> }
>> )
>> foo(src="Teststring:-1234_56/")
>> foo(src="Teststring:-1234_56/", plugin="punct")
>> foo(src="Teststring:-1234_56/", plugin="digit")
>>
>> ______________________________________________
>> R-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
>
>
More information about the R-devel
mailing list