dputting S4 ein Objekt

Question

Wie würde eine Person dput() ein Objekt S4? Ich habe versucht, dieses

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)

, dass Hinweis, wenn ich ein S4 Objekt dput(), kann ich es nicht wieder rekonstruieren. Ihre Gedanken?

Answer 1

Wie es derzeit steht, können Sie dieses Objekt nicht dput. Der Code von dput enthält folgende Schleife:

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()
}

Diese Griffe S4 Objekte rekursiv, aber es beruht auf der Annahme, ein S3-Objekt nicht ein S4-Objekt enthält, die in Ihrem Beispiel nicht gilt:

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

Edit: Hier ist eine Behelfslösung die Grenzen der dput. Es funktioniert für das Beispiel, das Sie zur Verfügung gestellt, aber ich glaube nicht, dass es im Allgemeinen funktionieren (z spielt es keine Attribute behandeln).

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))
}

Und hier ist es in Aktion:

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