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@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
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
