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

From: Martin Morgan <mtmorgan_at_fhcrc.org>
Date: Tue, 23 Aug 2011 21:37:08 -0700

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

______________________________________________
R-devel_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
Received on Wed 24 Aug 2011 - 04:39:29 GMT

This quarter's messages: by month, or sorted: [ by date ] [ by thread ] [ by subject ] [ by author ]

All messages

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Thu 25 Aug 2011 - 15:40:26 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.

list of date sections of archive