2014-11-30 15 views
11

Qualcuno ha appena pubblicato alcuni output della console come esempio. (Questo accade molto, e ho delle strategie per convertire l'output di stampa per i vettori e i dataframes.) Mi chiedo se qualcuno ha un metodo elegante per analizzare questo in una vera lista R?Converti l'output della console dell'elenco in un elenco R reale

test <- "[[1]] 
[1] 1.0000 1.9643 4.5957 

[[2]] 
[1] 1.0000 2.2753 3.8589 

[[3]] 
[1] 1.0000 2.9781 4.5651 

[[4]] 
[1] 1.0000 2.9320 3.5519 

[[5]] 
[1] 1.0000 3.5772 2.8560 

[[6]] 
[1] 1.0000 4.0150 3.1937 

[[7]] 
[1] 1.0000 3.3814 3.4291" 

Questo è un esempio con nodi denominati e senza nome:

L <- 
structure(list(a = structure(list(d = 1:2, j = 5:6, o = structure(list(
    w = 2, 4), .Names = c("w", ""))), .Names = c("d", "j", "o" 
)), b = "c", c = 3:4), .Names = c("a", "b", "c")) 

> L 
$a 
$a$d 
[1] 1 2 

$a$j 
[1] 5 6 

$a$o 
$a$o$w 
[1] 2 

$a$o[[2]] 
[1] 4 



$b 
[1] "c" 

$c 
[1] 3 4 

Ho lavorato attraverso il codice di come str gestisce gli elenchi, ma che sta facendo essenzialmente la trasformazione inversa. Immagino che questo debba essere strutturato in qualche modo lungo queste linee dove ci sarà un richiamo ricorsivo a qualcosa di simile a questa logica, dal momento che le liste possono essere nominate (in cui ci sarà "$" che precede l'ultimo indice) o senza nome (nel qual caso ci sarà un certo numero racchiuso in

parseTxt <- function(Lobj) { 
    #setup logic 
# Untested code... basically a structure to be filled in 
rdLn <- function(Ln) { 
    for(ln in length(inp)) { 
     m <- gregexpr("\\[\\[|\\$", "$a$o[[2]]") 
     separators <- regmatches("$a$o[[2]]", m) 
     curr.nm=NA 
     if (tail(separators, 1) == "$"){ 
        nm <- sub("^.+\\$","",ln) 
        if(!nm %in% curr.nm){ curr.nm <-c(nm, curr.nm) } 
     } else { if (tail(separators, 1) == '[['){ 
      # here need to handle "[[n]]" case 
     } else { and here handle the "[n]" case 
        } 
    } 
} 
+5

Seriamente, chiedere l'output 'dput'. Se non lo prevedono, lancia un downvote e vai avanti. Puoi * usare * una mostruosità come 'lapply (readLines (textConnection (gsub (" \ n (? = \ N) | \\ [\\ [\\ d * \\] \\] \ n | \\ [\ \ d * \\] "," ", test, perl = TRUE))), funzione (x) scan (textConnection (x)))', ma non lo farei. – Roland

+0

Sono d'accordo con Roland. La mostruosità alternativa è 'read.delim (text = gsub (" \\ [+ \\ d + \\] + "," ", test), header = FALSE, sep =" ")' ma funziona solo per questo caso. – Andrie

+0

@Andrie. Non funziona nemmeno qui. Fornisce un dataframe a 3 colonne anziché un elenco di 7 elementi. –

risposta

8

Ecco il mio colpo a una soluzione. Funziona bene su entrambi i casi di test, e su pochi altri con cui l'ho testato.

deprint <- function(ll) { 
    ## Pattern to match strings beginning with _at least_ one $x or [[x]] 
    branchPat <- "^(\\$[^$[]*|\\[\\[[[:digit:]]*\\]\\])" 
    ## Pattern to match strings with _just_ one $x or one [[x]] 
    trunkPat <- "^(\\$[^$[]*|\\[\\[[[:digit:]]*\\]\\])\\s*$" 
    ## 
    isBranch <- function(X) { 
     grepl(branchPat, X[1]) 
    } 
    ## Parse character vectors of lines like "[1] 1 3 4" or 
    ## "[1] TRUE FALSE" or c("[1] a b c d", "[5] e f") 
    readTip <- function(X) { 
     X <- paste(sub("^\\s*\\[.*\\]", "", X), collapse=" ") 
     tokens <- scan(textConnection(X), what=character(), quiet=TRUE) 
     read.table(text = tokens, stringsAsFactors=FALSE)[[1]] 
    } 

    ## (0) Split into vector of lines (if needed) and 
    ##  strip out empty lines 
    ll <- readLines(textConnection(ll)) 
    ll <- ll[ll!=""] 

    ## (1) Split into branches ... 
    trunks <- grep(trunkPat, ll) 
    grp <- cumsum(seq_along(ll) %in% trunks) 
    XX <- split(ll, grp) 
    ## ... preserving element names, where present 
    nms <- sapply(XX, function(X) gsub("\\[.*|\\$", "", X[[1]])) 
    XX <- lapply(XX, function(X) X[-1]) 
    names(XX) <- nms 

    ## (2) Strip away top-level list identifiers. 
    ## pat2 <- "^\\$[^$\\[]*" 
    XX <- lapply(XX, function(X) sub(branchPat, "", X)) 

    ## (3) Step through list elements: 
    ## - Branches will need further recursive processing. 
    ## - Tips are ready to parse into base type vectors. 
    lapply(XX, function(X) { 
     if(isBranch(X)) deprint(X) else readTip(X) 
    }) 
} 

Con L, l'elenco esempio più complicato, qui è quello che dà:

## Because deprint() interprets numbers without a decimal part as integers, 
## I've modified L slightly, changing "list(w=2,4)" to "list(w=2L,4L)" 
## to allow a meaningful test using identical(). 
L <- 
structure(list(a = structure(list(d = 1:2, j = 5:6, o = structure(list(
    w = 2L, 4L), .Names = c("w", ""))), .Names = c("d", "j", "o" 
)), b = "c", c = 3:4), .Names = c("a", "b", "c")) 

## Capture the print representation of L, and then feed it to deprint() 
test2 <- capture.output(L) 
LL <- deprint(test2) 
identical(L, LL) 
## [1] TRUE 
LL 
## $a 
## $a$d 
## [1] 1 2 
## 
## $a$j 
## [1] 5 6 
## 
## $a$o 
## $a$o$w 
## [1] 2 
## 
## $a$o[[2]] 
## [1] 4 
## 
## $b 
## [1] "c" 
## 
## $c 
## [1] 3 4 

Ed ecco come gestisce la rappresentazione di stampa di test, il vostro più lista regolare:

deprint(test) 
## [[1]] 
## [1] 1.0000 1.9643 4.5957 
## 
## [[2]] 
## [1] 1.0000 2.2753 3.8589 
## 
## [[3]] 
## [1] 1.0000 2.9781 4.5651 
## 
## [[4]] 
## [1] 1.0000 2.9320 3.5519 
## 
## [[5]] 
## [1] 1.0000 3.5772 2.8560 
## 
## [[6]] 
## [1] 1.0000 4.0150 3.1937 
## 
## [[7]] 
## [1] 1.0000 3.3814 3.4291 

Un altro esempio:

head(as.data.frame(deprint(capture.output(as.list(mtcars))))) 
# mpg cyl disp hp drat wt qsec vs am gear carb 
# 1 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 
# 2 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 
# 3 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 
# 4 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 
# 5 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 
# 6 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 
+0

Funziona anche per me Grazie –

+0

Avevo intenzione di concedere il premio di ieri e pensavo di farlo facendo un segno di spunta risposta, ma ho ricevuto un messaggio oggi che mi avvisava che stava per scadere, quindi tornai e cliccato sull'icona blu +500 –

+0

@BondedDust - Grazie. Questa è stata la generosa generosità. Dovrò tenere d'occhio altre domande su cui distribuirlo, e così diffondere l'allegria natalizia! –

4

io non lo chiamerei "elegante", ma per le liste senza nome si potrebbe fare qualche controllo/modifiche a qualcosa in questo senso "[[].]":.

s <- strsplit(gsub("\\[+\\d+\\]+", "", test), "\n+")[[1]][-1] 
lapply(s, function(x) scan(text = x, what = double(), quiet = TRUE)) 

[[1]] 
[1] 1.0000 1.9643 4.5957 

[[2]] 
[1] 1.0000 2.2753 3.8589 

[[3]] 
[1] 1.0000 2.9781 4.5651 

[[4]] 
[1] 1.0000 2.9320 3.5519 

[[5]] 
[1] 1.0000 3.5772 2.8560 

[[6]] 
[1] 1.0000 4.0150 3.1937 

[[7]] 
[1] 1.0000 3.3814 3.4291 

Naturalmente, questo è specifico soltanto liste e questo particolare esempio è specificamente what = double(), in modo che richiederebbe ulteriori Checki ng. Un'idea che mi salta in testa di rilevare gli elementi di carattere nella lista sarebbe quello di rendere l'argomento what

what = if(length(grep("\"", x))) character() else double() 
+0

Puoi verificare le linee vettoriali per la presenza di '" 'per determinare quale tipo di scansione esegui. –