2

In a package, I would like to call an S3 method "compact" for object foobar.

There would therefore be a compact.foobar function in my package, along with the compact function itself:

compact = function(x, ...){
    UseMethod("compact", x)
}

However, this latter would be conflicting with purrr::compact.

I could default the method to use purrr (compact.default = purrr::compact, or maybe compact.list = purrr::compact), but that would make little sense if the user does not have purrr loaded.

How can I default my method to the loaded version of compact, in the user environment? (so that it uses purrr::compact, any other declared compact function, or fails of missing function)

Dan Chaltiel
  • 7,811
  • 5
  • 47
  • 92
  • What about hypothetical package ‘xyz’ that also declares `compact`? (The answer to this matters for a potential solution.) – Konrad Rudolph Apr 02 '20 at 08:46
  • @KonradRudolph That's what I meant with "in the user environment". If the user has loaded `purrr`, `xyz`, both, or anything else, if the object is not of class `foobar`, my method should use whatever `compact` function it is loaded. – Dan Chaltiel Apr 02 '20 at 08:50

1 Answers1

1

Unfortunately S3 does not deal with this situation well. You have to search for suitable functions manually. The following works, more or less:

get_defined_function = function (name) {
    matches = getAnywhere(name)
    # Filter out invisible objects and duplicates
    objs = matches$objs[matches$visible & ! matches$dups]
    # Filter out non-function objects
    funs = objs[vapply(objs, is.function, logical(1L))]
    # Filter out function defined in own package.
    envs = lapply(funs, environment)
    funs = funs[! vapply(envs, identical, logical(1L), topenv())]
    funs[1L][[1L]] # Return `NULL` if no function exists.
}
compact.default = function (...) {
    # Maybe add error handling for functions not found.
    get_defined_function('compact')(...)
}

This uses getAnywhere to find all objects named compact that R knows about. It then filters out those that are not visible because they’re not inside attached packages, and those that are duplicate (this is probably redundant, but we do it anyway).

Next, it filters out anything that’s not a function. And finally it filters out the compact S3 generic that our own package defines. To do this, it compares each function’s environment to the package environment (given by topenv()).

This should work, but it has no rule for which function to prefer if there are multiple functions with the same name defined in different locations (it just picks an arbitrary one first), and it also doesn’t check whether the function signature matches (doing this is hard in R, since function calling and parameter matching is very flexible).

Konrad Rudolph
  • 530,221
  • 131
  • 937
  • 1,214
  • Awesome! I had to change the last line to `unlist(funs[[1L]])` for it to work, but after a few tests, it seems to be perfect. This should definitely be in some util package! – Dan Chaltiel Apr 02 '20 at 11:51
  • @DanChaltiel Hmm no, that change should *not* work: `funs[[1L]]` is already a single element, no need for `unlist`, and this will fail if the list is empty. Whereas my code will return `NULL`. The last line is in effect equivalent to `if (length(funs) > 0L) funs[[1L]] else NULL`. – Konrad Rudolph Apr 02 '20 at 12:02
  • This is strange, while what you say makes perfect sense, on my computer it fails with `[1L]` and runs with `[[1L]]`. Somehow, the `unlist` call didn't have any effect... – Dan Chaltiel Apr 02 '20 at 12:04
  • 1
    With `browser()`, I have `identical(funs[1L],unlist(funs[1L]))==TRUE`. How uncanny! But indeed, it fails if there is no `compact` function loaded. – Dan Chaltiel Apr 02 '20 at 12:07
  • @DanChaltiel Thanks for your debugging work, I’ve had another look and was able to reproduce it, no idea how my code ever worked in the first place. The fix should now work, although I’m slightly concerned that the code is a bit too obscure, and that using an explicit `if` might be better after all … – Konrad Rudolph Apr 02 '20 at 13:04
  • 1
    Actually, I stuck with the function returning a list, and used `fn=get_defined_function('compact'); fn[[1L]](...)` in `compact.default`. This way I can perform tests on the function and throw an error is `fn` is null. – Dan Chaltiel Apr 02 '20 at 14:00