Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

dputting an S4 object

Tags:

r

s4

How would a person dput() an S4 object? I tried this

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)

Notice that if I dput() an S4 object, I cannot reconstruct it again. Your thoughts?

like image 858
Roman Luštrik Avatar asked Aug 12 '10 10:08

Roman Luštrik


People also ask

What is an S4 object in R?

The S4 system in R is a system for object oriented programing. Confusingly, R has support for at least 3 different systems for object oriented programming: S3, S4 and S5 (also known as reference classes).

How do you create S4 objects How can you check an object is S4 object?

We can check if an object is an S4 object through the function isS4() . The function setClass() returns a generator function. This generator function (usually having same name as the class) can be used to create new objects. It acts as a constructor.


1 Answers

As it currently stands, you cannot dput this object. The code of dput contains the following loop:

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

This handles S4 objects recursively, but it relies on the assumption an S3 object will not contain an S4 object, which in your example does not hold:

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

Edit: Here is a work-around the limitations of dput. It works for the example you provided, but I don't think that it will work in general (e.g. it does not handle attributes).

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

And here it is in action:

> dput2(poly.d,file=(tempFile <- tempfile()))
> poly.d2 <- dget(tempFile)
> all.equal(poly.d,poly.d2)
[1] TRUE
like image 69
nullglob Avatar answered Oct 06 '22 22:10

nullglob