2014-11-30 17 views
11

Ktoś właśnie opublikował niektóre dane wyjściowe konsoli jako przykład. (Dzieje się tak dużo i mam strategie konwertowania wydruków dla wektorów i ramek danych.) Zastanawiam się, czy ktoś ma elegancką metodę analizowania tego na prawdziwą listę R?Konwersja listy wyjściowej konsoli do rzeczywistej listy R

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" 

To jest przykład z nazwanych imieniem i UN-węzłów:

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 

Pracowałam przez kodeks jak str obsługuje list, ale to robi w zasadzie odwrotną transformację. Sądzę, że musi to być nieco ustrukturyzowane wzdłuż tych linii, gdzie będzie rekursywne wywołanie czegoś podobnego do tej logiki, ponieważ listy mogą być nazwane (w których będzie "$" poprzedzający ostatni indeks) lub nienazwane (w takim przypadku pojawi się numer zamknięty w

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

Poważnie, poproś o wyjście 'dput'. Jeśli tego nie zapewnią, odrzuć głos i przejdź dalej. Możesz * użyć * monstrum, takiego jak lapply (readLines (textConnection (gsub) ("\ n (? = \ N) | \\ [\\ [\\ d * \\] \\] \ n | \\ [\ \ d * \\] "," ", test, perl = TRUE))), funkcja (x) scan (textConnection (x)))', ale nie zrobiłbym tego. – Roland

+0

Zgadzam się z Rolandem. Alternatywną monstrualnością jest 'read.delim (text = gsub (" \\ [+ \\ d + \\] + "," ", test), header = FALSE, sep =" ")' ale działa tylko w tym przypadku. – Andrie

+0

@Andrie. Nawet tu nie działa. Podaje 3-kolumnową ramkę danych zamiast 7-elementowej listy. –

Odpowiedz

8

Oto mój strzał w roztworze. Działa dobrze zarówno w testach, jak i na kilku innych testach.

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

Z L, twój bardziej skomplikowana lista przykładów, oto co daje:

## 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 

A oto jak to obsługuje reprezentacji wydruku test, swoją bardziej regularne listę:

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 

Jeszcze jeden przykład:

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

Działa również dla mnie Dzięki –

+0

Miałem zamiar dać nagrodę wczoraj i myślałem, że robię to poprzez zaznaczenie odpowiedziałem, ale dostałem dzisiaj wiadomość ostrzegającą mnie, że wkrótce wygaśnie, więc wróciłem i kliknąłem niebieską ikonę +500 –

+0

@BondedDust - Dzięki, to była hojna nagroda. Będę musiał uważać na niektóre inne pytania, na które można go dystrybuować, a więc rozsiewać świąteczną radość! –

4

nie nazwałbym go „elegancki”, ale dla anonimowych listach można zrobić kilka sprawdzanie/zmiany do czegoś wzdłuż tych linii „[[].]”.

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 

Oczywiście dotyczy to wyłącznie list i tym konkretnym przykładem jest konkretnie what = double(), więc wymagałoby to dodatkowego checki ng. Pomysł, który pojawia się w mojej głowie, aby wykryć elementy postać w liście byłoby uczynić what argumentem

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

Możesz przetestować linie wektorowe na obecność '' ', aby określić jakiego rodzaju' skanuj' uruchomisz –