输入 S4 对象答案

【问题标题】：dputting an S4 object输入 S4 对象
【发布时间】：2010-08-12 10:10:16
【问题描述】：

一个人dput() 怎么会是一个 S4 对象？我试过这个

require(sp)
require(splancs)
plot(0, 0, xlim = c(-100, 100), ylim = c(-100, 100))
poly.d <- getpoly() #draw a pretty polygon - PRETTY!
poly.d <- rbind(poly.d, poly.d[1,]) # close the polygon because of Polygons() and its kin
poly.d <- SpatialPolygons(list(Polygons(list(Polygon(poly.d)), ID = 1)))
poly.d
dput(poly.d)

请注意，如果我 dput() 一个 S4 对象，我将无法再次重建它。你的想法？

【问题讨论】：

为什么要这样构建对象？看起来它比编写一个构建并返回一个模板对象的函数可读性要差得多，然后你可以调整它。
当我尝试保存一个小多边形以进行测试时，我注意到了这一点。我同意拥有一个 n*2 矩阵和一个对其进行一些处理的函数会更容易。

标签： r s4

【解决方案1】：

就目前而言，您不能dput 这个对象。 dput 的代码包含以下循环：

if (isS4(x)) {
    cat("new(\"", class(x), "\"\n", file = file, sep = "")
    for (n in slotNames(x)) {
        cat("    ,", n, "= ", file = file)
        dput(slot(x, n), file = file, control = control)
    }
    cat(")\n", file = file)
    invisible()
}

这会递归处理 S4 对象，但它依赖于假设 S3 对象不包含 S4 对象，在您的示例中不包含：

> isS4(slot(poly.d,'polygons'))
[1] FALSE
> isS4(slot(poly.d,'polygons')[[1]])
[1] TRUE

编辑：这是解决dput 限制的方法。它适用于您提供的示例，但我认为它一般不会起作用（例如，它不处理属性）。

dput2 <- function (x,
                   file = "",
                   control = c("keepNA", "keepInteger", "showAttributes")){
    if (is.character(file))
        if (nzchar(file)) {
            file <- file(file, "wt")
            on.exit(close(file))
        }
        else file <- stdout()
    opts <- .deparseOpts(control)
    if (isS4(x)) {
        cat("new(\"", class(x), "\"\n", file = file, sep = "")
        for (n in slotNames(x)) {
            cat("    ,", n, "= ", file = file)
            dput2(slot(x, n), file = file, control = control)
        }
        cat(")\n", file = file)
        invisible()
    } else if(length(grep('@',capture.output(str(x)))) > 0){
      if(is.list(x)){
        cat("list(\n", file = file, sep = "")
        for (i in 1:length(x)) {
          if(!is.null(names(x))){
            n <- names(x)[i]
            if(n != ''){
              cat("    ,", n, "= ", file = file)
            }
          }
          dput2(x[[i]], file = file, control = control)
        }
        cat(")\n", file = file)
        invisible()
      } else {
        stop('S4 objects are only handled if they are contained within an S4 object or a list object')
      }
    }
    else .Internal(dput(x, file, opts))
}

它正在发挥作用：

> dput2(poly.d,file=(tempFile <- tempfile()))
> poly.d2 <- dget(tempFile)
> all.equal(poly.d,poly.d2)
[1] TRUE

【讨论】：

对我非常有帮助！谢谢。需要一个修复：在最后一次递归调用 dput2 之前添加此行：if(i > 1) cat(", ", file = file)