[Rd] Implementing a "plugin" paradigm with R methods

[Martin Morgan]

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