Implementing a "plugin" paradigm with R methods

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")