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
--
Computational Biology
Fred Hutchinson Cancer Research Center
1100 Fairview Ave. N. PO Box 19024 Seattle, WA 98109
Location: M1-B861
Telephone: 206 667-2793