What you want is some sort of indexing nested lists based on names (as we
are used to for vectors, for example). As Ivan pointed out, I don't think
there's an "out-of-the-box" function in R that supports such indexing as it
requires some sort of mapping of the nested list's hierarchical structure.
At first I thought one could use the information of 'as.relistable()' and
'relist()' in some way, but I couldn't really make use of it. 

So this is my own solution for retrieving all "branch names" of an arbitrary
deeply nested list together with their recursive indexes which you then can
use to index/access a branch of your choice. I'm sure there are more elegant
ways, but at least it does the trick ;-). Currently requires that all
branches are named and names at a branch are unique(!). E.g., this is fine:
my.list=list(a=list(a.1=list(...), a.2=list(...)), b=list(...)); something
like this is not supported yet: my.list=list(a=list(a.1=list(...),
a.1=list(...)), a=list(...))). One could use regular expressions to handle
"stubs" of names. Right now you must use the "absolute path name" (e.g.
"a$a.1$a.1.1) of a branch to access it (you get this info via
'listnames.get()', though). But it should be easy to handle "stubs" (e.g.
"a.1.1" only) as well.

The two function defs and an example:

##### FUNCTION DEFS #####

listnames.get <- function(
        list.obj,                       
        do.basename=FALSE,      
        do.name.chain=TRUE,
        ...
)
{
        # VALIDATE
        if(!is.list(list.obj)) stop("Argument 'list.obj' must be a list.")
        # /
        
        
#---------------------------------------------------------------------------
        # CORE FUNCTION
        
#---------------------------------------------------------------------------
        
        listnames.get.core <- function(
                # CUSTOM:
                list.obj,               
                do.basename=FALSE,
                do.name.chain=TRUE,
                buffer,
                ...
        )
        {       
                if(!exists("index", buffer))
        {
                        buffer$index    <- new.env(parent=emptyenv())
                        buffer$index    <- NULL
                        buffer$name             <- NULL
                }
#x=1            
                jnk <- sapply(1:length(list.obj), function(x)

                {
                        list.branch     <- list.obj[x]
                        list.branch.nme <- names(list.branch)
                        if(do.basename) list.branch.nme <-
basename(list.branch.nme)
                        list.obj.updt   <- list.branch[[1]]
                        
                        # UPDATE BUFFER
                        buffer$run              <- c(buffer$run, x)
                        if(do.name.chain)
                        {
#                               buffer$name             <-
paste(buffer$name, list.branch.nme, sep="$")
                                buffer$name             <- c(buffer$name,
list.branch.nme)
                        } else
                        {
                                buffer$name             <- list.branch.nme
                        }
                        # /
                        
                        index.crnt              <-
paste(as.character(buffer$run), collapse="-")
                        index.crnt              <- data.frame(
                                name=paste(buffer$name, collapse="$"), 
                                index=index.crnt,
                                stringsAsFactors=FALSE
                        )
                        index.updt              <- rbind(buffer$index,
index.crnt)
                        buffer$index    <- index.updt                   
                        
                        if(is.list(list.obj.updt))
                        {                               
                                listnames.get.core(
                                        list.obj=list.obj.updt,
                                        do.basename=do.basename,
                                        do.name.chain=do.name.chain,
                                        buffer=buffer
                                )
                        }
                        
                        # UPDATE BUFFER
                        buffer$run      <- buffer$run[-length(buffer$run)]
                        buffer$name     <- buffer$name[-length(buffer$name)]

                        # /
                        
                        return(NULL)
                })
                
                return(TRUE)
        }
        
        # /CORE FUNCTION ----------
        
        
#---------------------------------------------------------------------------
        # APPLICATION
        
#---------------------------------------------------------------------------
        
        assign("buffer", new.env(parent=emptyenv()), envir=environment())
        
        listnames.get.core(
                list.obj=list.obj,
                do.basename=do.basename,
                buffer=buffer
        )       
        
        # /APPLICATION ----------
                
        return(buffer$index)
}

listbranch.get <- function(
        list.obj,
        query,
        do.strict=TRUE,
        do.rtn.val=TRUE,
        msg.error=NULL,
        ...
)
{
        # VALIDATE
        if(!is.list(list.obj)) stop("Argument 'list.obj' must be a list.")
        # /
        
        # ESTABLISH LIST INDEX
        list.index      <- listnames.get(
                list.obj=list.obj, 
                do.basename=TRUE,
                do.name.chain=TRUE
        )
        list.index.nms <- list.index$name
        # /
        
        query.0 <- query
        # SEARCH FOR QUERY
        if(do.strict)
    {
                query <- gsub("\\$", "\\\\$", query)
                query <- gsub("\\.", "\\\\.", query)
                query <- paste("^", query, "$", sep="")
        } else
        {
                stop("'do.strict = FALSE not supported yet as it may result
in multiple results.")
        }
        idx <- grep(query, list.index.nms, perl=TRUE)

        if(!length(idx))
        {
                if(is.null(msg.error))
                {
                        msg.error <- paste("Query not successful: '",
query.0, "' ('", query, "')", sep="")
                }
                stop(cat(msg.error, sep="\n"))
        }
        # /
        
        # BUILDING RECURSIVE INDEX
        idx <- list.index$index[idx]
        idx <- as.numeric(unlist(strsplit(idx, split="-")))
        # /
        
        if(do.rtn.val)
        {
                # RECURSIVE INDEXING
                rtn <- list.obj[[idx]]  
                # /
        } else
        {
                rtn <- idx
        }
        
        return(rtn)
}

##### EXAMPLE #####

my.list <- list(
        a=list(a.1="a", a.2=list(a.2.1="a", a.2.2="b"), a.3=list(a.3.1="a"),
        b=list(b.1=list(b.1.1="a"), b.2="b"),
        c="a"
))

# RETRIEVE 'COMPLETE' INDEX (A DATA FRAME; NAMES AND INDEX)
listnames.get(list.obj=my.list, do.basename=TRUE, do.name.chain=TRUE)

# GET RECURSIVE INDEX ONLY
idx <- listbranch.get(list.obj=my.list, query="a$a.2$a.2.2",
        do.strict=TRUE, do.rtn.val=FALSE)
my.list[[idx]]

# GET RECURSIVELY INDEXED 'BRANCH CONTENT' DIRECTLY
my.list.sub <- listbranch.get(list.obj=my.list, query="a$a.2$a.2.2",
        do.strict=TRUE, do.rtn.val=TRUE)
my.list.sub

Hope this helps,
Janko

> -----Ursprüngliche Nachricht-----
> Von: r-help-boun...@r-project.org [mailto:r-help-boun...@r-project.org] Im
> Auftrag von Friedericksen Hope
> Gesendet: Donnerstag, 11. November 2010 09:05
> An: r-h...@stat.math.ethz.ch
> Betreff: [R] How to get a specific named element in a nested list
> 
> Hello,
> 
> I have a nested named list structure, like the following:
> 
> x <- list(
>       list(
>          list(df1,df2)
>          list(df3,
>               list(df4,df5))
>       list(df6,df7)))
> 
> with df1...d7 as data frames. Every data frame is named.
> 
> Is there a way to get a specific named element in x?
> 
> so, for example,
> 
> x[[c("df5")]] gives me the data frame 5?
> 
> Thank you in advance!
> 
> Best,
> Friedericksen
> 
> ______________________________________________
> R-help@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.

______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.

Reply via email to