How to pass through call of dispatched method and combine with defaults?-CodePudding

I have a generic function foo, a respective default method, and e.g. a formula method. If the default method is dispatched the call to foo.default should be returned as an attribute, whereas if foo.formula was dispatched, X and y arguments should be replaced by the formula argument. Moreover, the defaults in foo.default should also be returned (in both methods), even if not explicitly specified by the user.

It already looks not too bad, but so far I fail to pass the call through from foo.formula to foo.default.

foo <- function(x, ...) UseMethod('foo')

foo.formula <- function(fo, data, ...) {
  .cl <- match.call()
  y <- model.response(model.frame(fo, data))
  X <- model.matrix(fo, data)
  foo.default(X, y, .cl=.cl)
}

foo.default <- function(X, y, bar=FALSE, method='1A', beta=2, ...) {
  if (!exists('.cl')) .cl <- match.call()
  fa <- formalArgs(foo.default)
  m <- match(names(.cl), fa, nomatch=0)
  .cl <- c(as.list(.cl), as.list(args(foo.default))[-m])
  .cl[[1]] <- as.name('foo')
  `attr<-`(lm.fit(X, y)$coefficients, 'call', as.call(.cl))
}

foo(X1, y1)
# (Intercept)          hp 
# 30.09886054 -0.06822828 
# attr(,"call")
# foo(X = X1, y = y1, bar = FALSE, method = "1A", beta = 2, 
#             ... = , NULL)

foo(mpg ~ hp, mtcars)
# (Intercept)          hp 
# 30.09886054 -0.06822828 
# attr(,"call")
# foo(X = X, y = y, .cl = .cl, bar = FALSE, method = "1A", 
#             beta = 2, ... = , NULL)

Desired output in about:

foo(X1, y1)
# (Intercept)          hp 
# 30.09886054 -0.06822828 
# attr(,"call")
# foo(X = X1, y = y1, bar = FALSE, method = "1A", beta = 2, ...)

foo(mpg ~ hp, mtcars)
# (Intercept)          hp 
# 30.09886054 -0.06822828 
# attr(,"call")
# foo(fo = mpg ~ hp, data = mtcars, bar = FALSE, method = '1A', beta = 2, ...)

How can I do that?

Data:

y1 <- c(`Mazda RX4` = 21, `Mazda RX4 Wag` = 21, `Datsun 710` = 22.8, 
`Hornet 4 Drive` = 21.4, `Hornet Sportabout` = 18.7, Valiant = 18.1, 
`Duster 360` = 14.3, `Merc 240D` = 24.4, `Merc 230` = 22.8, `Merc 280` = 19.2, 
`Merc 280C` = 17.8, `Merc 450SE` = 16.4, `Merc 450SL` = 17.3, 
`Merc 450SLC` = 15.2, `Cadillac Fleetwood` = 10.4, `Lincoln Continental` = 10.4, 
`Chrysler Imperial` = 14.7, `Fiat 128` = 32.4, `Honda Civic` = 30.4, 
`Toyota Corolla` = 33.9, `Toyota Corona` = 21.5, `Dodge Challenger` = 15.5, 
`AMC Javelin` = 15.2, `Camaro Z28` = 13.3, `Pontiac Firebird` = 19.2, 
`Fiat X1-9` = 27.3, `Porsche 914-2` = 26, `Lotus Europa` = 30.4, 
`Ford Pantera L` = 15.8, `Ferrari Dino` = 19.7, `Maserati Bora` = 15, 
`Volvo 142E` = 21.4)

X1 <- structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 110, 110, 93, 110, 
175, 105, 245, 62, 95, 123, 123, 180, 180, 180, 205, 215, 230, 
66, 52, 65, 97, 150, 150, 245, 175, 66, 91, 113, 264, 175, 335, 
109), dim = c(32L, 2L), dimnames = list(c("Mazda RX4", "Mazda RX4 Wag", 
"Datsun 710", "Hornet 4 Drive", "Hornet Sportabout", "Valiant", 
"Duster 360", "Merc 240D", "Merc 230", "Merc 280", "Merc 280C", 
"Merc 450SE", "Merc 450SL", "Merc 450SLC", "Cadillac Fleetwood", 
"Lincoln Continental", "Chrysler Imperial", "Fiat 128", "Honda Civic", 
"Toyota Corolla", "Toyota Corona", "Dodge Challenger", "AMC Javelin", 
"Camaro Z28", "Pontiac Firebird", "Fiat X1-9", "Porsche 914-2", 
"Lotus Europa", "Ford Pantera L", "Ferrari Dino", "Maserati Bora", 
"Volvo 142E"), c("(Intercept)", "hp")), assign = 0:1)

CodePudding user response：

How about this?

foo.default <- function(X, y, bar=FALSE, method='1A', beta=2, ...) {
    ell <- list(...)
    fa <- Filter(Negate(is.null), as.list(args(foo.default)))
    if (!exists('.cl', where = ell)) {
        .cl <- as.list(match.call())
        m <- match(names(.cl), names(fa), nomatch = 0)
        .cl <- c(.cl, fa[-m])
    } else {
        .cl <- c(as.list(ell$.cl), fa[-c(1, 2)])
    }
    `attr<-`(lm.fit(X, y)$coefficients, 'call', as.call(.cl))
}

foo(X1, y1)
#(Intercept)          hp 
#30.09886054 -0.06822828 
#attr(,"call")
#foo.default(X = X1, y = y1, bar = FALSE, method = "1A", beta = 2, 
#            ... = )

foo(mpg ~ hp, mtcars)
#(Intercept)          hp 
#30.09886054 -0.06822828 
#attr(,"call")
#foo.formula(fo = mpg ~ hp, data = mtcars, bar = FALSE, method = "1A", 
#            beta = 2, ... = )

A couple of comments:

There is a bit of a (minor?) awkwardness here: Inside else, excluding the first two arguments X and y of foo.default when foo.formula had been dispatched first, is hard-coded here. So I'm not sure how this will generalise when you introduce another method, e.g. foo.bar(df, ...). As long as df replaces the first two arguments of foo.default that'll be fine; if not, more work is required.
I don't fully understand where the NULL from as.list(args(foo.default)) comes from. I think it's because args returns NULL which gets turned into a final NULL element when coercing to as.list. Either way, it can be removed with Filter(Negate(is.null), ...).
I haven't tidied up the ellipsis argument. Instead of ... = I take it you want ... inside the call.