2010-08-12 4 views
7

Come sarebbe una persona dput() un oggetto S4? Ho provato questodputting un oggetto 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) 

Si noti che se un oggetto dput() S4, non riesco a ricostruire di nuovo. I tuoi pensieri?

+1

Perché si vuole costruire oggetti in questo modo? Sembra che sarebbe molto meno leggibile rispetto alla scrittura di una funzione che costruisce e restituisce un oggetto modello che è possibile quindi regolare. – Vince

+0

È solo una piccola cosa che ho notato quando ho provato a salvare un piccolo poligono a scopo di test. Sono d'accordo sul fatto che sia più facile avere una matrice n * 2 e una funzione che suona un po 'su di essa. –

risposta

9

Allo stato attuale, non è possibile dput questo oggetto. Il codice di dput contiene il seguente ciclo:

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

Questo gestisce S4 oggetti in modo ricorsivo, ma si basa sul presupposto di un oggetto S3 non conterrà un oggetto S4, che nel tuo esempio non regge:

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

Modifica: Ecco una soluzione ai limiti di dput. Funziona per l'esempio che hai fornito, ma non penso che funzionerà in generale (ad esempio non gestisce gli attributi).

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

e qui è in azione:

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

Estremamente utile per me! Grazie. Era necessaria una correzione: aggiunta questa riga prima dell'ultima chiamata ricorsiva a dput2: 'if (i> 1) cat (", ", file = file)' – Roger

Problemi correlati