R 从关联对象检索定义S4引用类的实际源表达式 简言之（实际问题）

如何从

getClass（“MyClass”）

或

getRefClass（“MyClass”）返回的对象访问定义S4引用类（请参见
？setRefClass
）的实际源代码/表达式（因此在它已经被来源化之后，不是通过调查实际的源文件）

我做的作业
因为在R中，一切都是一个对象，所以我可以检索的源代码/表达式

1）只需调查相应对象即可获得常规函数：

foo <- function(x) print(x)

> foo
function(x) print(x)

setGeneric(name="myMethod", signature=c("x"),
    def=function(x) standardGeneric("myMethod")       
)
setMethod(
    f="myMethod", 
    signature=signature(x="numeric"), 
    definition=function(x) print(x)
)
def <- selectMethod(f="myMethod", signature=c(x="numeric"))

# Get actual source code/expression
> attributes(def)$srcref
function(x) print(x)

setRefClass(Class="MyClass", fields=list(x.1="character"))

def <- getRefClass("MyClass")

# Inspect object >> no expression
> def
Generator object for class "MyClass":

Class fields:

Name:        x.1
Class: character

 Class Methods:  
    "callSuper", "copy", "export", "field", "getClass", "getRefClass", "import", 
"initFields", "show", "trace", "untrace"


 Reference Superclasses:  
    "envRefClass"

def.temp <- attributes(attributes(def)$.xData$def)

# Inspect attributes >> no expression
> attributes(def.temp)
$names
 [1] "fieldClasses"    "fieldPrototypes" "refMethods"      "refSuperClasses"
 [5] "slots"           "contains"        "virtual"         "prototype"      
 [9] "validity"        "access"          "className"       "package"        
[13] "subclasses"      "versionKey"      "sealed"          "class"          

# Alternatively:
> names(attributes(getClass("MyClass")))
 [1] "fieldClasses"    "fieldPrototypes" "refMethods"      "refSuperClasses"
 [5] "slots"           "contains"        "virtual"         "prototype"      
 [9] "validity"        "access"          "className"       "package"        
[13] "subclasses"      "versionKey"      "sealed"          "class"  

但S4参考类的情况似乎有所不同：

foo <- function(x) print(x)

> foo
function(x) print(x)

setGeneric(name="myMethod", signature=c("x"),
    def=function(x) standardGeneric("myMethod")       
)
setMethod(
    f="myMethod", 
    signature=signature(x="numeric"), 
    definition=function(x) print(x)
)
def <- selectMethod(f="myMethod", signature=c(x="numeric"))

# Get actual source code/expression
> attributes(def)$srcref
function(x) print(x)

setRefClass(Class="MyClass", fields=list(x.1="character"))

def <- getRefClass("MyClass")

# Inspect object >> no expression
> def
Generator object for class "MyClass":

Class fields:

Name:        x.1
Class: character

 Class Methods:  
    "callSuper", "copy", "export", "field", "getClass", "getRefClass", "import", 
"initFields", "show", "trace", "untrace"


 Reference Superclasses:  
    "envRefClass"

def.temp <- attributes(attributes(def)$.xData$def)

# Inspect attributes >> no expression
> attributes(def.temp)
$names
 [1] "fieldClasses"    "fieldPrototypes" "refMethods"      "refSuperClasses"
 [5] "slots"           "contains"        "virtual"         "prototype"      
 [9] "validity"        "access"          "className"       "package"        
[13] "subclasses"      "versionKey"      "sealed"          "class"          

# Alternatively:
> names(attributes(getClass("MyClass")))
 [1] "fieldClasses"    "fieldPrototypes" "refMethods"      "refSuperClasses"
 [5] "slots"           "contains"        "virtual"         "prototype"      
 [9] "validity"        "access"          "className"       "package"        
[13] "subclasses"      "versionKey"      "sealed"          "class"  


背景/动机
我经常使用S4参考类（
？setRefClass
），因此像这样的面向对象方面在我的日常工作中扮演着重要角色。我还遵循一个“每个文件一个def”范例，以保持事物的有序性，因此各种类def存储在单独的文件中，其中文件名对应于相应类的名称

与生活中的一切一样，这种方法有一些优点，但也有一些固有的缺点：

方面1

无论长短，最终的继承结构都将与单个源文件的字母顺序不匹配。因此，简单地一个接一个地寻找一个文件将导致在某些所需的超类尚未找到的特定点出现错误

dir.create("classes", showWarnings=FALSE)
write("setRefClass(Class=\"A\", contains=\"B\", fields=list(x.3=\"logical\"))", 
    file="classes/class_A.R")
write("setRefClass(Class=\"B\", contains=\"C\", fields=list(x.2=\"numeric\"))", 
    file="classes/class_B.R")
write("setRefClass(Class=\"C\", fields=list(x.1=\"character\"))", 
    file="classes/class_C.R")

class_A.R
是文件夹
classes
中的第一个文件，但为了获得它，我们首先需要获得
class_B.R
（正如此文件定义class
B
），这反过来需要class
C
，因此需要事先获得
class_C.R

因此，正确的排序规则是：

c("class_C.R", "class_B.R", "class_A.R")

方面2

对于某些任务，您确实希望/需要一个“每个文件多个def”范例：在视差、实际构建包时组织代码等时，将必要的对象/函数/类快速方便地分发给工作进程

path <- "classes/classes.R"
file.create(path)
write("setRefClass(Class=\"C\", fields=list(x.1=\"character\"))", 
    file=path, append=TRUE)
write("setRefClass(Class=\"B\", contains=\"C\", fields=list(x.2=\"numeric\"))", 
    file=path, append=TRUE)
write("setRefClass(Class=\"A\", contains=\"B\", fields=list(x.3=\"logical\"))", 
    file=path, append=TRUE)

广告方面2

我也不喜欢手动复制和粘贴，因此我实现了一个例程，它允许我将存储在单个文件中的源代码或从各个对象绘制的源代码合并到单个“合并”文件中（通过
deparse（）
和
write（…，append=TRUE）
）。对于类，正确的排序规则在这里也很重要，否则当您尝试获取合并文件的源代码时，将再次出现错误

对于这两个方面，最好能够选择如何获得类/函数/方法的实际源代码/表达式：

或者基于对存储在相应数据库中的代码的调查
源文件（
parse（file=*）
）
或者基于直接从数据库访问所需信息
各自的对象
第二个选择是与上述实际问题的链接
 命令的“源”代码未存储，因此您无法通过检查对象来查看它

在控制台上键入并点击
[ENTER]
，查看
setRefClass
的源代码。请注意，您所做的只是将参数传递给函数。。。未定义新表达式。因此，当您
getRefClass
时，您将获得类所知道的关于自身的一切

您可以通过创建parseRefClassArgs函数来重建它，该函数将重建setRefClass的参数。
类定义
由于我们无法评估文件（因为我们不知道排序顺序），
source
或探索定义的类不在表中。在这里，我们将每个文件中的文本解析为一个字符向量，保留以“setRefClass”开头的解析行。解析器去除空白并进行其他转换，以使文本的格式更加统一，尽管以下内容将依赖于一致的类定义（例如，使用命名参数）

依赖关系
我们想要的是具有依赖关系的类的依赖关系图。因此，我们将使用和中的包来构造适当的图

## From --> To == contains --> Class
m <- as.matrix(df[!is.na(df$contains), c("contains", "Class")])
gr <- ftM2graphNEL(m, edgemode="directed")

所以

ClassDefFilesCollaterOrder For Ad 1）软件如何在不首先评估类定义（需要正确的排序规则）的情况下知道正确的排序规则？如果您愿意克服这一点，那么解决方案可能是制作一个带有Collate:字段的包（最终不是那么难），调查
contains
参数的值，并递归地对遇到的超类再次执行整个过程，直到得到具有正确顺序的向量为止。手动指定Collate:字段正是我想要避免的。我同意，明确表达通常是好的，但对于30-50门课程的“快速原型”来说，你可以在其中探索并改变很多东西，我认为这是计算机可以为我做的工作。
base=“foo”；setRefClass（基本）；setRefClass（“bar”，contains=base）
需要求值，对吗？是的，但这不是我的用例：类def存储在文件中，因此我正在解析每个文件的内容，并且不需要求值来处理解析的表达式。请参见我的引用类的结构（
contains=“some string”
not
contains=some.object
）和我在“Ad方面1”中的编辑。但是对于
setMethod
或类似的东西，这不是也是正确的吗？您仍然可以获得源代码的详细信息。也许可以调整
？setRefClass
函数，使其立即包含该信息？是和否setMethod与setRefClass相似，因为：：是的，setMethod只是接收像setRefC这样的参数
p2 <- unlist(p1, use.names=FALSE)
pat <- '.*Class = "([[:alnum:]]+)".*'
df[,"Class"] <- sub(pat, "\\1", p2)

pat <- '.*contains = "([[:alnum:]]+)".*'
idx <- grep(pat, p2)
df[idx,"contains"] <- sub(pat, "\\1", p2[idx])

> df
  Class contains      File
1     A        B class_A.R
2    A1        B class_A.R
3     B        C class_B.R
4     C     <NA> class_C.R

gClass <- character()
gcontains <- character()
setRefClass <- function(Class, fields, contains=NA_character_, ...)
{
    gClass <<- c(gClass, Class)
    gcontains <<- c(gcontains, contains)
}

for (fl in dir()) source(fl)

## From --> To == contains --> Class
m <- as.matrix(df[!is.na(df$contains), c("contains", "Class")])
gr <- ftM2graphNEL(m, edgemode="directed")

o <- bfs(gr, "C")                       # order: breadth-first search
unique(df[match(o, df$Class), "File"])

classDefFilesCollateOrder <- function(fls)
{
    names(fls) <- fls
    p0 <- lapply(fls, function(fl) as.character(parse(text=readLines(fl))))
    p1 <- lapply(p0, grep, pattern="^setRefClass", value=TRUE)

    df <- data.frame(Class=NA_character_, contains=NA_character_,
                     File=rep(fls, sapply(p1, length)),
                     stringsAsFactors=FALSE)

    p2 <- unlist(p1, use.names=FALSE)
    pat <- '.*Class = "([[:alnum:]]+)".*'
    df[,"Class"] <- sub(pat, "\\1", p2)

    pat <- '.*contains = "([[:alnum:]]+)".*'
    idx <- grep(pat, p2)
    df[idx, "contains"] <- sub(pat, "\\1", p2[idx])

    ## From --> To == contains --> Class
    m <- as.matrix(df[!is.na(df$contains), c("contains", "Class")])
    gr <- ftM2graphNEL(m, edgemode="directed")

    ## single class only
    base <- df$Class[is.na(df$contains)]
    if (length(base) != 1)
        stop("don't yet know how to deal with more than 1 base class")
    o <- bfs(gr, base)

    unique(df[match(o, df$Class), "File"])
}