I have a list in R:
my_list <- list(a = 1, b = 2, c = list(d = 4, e = 5))
Suppose I don't know the structure of the list, but I know that somewhere in this list, there is an element named d, nested or not. I would like to:
Subset that list element, without knowing the structure of the master list that contains it
Know the name of its parent list (i.e. element c)
Is there an easy method / package that can solve this seemingly simple problem?
I'm implementing the suggestion by #r2evans. I'm sure this can be improved:
getParentChild <- function(lst, myN) {
myFun <- function(lst, myN) {
test <- which(names(lst) == myN)
if (length(test) > 0)
return(lst[test])
lapply(lst, function(x) {
if (is.list(x))
myFun(x, myN)
})
}
temp <- myFun(lst, myN)
temp[!sapply(temp, function(x) is.null(unlist(x)))]
}
getParentChild(my_list, "d")
$c
$c$d
[1] 4
Here is a more complicate example that illustrates how getParentChild shows lineage when there are multiple children/grandchildren.
exotic_list <- list(a = 1, b = 2, c = list(d = 4, e = 5), f = list(g = 6, h = list(k = 7, j = 8)), l = list(m = 6, n = list(o = 7, p = 8)), q = list(r = 5, s = 11), t = 12)
getParentChild(exotic_list, "n")
$l
$l$n
$l$n$o
[1] 7
$l$n$p
[1] 8
Here's another recursive approach, very similar to #JosephWood's answer, that generalizes the solution such that you can search for multiple elements at the same time, and find all the matching elements, if there are multiple:
find_all <- function(x, elements) {
lists <- vapply(x, is.list, logical(1)) # find sublists
# find all elements in sublists
out <- lapply(x[lists], find_all, elements)
out <- out[!vapply(out, is.null, logical(1))]
# output any found elements
if (any(elements %in% names(x)))
out <- c(out, x[names(x) %in% elements])
if (length(out) == 0) NULL else out
}
The example problem:
my_list <- list(a = 1, b = 2, c = list(d = 4, e = 5))
str(find_all(my_list, "e"))
#> List of 1
#> $ c:List of 1
#> ..$ e: num 5
And #JosephWood's exotic example complicted further:
exotic_list <-
list(
a = 1,
b = 2,
c = list(d = 4, e = 5),
f = list(g = 6, h = list(k = 7, j = 8)),
l = list(m = 6, n = list(o = 7, p = 8)),
q = list(r = 5, s = 11),
t = 12,
n = 13
)
str(find_all(exotic_list, c("n", "q")))
#> List of 3
#> $ l:List of 1
#> ..$ n:List of 2
#> .. ..$ o: num 7
#> .. ..$ p: num 8
#> $ q:List of 2
#> ..$ r: num 5
#> ..$ s: num 11
#> $ n: num 13
Using the purrr package we could also get rid of the vapplys, making the
function a little bit more succinct, and perhaps a bit more readable, too:
library(purrr)
find_all2 <- function(x, elements) {
# find all elements in sublists
out <- map(keep(x, is.list), find_all, elements)
out <- compact(out) # drop nulls
# output any found elements
if (any(elements %in% names(x)))
out <- c(out, x[names(x) %in% elements])
if (length(out) == 0) NULL else out
}
identical(
find_all(exotic_list, c("n", "q")),
find_all2(exotic_list, c("n", "q"))
)
#> [1] TRUE
Created on 2018-03-15 by the reprex package (v0.2.0).
Maybe something like the following will do what you want.
wanted <- "d"
inx <- grep(wanted, names(unlist(my_list)), value = TRUE)
unlist(my_list)[inx]
#c.d
# 4
sub(paste0("(\\w)\\.", wanted), "\\1", inx)
#[1] "c"
Related
Suppose I have function that returns a list
fun <- function()
{
return(list(c(1,2,3), c(4,5,6), c(7,8,9)))
}
Now writing fun() gives me
[[1]]
[1] 1 2 3
[[2]]
[1] 4 5 6
[[3]]
[1] 7 8 9
But is there a way to get something like this?
list(c(1,2,3),
c(4,5,6),
c(7,8,9))
EDIT: how can I preserve both a nice output and a possibility of making operations on the list that is returned?
I think you're probably wanting a prettified version of dput:
fun <- function(x) {
text_con <- textConnection("output", "w")
dput(x, text_con)
close(text_con)
formatR::tidy_source(text = output, args.newline = TRUE, width = 40)
}
So for example:
mylist <- list(c(1,2,3), c(4,5,6), c(7,8,9))
fun(mylist)
#> list(
#> c(1, 2, 3),
#> c(4, 5, 6),
#> c(7, 8, 9)
#> )
EDIT
If you want a list to be printed in a particular way, but otherwise maintain all of the functionality of a list, it's probably best to create an S3 class with its own printing method:
special_list <- function(...) structure(list(...), class = "special_list")
as.special_list <- function(x) `class<-`(as.list(x), "special_list")
print.special_list <- function(x) {
text_con <- textConnection("output", "w")
dput(unclass(x), text_con)
close(text_con)
formatR::tidy_source(text = output, args.newline = TRUE, width = 40)
invisible(x)
}
Now you can create a special_list like this:
my_list <- special_list(a = c(1, 2, 3), b = letters[1:3])
my_list
#> list(
#> a = c(1, 2, 3),
#> b = c("a", "b", "c")
#> )
and it retains the functionality of any other list
my_list$a <- 2 * my_list$a
my_list
#> list(
#> a = c(2, 4, 6),
#> b = c("a", "b", "c")
#> )
It just means that you need to make a special_list instead of a normal list if you want to print a list this way. If you want to create a special_list from an existing list, you can do:
newlist <- list(a = 1:3)
newlist
#> $a
#> [1] 1 2 3
newlist <- as.special_list(newlist)
newlist
#> list(a = 1:3)
this function returns exactly that - but I may have misunderstood
print_list <- function(x){
cat("list(", paste(x, collapse="\n "), ")", sep="")
}
print_list(fun())
Adding that to your existing function:
fun <- function(){
cat("list(", paste(list(c(1,2,3), c(4,5,6), c(7,8,9)), collapse="\n "), ")", sep="")
}
As noted in the comments, you could (if not bothered about the line breaks) use dput(fun())
I have a list of list like ll:
ll <- list(a = list(data.frame(c = 1, d = 2), data.frame(h = 3, j = 4)), b = list(data.frame(c = 5, d = 6), data.frame(h = 7, j = 9)))
I want to unnest/unlist the last level of the structure (the interior list). Note that every list contains the same structure. I want to obtain lj:
lj <- list(a = (data.frame(c = 1, d = 2, h = 3, j = 4)), b = data.frame(c = 5, d = 6, h = 7, j = 9))
I have tried the following code without any success:
lj_not_success <- unlist(ll, recursive = F)
However, this code unlists the FIRST level, not the LAST one.
Any clue?
We may need to cbind the inner list elements instead of unlisting as the expected output is a also a list of data.frames
ll_new <- lapply(ll, function(x) do.call(cbind, x))
-checking
> identical(lj, ll_new)
[1] TRUE
I have some R-function f, which fixes some parameters of some other function target (thanks to GKi for help):
target <- function(b1,b2,l1,l2,l3,o1,o2) return((b1+b2+l1+l2+l3+o1+o2)^2)
fixed <- c(b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5)
variable <- c("o2","b2")
f <- function(fixed, variable) {
target_new <- function() {}
formals(target_new) <- setNames(rep(list(bquote()), length(variable)), variable)
for(i in variable) assign(i, as.symbol(i))
body(target_new) <- do.call("call", unlist(list("target", mget(variable), as.list(fixed))))
return(target_new)
}
f(fixed,variable)
> function (o2, b2)
> target(o2 = o2, b2 = b2, b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5)
> <environment: 0x0000020a8e0c0c88>
I want to maximize target_new by nlm, so I need to concentrate its function arguments into a vector, i.e. the desired output of f(fixed,variable) is
> function (theta)
> target(o2 = theta[1], b2 = theta[2], b1 = 1, l1 = 2, l2 = 3, l3 = 4, o1 = 5)
How to modify the above code, so that the function can process the vector theta?
Please mind that the vectors fixed and variable can be of variable lengths.
You are making this too complicated.
f <- function(fixed, variable) {
function(theta) {
args <- c(as.list(theta), as.list(fixed))
names(args)[seq_along(variable)] <- variable
do.call(target, args)
}
}
fun <- f(fixed, variable)
#does it work?
all.equal(
nlm(fun, p = c(1, 2)),
nlm(function(theta) target(1,theta[2], 2, 3, 4, 5, theta[1]),
p = c(1, 2))
)
#[1] TRUE
I have the following list that I wish to unpack (aka expand) using only base R.
For example, I want to turn this:
b <- list(a = c(1, 2), b = 1, d = c(5, 7))
into the equivalent of:
list(a = 1, a = 2, b = 1, d = 5, d = 7)
I have this function that works if only one named element has length > 1 but not if there are multiple elements:
expand_list <- function(listx){
long_elements <- as.numeric(which(lapply(listx, length) > 1))
short_elements <- as.numeric(which(lapply(listx, length) == 1))
res <- lapply(long_elements, function(x){
as.list(setNames(listx[[x]], rep(names(listx)[x], length(listx[[x]]))))
})
expanded_elements <- res[[1]]
c(listx[short_elements], expanded_elements)
}
expand_list(b)
You can use stack followed by setNames to achieve that
y <- list(a = c(1, 2), b = 1, c = 2, d = c(5, 7))
x <- stack(y)
as.list(setNames(x$values, x$ind))
I have list out like this:
u <- list(a = list(b = 1, c = 2),
x = list(k = list(ka = 1, kb = 3),
l = list(la = 1, la = 4)))
v <- list(a = list(b = 1, c = 2),
x = list(m = list(ma = 5, mb = 8),
n = list(na = 5, nb = 8)))
w <- list(a = list(b = 1, c = 2),
x = list(o = list(oa = 4, ob = 1),
p = list(pa = 8, pb = 0)))
out <- list(u, v, w)
I would like to create another list where there are elements k, l, m, n, o, p and names of the list elements are preserved. I found a solution, but looks sub-optimal:
x <- lapply(out, function(y) y[['x']])
o <- list()
for (a in x) {
o <- c(o, a)
}
> str(o, max.level = 1)
List of 6
$ k:List of 2
$ l:List of 2
$ m:List of 2
$ n:List of 2
$ o:List of 2
$ p:List of 2
Is there a better way?
The loop could be replaced with unlist:
res <- unlist( lapply(out,"[[","x"), recursive=FALSE)
identical(res,o)
# [1] TRUE
My lapply is the same as in the OP; it's just a shortcut.
As #akrun suggested, you could more closely mirror the OP's loop with
do.call("c", lapply(out, '[[', 'x'))