R devel - Jan 2015 - [Q] Get formal arguments of my implemented S4 method

On Jan 28, 2015, at 6:37 PM, Michael Lawrence <lawrence.michael at
gene.com> wrote:
> At this point I would just due:
> 
> formals(body(method)[[2L]])
> 
> At some point we need to figure out what to do with this .local()
confusion.
Agreed, definitely.  The current hack is to avoid re-matching arguments on
method dispatch, so a fix would need to be fairly deep in the implementation.

But I don't think the expression above is quite right. body(method)[[2L]] is
the assignment.  You need to evaluate the rhs.

Here is a function that does the same sort of thing, and returns the standard
formals for the generic if this method does not have nonstandard arguments.  We
should probably add a version of this function for 3.3.0, so user code
doesn't have hacks around the current hack.

methodFormals <- function(f, signature = character()) {
    fdef <- getGeneric(f)
    method <- selectMethod(fdef, signature)
    genFormals <- base::formals(fdef)
    b <- body(method)
    if(is(b, "{") && is(b[[2]], "<-") &&
identical(b[[2]][[2]], as.name(".local"))) {
        local <- eval(b[[2]][[3]])
        if(is.function(local))
            return(formals(local))
        warning("Expected a .local assignment to be a function. Corrupted
method?")
    }
    genFormals
}
> 
> 
> 
> 
> On Wed, Jan 28, 2015 at 10:07 AM, Roebuck,Paul L <PLRoebuck at
mdanderson.org>
> wrote:
> 
>> I'm attempting to reflect the information for use with
corresponding
>> fields in GUI (in a different package), to provide default values,
>> argname as key for UI label lookups, etc.
>> 
>> So I want something much more like the formals of the implementation:
>> 
>> {
>>    "object",
>>    "method":             c("median",
"vs", "tukey"),
>>    "calc.medians":       TRUE,
>>    "sweep.cols":         calc.medians,
>>    "recalc.after.sweep": sweep.cols,
>>    "?"
>> }
>> 
>> not those of the generic:
>> 
>> {
>>    "object",
>>    "?"
>> }
>> 
>> 
>> From:  Michael Lawrence <lawrence.michael at gene.com>
>> Date:  Wednesday, January 28, 2015 11:28 AM
>> To:  "Roebuck,Paul L" <PLRoebuck at mdanderson.org>
>> Cc:  R-devel <r-devel at r-project.org>
>> Subject:  Re: [Rd] [Q] Get formal arguments of my implemented S4 method
>> 
>> 
>> Would you please clarify your exact use case?
>> 
>> 
>> Thanks,
>> Michael
>> 
>> 
>> On Wed, Jan 28, 2015 at 9:02 AM, Roebuck,Paul L
>> <PLRoebuck at mdanderson.org> wrote:
>> 
>> Interrogating some (of my own) code in another package.
>> 
>>> norm.meth <- getMethod("normalize",
"MatrixLike")
>>> message("str(norm.meth)")
>>> str(norm.meth)
>> 
>>> message("show(norm.meth at .Data)")
>>> show(norm.meth at .Data)
>> 
>> 
>> Last show() displays this:
>> 
>> function (object, ...)
>> {
>>    .local <- function (object, method = c("median",
"vs", "tukey"),
>>        calc.medians = TRUE, sweep.cols = calc.medians,
>>        recalc.after.sweep = sweep.cols, ...)
>>    {
>>        .do_normalize(object,
>>            method = match.arg(method),
>>            calc.medians = calc.medians,
>>            sweep.cols = sweep.cols,
>>            recalc.after.sweep = recalc.after.sweep,
>>            ...)
>>    }
>>    .local(object, ...)
>> }
>> 
>> 
>> Desire to be able to access formals() for the .local() function
definition,
>> not the generic one. Have seen information desired available via
"defined"
>> slot of returned 'MethodDefinition' object, but not using the
code below.
>> 
>> 
>> 
>> ===================>> 
>> library(methods)
>> 
>> if (!isGeneric("normalize")) {
>>    ## Other packages also define this generic...
>>    setGeneric("normalize",
>>               function(object, ...)
standardGeneric("normalize"))
>> }
>> 
>> setClassUnion("MatrixLike", c("matrix",
"data.frame"))
>> 
>> .do_normalize <- function(concs,
>>                          method,
>>                          calc.medians,
>>                          sweep.cols,
>>                          recalc.after.sweep,
>>                          ...) {
>>    message("internal routine called!")
>>    NULL
>> }
>> 
>> setMethod("normalize",
signature(object="MatrixLike"),
>>          function(object,
>>                   method=c("median", "vs",
"tukey"),
>>                   calc.medians=TRUE,
>>                   sweep.cols=calc.medians,
>>                   recalc.after.sweep=sweep.cols,
>>                   ...) {
>> 
>>    .do_normalize <- function(object,
>>                            method=match.arg(method),
>>                            calc.medians=calc.medians,
>>                            sweep.cols=sweep.cols,
>>                            recalc.after.sweep=recalc.after.sweep,
>>                            ...)
>> }
>> 
>> ______________________________________________
>> R-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
>> 
>> 
>> 
>> 
>> 
>> 
> 
> 	[[alternative HTML version deleted]]
> 
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel

	[[alternative HTML version deleted]]

On Thu, Jan 29, 2015 at 5:57 AM, John Chambers <jmc at r-project.org>
wrote:
>
> On Jan 28, 2015, at 6:37 PM, Michael Lawrence <lawrence.michael at
gene.com>
> wrote:
>
> At this point I would just due:
>
> formals(body(method)[[2L]])
>
> At some point we need to figure out what to do with this .local()
> confusion.
>
>
> Agreed, definitely.  The current hack is to avoid re-matching arguments on
> method dispatch, so a fix would need to be fairly deep in the
> implementation.
>
> But I don't think the expression above is quite right.
body(method)[[2L]]
> is the assignment.  You need to evaluate the rhs.
>
>
Sorry, thanks for the catch.

> Here is a function that does the same sort of thing, and returns the
> standard formals for the generic if this method does not have nonstandard
> arguments.  We should probably add a version of this function for 3.3.0, so
> user code doesn't have hacks around the current hack.
>
> methodFormals <- function(f, signature = character()) {
>     fdef <- getGeneric(f)
>     method <- selectMethod(fdef, signature)
>     genFormals <- base::formals(fdef)
>     b <- body(method)
>     if(is(b, "{") && is(b[[2]], "<-")
&& identical(b[[2]][[2]], as.name(".local")))
> {
>         local <- eval(b[[2]][[3]])
>         if(is.function(local))
>             return(formals(local))
>         warning("Expected a .local assignment to be a function.
Corrupted
> method?")
>     }
>     genFormals
> }
>
>
Yea, I had thought about having that, or a more general getMethodFunction()
on which formals() could be called. I held back though, because I thought
it might be best to address the .local issue, instead of introducing
additional API components that would otherwise be unnecessary.

>
>
>
> On Wed, Jan 28, 2015 at 10:07 AM, Roebuck,Paul L <PLRoebuck at
mdanderson.org
> >
> wrote:
>
> I'm attempting to reflect the information for use with corresponding
> fields in GUI (in a different package), to provide default values,
> argname as key for UI label lookups, etc.
>
> So I want something much more like the formals of the implementation:
>
> {
>    "object",
>    "method":             c("median", "vs",
"tukey"),
>    "calc.medians":       TRUE,
>    "sweep.cols":         calc.medians,
>    "recalc.after.sweep": sweep.cols,
>    "?"
> }
>
> not those of the generic:
>
> {
>    "object",
>    "?"
> }
>
>
> From:  Michael Lawrence <lawrence.michael at gene.com>
> Date:  Wednesday, January 28, 2015 11:28 AM
> To:  "Roebuck,Paul L" <PLRoebuck at mdanderson.org>
> Cc:  R-devel <r-devel at r-project.org>
> Subject:  Re: [Rd] [Q] Get formal arguments of my implemented S4 method
>
>
> Would you please clarify your exact use case?
>
>
> Thanks,
> Michael
>
>
> On Wed, Jan 28, 2015 at 9:02 AM, Roebuck,Paul L
> <PLRoebuck at mdanderson.org> wrote:
>
> Interrogating some (of my own) code in another package.
>
> norm.meth <- getMethod("normalize", "MatrixLike")
> message("str(norm.meth)")
> str(norm.meth)
>
>
> message("show(norm.meth at .Data)")
> show(norm.meth at .Data)
>
>
>
> Last show() displays this:
>
> function (object, ...)
> {
>    .local <- function (object, method = c("median",
"vs", "tukey"),
>        calc.medians = TRUE, sweep.cols = calc.medians,
>        recalc.after.sweep = sweep.cols, ...)
>    {
>        .do_normalize(object,
>            method = match.arg(method),
>            calc.medians = calc.medians,
>            sweep.cols = sweep.cols,
>            recalc.after.sweep = recalc.after.sweep,
>            ...)
>    }
>    .local(object, ...)
> }
>
>
> Desire to be able to access formals() for the .local() function definition,
> not the generic one. Have seen information desired available via
"defined"
> slot of returned 'MethodDefinition' object, but not using the code
below.
>
>
>
> ===================>
> library(methods)
>
> if (!isGeneric("normalize")) {
>    ## Other packages also define this generic...
>    setGeneric("normalize",
>               function(object, ...) standardGeneric("normalize"))
> }
>
> setClassUnion("MatrixLike", c("matrix",
"data.frame"))
>
> .do_normalize <- function(concs,
>                          method,
>                          calc.medians,
>                          sweep.cols,
>                          recalc.after.sweep,
>                          ...) {
>    message("internal routine called!")
>    NULL
> }
>
> setMethod("normalize", signature(object="MatrixLike"),
>          function(object,
>                   method=c("median", "vs",
"tukey"),
>                   calc.medians=TRUE,
>                   sweep.cols=calc.medians,
>                   recalc.after.sweep=sweep.cols,
>                   ...) {
>
>    .do_normalize <- function(object,
>                            method=match.arg(method),
>                            calc.medians=calc.medians,
>                            sweep.cols=sweep.cols,
>                            recalc.after.sweep=recalc.after.sweep,
>                            ...)
> }
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
>
>
>
>
>
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
>
>
	[[alternative HTML version deleted]]

On Thu, Jan 29, 2015 at 7:57 AM, John Chambers <jmc at r-project.org>
wrote:
>
> On Jan 28, 2015, at 6:37 PM, Michael Lawrence <lawrence.michael at
gene.com> wrote:
>
>> At this point I would just due:
>>
>> formals(body(method)[[2L]])
>>
>> At some point we need to figure out what to do with this .local()
confusion.
>
> Agreed, definitely.  The current hack is to avoid re-matching arguments on
method dispatch, so a fix would need to be fairly deep in the implementation.
>
> But I don't think the expression above is quite right.
body(method)[[2L]] is the assignment.  You need to evaluate the rhs.
>
> Here is a function that does the same sort of thing, and returns the
standard formals for the generic if this method does not have nonstandard
arguments.  We should probably add a version of this function for 3.3.0, so user
code doesn't have hacks around the current hack.
>
> methodFormals <- function(f, signature = character()) {
>     fdef <- getGeneric(f)
>     method <- selectMethod(fdef, signature)
>     genFormals <- base::formals(fdef)
>     b <- body(method)
>     if(is(b, "{") && is(b[[2]], "<-")
&& identical(b[[2]][[2]], as.name(".local"))) {
>         local <- eval(b[[2]][[3]])
>         if(is.function(local))
>             return(formals(local))
>         warning("Expected a .local assignment to be a function.
Corrupted method?")
>     }
>     genFormals
> }
I have similar code in roxygen2:

# When a generic has ... and a method adds new arguments, the S4 method
# wraps the definition inside another function which has the same arguments
# as the generic. This function figures out if that's the case, and extracts
# the original function if so.
#
# It's based on expression processing based on the structure of the
# constructed method which looks like:
#
# function (x, ...) {
#   .local <- function (x, ..., y = 7) {}
#   .local(x, ...)
# }
extract_method_fun <- function(x) {
  fun <- x at .Data

  method_body <- body(fun)
  if (!is.call(method_body)) return(fun)
  if (!identical(method_body[[1]], quote(`{`))) return(fun)

  first_line <- method_body[[2]]
  if (!is.call(first_line)) return(fun)
  if (!identical(first_line[[1]], quote(`<-`))) return(fun)
  if (!identical(first_line[[2]], quote(`.local`))) return(fun)

  first_line[[3]]
}


-- 
http://had.co.nz/

I wish it didn't have to depend on the name '.local'.

Back when I wrote a lot of S4 methods I avoided the auto-generated .local
and named the local function something that made sense so that is was easier
for a user to track down the source of an error.

E.g., define the generic QQQ with numeric and integer methods:
setGeneric("QQQ",
           function(x, ...)NULL)
setMethod("QQQ",
          signature=signature(x="numeric"),
          function(x, lower, ...) {
              if (x<lower) stop("x<lower")
          })
setMethod("QQQ",
          signature=signature(x="integer"),
          function(x, ...) {
              .QQQ.integer <- function(x, lower, ...) if (x<lower)
stop("x<lower")
              .QQQ.integer(x, ...)
          })
and try using them:
  > QQQ(3.4, 10)
  Error in .local(x, ...) : x<lower
  > traceback()
  4: stop("x<lower") at #4
  3: .local(x, ...)
  2: QQQ(3.4, 10)
  1: QQQ(3.4, 10)
  > QQQ(3L, 10)
  Error in .QQQ.integer(x, ...) : x<lower
  > traceback()
  4: stop("x<lower") at #4
  3: .QQQ.integer(x, ...) at #5
  2: QQQ(3L, 10)
  1: QQQ(3L, 10)
I think the latter gives the user more guidance on how to fix the problem.

Perhaps instead of searching for an assignment to '.local' you could
search for an assignment to the name of the function used in the last
function call of the method.



Bill Dunlap
TIBCO Software
wdunlap tibco.com

On Thu, Jan 29, 2015 at 6:34 AM, Hadley Wickham <h.wickham at gmail.com>
wrote:
> On Thu, Jan 29, 2015 at 7:57 AM, John Chambers <jmc at r-project.org>
wrote:
> >
> > On Jan 28, 2015, at 6:37 PM, Michael Lawrence <lawrence.michael at
gene.com>
> wrote:
> >
> >> At this point I would just due:
> >>
> >> formals(body(method)[[2L]])
> >>
> >> At some point we need to figure out what to do with this .local()
> confusion.
> >
> > Agreed, definitely.  The current hack is to avoid re-matching
arguments
> on method dispatch, so a fix would need to be fairly deep in the
> implementation.
> >
> > But I don't think the expression above is quite right.
> body(method)[[2L]] is the assignment.  You need to evaluate the rhs.
> >
> > Here is a function that does the same sort of thing, and returns the
> standard formals for the generic if this method does not have nonstandard
> arguments.  We should probably add a version of this function for 3.3.0, so
> user code doesn't have hacks around the current hack.
> >
> > methodFormals <- function(f, signature = character()) {
> >     fdef <- getGeneric(f)
> >     method <- selectMethod(fdef, signature)
> >     genFormals <- base::formals(fdef)
> >     b <- body(method)
> >     if(is(b, "{") && is(b[[2]], "<-")
&& identical(b[[2]][[2]], as.name(".local")))
> {
> >         local <- eval(b[[2]][[3]])
> >         if(is.function(local))
> >             return(formals(local))
> >         warning("Expected a .local assignment to be a function.
> Corrupted method?")
> >     }
> >     genFormals
> > }
>
> I have similar code in roxygen2:
>
> # When a generic has ... and a method adds new arguments, the S4 method
> # wraps the definition inside another function which has the same arguments
> # as the generic. This function figures out if that's the case, and
> extracts
> # the original function if so.
> #
> # It's based on expression processing based on the structure of the
> # constructed method which looks like:
> #
> # function (x, ...) {
> #   .local <- function (x, ..., y = 7) {}
> #   .local(x, ...)
> # }
> extract_method_fun <- function(x) {
>   fun <- x at .Data
>
>   method_body <- body(fun)
>   if (!is.call(method_body)) return(fun)
>   if (!identical(method_body[[1]], quote(`{`))) return(fun)
>
>   first_line <- method_body[[2]]
>   if (!is.call(first_line)) return(fun)
>   if (!identical(first_line[[1]], quote(`<-`))) return(fun)
>   if (!identical(first_line[[2]], quote(`.local`))) return(fun)
>
>   first_line[[3]]
> }
>
>
> --
> http://had.co.nz/
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
	[[alternative HTML version deleted]]