r - 如何列出在特定包/命名空间中为特定通用函数定义的所有 S3 方法

Question

我知道我可以列出特定通用函数的所有 S3 方法，比如 summary ， 经过

.S3methods("summary")
# [1] summary.aov                    summary.aovlist*              
# [3] summary.aspell*                summary.check_packages_in_dir*
# [5] summary.connection             summary.data.frame            
# [7] summary.Date                   summary.default               
# [9] summary.ecdf*                  summary.factor                
#[11] summary.glm                    summary.infl*                 
#[13] summary.lm                     summary.loess*                
#[15] summary.manova                 summary.matrix                
#[17] summary.mlm*                   summary.nls*                  
#[19] summary.packageStatus*         summary.PDF_Dictionary*       
#[21] summary.PDF_Stream*            summary.POSIXct               
#[23] summary.POSIXlt                summary.ppr*                  
#[25] summary.prcomp*                summary.princomp*             
#[27] summary.proc_time              summary.srcfile               
#[29] summary.srcref                 summary.stepfun               
#[31] summary.stl*                   summary.table                 
#[33] summary.tukeysmooth*  

但是，我知道其中一些功能来自 stats ，而一些来自 base .如果我将更多的包加载到 R 中，这个列表可能会更长。因此，我想限制在特定包/命名空间中的搜索，但我找不到这样做的方法。
?.S3methods说明书似乎是自相矛盾的。

 .S3methods(generic.function, class, envir=parent.frame())

envir: the environment in which to look for the definition of the
       generic function, when the generic function is passed as a
       character string.

所以我尝试了以下但仍然显示所有方法:

.S3methods("summary", envir = getNamespace("base"))

在手册的“详细信息”部分，它说:

‘methods()’ finds S3 and S4 methods associated with either the ’generic.function’ or ‘class’ argument. Methods are found in all packages on the current ‘search()’ path. ‘.S3methods()’ finds only S3 methods, ‘.S4methods()’ finds only only S4 methods.

所以基本上它拒绝使用参数 envir .

无论如何我可以实现受限制的搜索和显示。

Answer 1

MrFlick's answer (现在不幸被删除)非常有帮助。忘记检查 .S3methods 的返回值是我的错.然而，他的回答并没有完全解决问题。

xx <- .S3methods("summary")
yy <- attr(xx, "info")
levels(yy$from)
#[1] "base"                            "datasets"                       
#[3] ".GlobalEnv"                      "graphics"                       
#[5] "grDevices"                       "methods"                        
#[7] "stats"                           "utils"                          
#[9] "registered S3method for summary"

“注册 S3 方法摘要”这一级别相当含糊。使用这种方法，只有 5 个结果来自 stats包可以显示:

xx[yy$from == "stats"]
#[1] "summary.aov"     "summary.glm"     "summary.lm"      "summary.manova" 
#[5] "summary.stepfun"

就在我发布这个问题之后，我意识到通过正则表达式有一种方法。这表明实际上有 16 次点击。

grep("^summary.", ls(getNamespace("stats")), value = TRUE)
# [1] "summary.aov"         "summary.aovlist"     "summary.ecdf"       
# [4] "summary.glm"         "summary.infl"        "summary.lm"         
# [7] "summary.loess"       "summary.manova"      "summary.mlm"        
#[10] "summary.nls"         "summary.ppr"         "summary.prcomp"     
#[13] "summary.princomp"    "summary.stepfun"     "summary.stl"        
#[16] "summary.tukeysmooth"

因此，在找到任何替代解决方案之前，我会继续使用正则表达式。这是一个函数。

## provide (generic) function name and package name as strings
findS3Fun <- function (Fun, pkg) {
  all_fun <- ls(getNamespace(pkg))
  all_fun[startsWith(all_fun, sprintf("%s.", Fun))]
  }

findS3Fun("summary", "stats")

咳咳，正则表达式有问题!
findS3Fun实际上是 buggy 。

findS3Fun("seq", "base")
#[1] "seq.Date"    "seq.default" "seq.int"     "seq.POSIXt" 

findS3Fun("sort", "base")
#[1] "sort.default" "sort.int"     "sort.list"    "sort.POSIXlt"

seq.int不是 seq 的“int”方法.都没有 sort.int也不是 sort.list是 sort 的“int”或“list”方法.它们只是具有 . 的独立功能在它们的函数名称中。

.S3methods("seq")
#[1] seq.Date    seq.default seq.POSIXt 

.S3methods("sort")
#[1] sort.bibentry* sort.default   sort.POSIXlt 

## this function is from package `utils` not `base`
environment(getS3method("sort", "bibentry"))
#<environment: namespace:utils>

所以最安全的方法可能仍然是使用 .S3methods 的返回值。 .

使用 getAnywhere ( getS3method )

回到带有“摘要”的示例。不是从命名空间导出的函数，即具有 yy$visible = FALSE 的函数, 有 yy$from = "registered S3method for summary" .

with(yy, from[!visible])
# [1] registered S3method for summary registered S3method for summary
# [3] registered S3method for summary registered S3method for summary
# [5] registered S3method for summary registered S3method for summary
# [7] registered S3method for summary registered S3method for summary
# [9] registered S3method for summary registered S3method for summary
#[11] registered S3method for summary registered S3method for summary
#[13] registered S3method for summary registered S3method for summary
#[15] registered S3method for summary registered S3method for summary
#8 Levels: base datasets graphics grDevices methods stats ... registered S3method for summary

但是，既然我们知道这些函数的名称，为什么不应用 getAnywhere在他们？

zz <- lapply(xx[!yy$visible], getAnywhere)

然后可以从 zz中提取包/命名空间信息经过一些努力。然而，这个 lapply + getAnywhere很慢。自 getAnywhere返回比我需要的更多的东西，我深入研究了它的源代码，看看我是否可以做一些修剪。事实证明我可以。

hidden <- xx[!yy$visible]
# [1] "summary.aovlist"               "summary.aspell"               
# [3] "summary.check_packages_in_dir" "summary.ecdf"                 
# [5] "summary.infl"                  "summary.loess"                
# [7] "summary.mlm"                   "summary.nls"                  
# [9] "summary.packageStatus"         "summary.PDF_Dictionary"       
#[11] "summary.PDF_Stream"            "summary.ppr"                  
#[13] "summary.prcomp"                "summary.princomp"             
#[15] "summary.stl"                   "summary.tukeysmooth"  

CLASS <- substr(hidden, nchar("summary") + 2L, nchar(hidden))
#[1] "aovlist"               "aspell"                "check_packages_in_dir"
# [4] "ecdf"                  "infl"                  "loess"                
# [7] "mlm"                   "nls"                   "packageStatus"        
#[10] "PDF_Dictionary"        "PDF_Stream"            "ppr"                  
#[13] "prcomp"                "princomp"              "stl"                  
#[16] "tukeysmooth"          

vapply(CLASS,
       function (u) getNamespaceName(environment(getS3method("summary", u)))[[1L]],
       "", USE.NAMES = FALSE)
# [1] "stats" "utils" "tools" "stats" "stats" "stats" "stats" "stats" "utils"
#[10] "tools" "tools" "stats" "stats" "stats" "stats" "stats"

最终解决方案

现在让我将这些想法包装成一个函数。

findS3Fun <- function (Fun, pkg) {
  xx <- .S3methods(Fun)
  yy <- attr(xx, "info")[1:2]
  where <- yy[[2L]]  ## yy$from
  where <- levels(where)[where]  ## factor to character
  hidden <- !yy[[1L]]  ## !yy$visible
  hidden_xx <- xx[hidden]  ## hidden functions
  if (length(hidden) > 0L) {
    CLASS <- substr(hidden_xx, nchar(Fun) + 2L, nchar(hidden_xx))
    aux <- function (u) getNamespaceName(environment(getS3method(Fun, u)))[[1L]]
    where[hidden] <- vapply(CLASS, aux, "", USE.NAMES = FALSE)
    }
  export <- where == pkg
  xx <- xx[export]
  visible <- yy[[1L]][export]
  ## use "regex" to find functions with "." in their names but not methods
  all_fun <- ls(getNamespace(pkg))
  all_fun <- all_fun[startsWith(all_fun, sprintf("%s.", Fun))]
  misc <- all_fun[!(all_fun %in% xx)]
  ## return functions by category
  list(visible = xx[visible], invisible = xx[!visible], misc = misc)
  }

最后我还是用正则表达式来捕捉函数 .以他们的名义，但不是正确的方法。除了“可见”和“不可见”之外，它们还被归类为“杂项”。

测试

findS3Fun("summary", "stats")
#$visible
#[1] "summary.aov"     "summary.glm"     "summary.lm"      "summary.manova" 
#[5] "summary.stepfun"
#
#$invisible
# [1] "summary.aovlist"     "summary.ecdf"        "summary.infl"       
# [4] "summary.loess"       "summary.mlm"         "summary.nls"        
# [7] "summary.ppr"         "summary.prcomp"      "summary.princomp"   
#[10] "summary.stl"         "summary.tukeysmooth"
#
#$misc
#character(0)

findS3Fun("sort", "base")
#$visible
#[1] "sort.default" "sort.POSIXlt"
#
#$invisible
#character(0)
#
#$misc
#[1] "sort.int"  "sort.list"

findS3Fun("[", "base")
#$visible
# [1] "[.AsIs"            "[.data.frame"      "[.Date"           
# [4] "[.difftime"        "[.Dlist"           "[.factor"         
# [7] "[.hexmode"         "[.listof"          "[.noquote"        
#[10] "[.numeric_version" "[.octmode"         "[.POSIXct"        
#[13] "[.POSIXlt"         "[.simple.list"     "[.table"          
#[16] "[.warnings"       
#
#$invisible
#character(0)
#
#$misc
#character(0)

findS3Fun("[[", "base")
#$visible
#[1] "[[.data.frame"      "[[.Date"            "[[.factor"         
#[4] "[[.numeric_version" "[[.POSIXct"        
#
#$invisible
#character(0)
#
#$misc
#character(0)