traversing in nested R lists

burrow.R

burrow_find <- function(x,parent,regex = FALSE){
  
  if(grepl('(\\[|\\])',parent)){
    
    nx <- as.numeric(gsub('(\\[|\\])','',parent))
    
  }else{
    
    if(regex){
      nx <- grep(parent,names(x))  
    }else{
      nx <- match(parent,names(x))
    }
    
    if(length(nx)==0) return(NULL)
  }
  
  if(length(nx)==1){
    
    x[[nx]]
    
  }else{
    
    x <- x[nx]
    
    if(all(sapply(x,class)=='list')){
      x <- unlist(x,recursive = FALSE)
      attr(x,'add') <- paste0(names(x),collapse='|')
    }
    
    x
  }
}

#' @title xpath for lists
#' @description return objects inside a nested list
#' @param x list
#' @param path character, path to object
#' @param regex boolean, if turned on the regex is assumed for each level, Default: FALSE
#' @return child object of the path, if more than one parent is found then 
#' a list of children is returned
#' @details when regex if FALSE you can use index of a element instead of a name, with the
#' notation [number] eg [1].
#' @examples 
#'
#' require(dplyr)
#'
#' a  <- dplyr::tibble(x=list(
#' john = list(bob=dplyr::as_tibble(mtcars)%>%dplyr::slice(1:2),
#'             bobo=dplyr::as_tibble(iris)%>%dplyr::slice(1:2)),
#' johnny = list(bob=dplyr::as_tibble(mtcars)%>%dplyr::slice(1:5),
#'               bobo=dplyr::as_tibble(iris)%>%dplyr::slice(1:5))
#' )
#' )
#' 
#' a%>%burrow('x/johnny/bob')
#' 
#' a%>%burrow('x/john/[1]')
#' 
#' a%>%burrow('x/[1]/[2]')
#' 
#' a%>%burrow('x/john/bob',regex = TRUE)
#' 
#' a%>%burrow('x/john$/bob',regex = TRUE)
#' 
#' a%>%burrow('x/johnny/bob',regex = TRUE)
#' 
#' @rdname burrow
#' @export 

burrow <- function(x,path,regex=FALSE){
  
  s <- strsplit(path,'/')[[1]]
  
  if(length(s)>1){
    
    child <- paste0(s[-1],collapse='/')
    
    parent <- s[1]
    
    x <- burrow_find(x,parent,regex)
    
    if(!is.null(attr(x,'add'))){
      new_parent <- strsplit(attr(x,'add'),'\\|')[[1]]
      old_parent <- strsplit(child,'/')[[1]]
      old_child <- old_parent[1]
      
      old_parent[1] <- paste0(new_parent[grep(old_child,new_parent)],collapse = '|')
      child <- paste0(old_parent,collapse = '/')
      x <- x[grep(old_child,new_parent)]
    }
    
    burrow(x,child,regex)
    
  }else{
    
    parent <- s
    
    if(inherits(x,'list')&length(x)==1){
      x <- x[[1]]
    }
    
    out <- burrow_find(x,parent,regex)
    
    attr(out,'add') <- NULL
    
    out
    
  }
  
  
}