You won't like this ...;)
return(drop(callGeneric(array(x,
c(1, length(x)),
val)
)))
i.e., 'val' is inside 'array'!
I was discouraged from answering sooner by the complexity of your
example; simplifying it might have provided an immediate answer...
> x <- 1:8
> foo(array(x, c(1,length(x)), val)
+
! Martin
Paul Roebuck <roebuck at mdanderson.org> writes:
> I recently encountered this and was wondering if someone
> could explain what happened. Basis of question involves
> what the difference between the calls makes as the end
> result is the same:
>
>> identical(matrix(1:8, nrow = 1), array(1:8, c(1, 8)))
> TRUE
>
> If I run the code below as shown, I get the following:
>
>> foo(1:8, 4)
> foo (vector, numeric)
> val = 4
> foo (matrix, ANY)
> val = 500
> foo (matrix, numeric)
> val = 500
> [1] 500 500 500 500 500 500 500 500
>
> Exchanging the current return for one of the commented ones
> (HERE) yields the expected answer:
>
>> foo(1:8, 4)
> foo (vector, numeric)
> val = 4
> foo (matrix, numeric)
> val = 4
> [1] 4 4 4 4 4 4 4 4
>
>
> When invoked with array(), it loses track of the second
> parameter and gives the wrong answer. While it would seem
> to have something to do with the first parameter's
> evaluation time, I don't follow why one works and the other
> doesn't. Forcing the evaluation via assignment (third case)
> also provides the correct result.
>
> Example code follows:
>
>
>
##------------------------------------------------------------------------------
> library(methods)
>
> setGeneric("foo",
> function(x, val = 500) {
> standardGeneric("foo")
> })
>
> setMethod("foo",
> signature(x = "vector", val = "numeric"),
> function(x, val) {
> cat(match.call()[[1]], "(vector, numeric)",
"\n")
> cat("\t", "val =", val, "\n")
> ## HERE ##
> # return(drop(callGeneric(matrix(x, nrow = 1), val)))
> return(drop(callGeneric(array(x, c(1, length(x)), val))))
> # return(drop(callGeneric(xm <- array(x, c(1, length(x))),
val)))
> })
>
> setMethod("foo",
> signature(x = "vector"),
> function(x, val) {
> cat(match.call()[[1]], "(vector, ANY)",
"\n")
> callGeneric(x, val)
> })
>
> setMethod("foo",
> signature(x = "matrix", val = "numeric"),
> function(x, val) {
> cat(match.call()[[1]], "(matrix, numeric)",
"\n")
> cat("\t", "val =", val, "\n")
> return(apply(x, c(1, 2), function(m, v) { m <- v }, val))
> })
>
> setMethod("foo",
> signature(x = "matrix"),
> function(x, val) {
> cat(match.call()[[1]], "(matrix, ANY)",
"\n")
> cat("\t", "val =", val, "\n")
> callGeneric(x, val)
> })
>
> setMethod("foo",
> signature(x = "array"),
> function(x, val) {
> cat(match.call()[[1]], "(array, ANY)",
"\n")
> stop(sprintf("method not defined for %s argument",
> data.class(x)))
> })
>
> setMethod("foo",
> signature(x = "ANY"),
> function(x, val) {
> cat(match.call()[[1]], "(ANY, ANY)",
"\n")
> stop(sprintf("method not defined for %s argument",
> data.class(x)))
> })
>
> ----------------------------------------------------------
> SIGSIG -- signature too long (core dumped)
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel