Use mapply or lapply to nested list - r

I want to apply a sample function to a nested list (I will call this list bb) and I also have a list of numbers (I will call this list k) to be supplied in the sample function. I would like each of the numbers in k to iterate through all the values of each list in bb. How to do this using mapply or lapply?
Here are the data:
k <- list(1,2,4,3) #this is the list of numbers to be supplied in the `sample.int` function
b1 <- list(c(1,2,3),c(2,3,4),c(3,4,5),c(4,5,6)) #The first list of bb
b2 <- list(c(1,2),c(2,3),c(3,4),c(4,5), c(5,6)) #The second list of bb
bb <- list(b1,b2) #This is list bb containing b1 and b2 whose values are to be iterated through
I created this mapply function but it didn't get the expected outcome:
mapply(function(x, y) {
x[sample.int(y,y, replace = TRUE)]
}, bb,k, SIMPLIFY = FALSE)
This only returns 10 output values but I would like each number of k to loop through all values of the two lists in bb and so there should be 10*2 outputs for the two lists in bb. I might be using mapply in the wrong way and so I would appreciate if anyone can point me to the right direction!

outer is your friend. It's normally used to calculate the outer matrix product. Consider:
outer(1:3, 2:4)
1:3 %o% 2:4 ## or
# [,1] [,2] [,3]
# [1,] 2 3 4
# [2,] 4 6 8
# [3,] 6 9 12
It also has a FUN= argument that defaults to "*". However it enables you to calculate any function over the combinations of x and y cross-wise, i.e. x[1] X y[1], x[1] X y[2], ... whereas *apply functions only calculate x[1] X y[1], x[2] X y[2], .... So let's do it:
FUN <- Vectorize(function(x, y) x[sample.int(y, y)])
set.seed(42)
res <- outer(bb, k, FUN)
res
# [,1] [,2] [,3] [,4]
# [1,] List,1 List,2 List,4 List,3
# [2,] List,1 List,2 List,4 List,3
This result looks a little weird, but we may easily unlist it.
res <- unlist(res, recursive=F)
Result
res
# [[1]]
# [1] 1 2 3
#
# [[2]]
# [1] 1 2
#
# [[3]]
# [1] 1 2 3
#
# [[4]]
# [1] 2 3 4
#
# [[5]]
# [1] 2 3
#
# [[6]]
# [1] 1 2
#
# [[7]]
# [1] 2 3 4
#
# [[8]]
# [1] 4 5 6
#
# [[9]]
# [1] 1 2 3
#
# [[10]]
# [1] 3 4 5
#
# [[11]]
# [1] 3 4
#
# [[12]]
# [1] 4 5
#
# [[13]]
# [1] 2 3
#
# [[14]]
# [1] 1 2
#
# [[15]]
# [1] 1 2 3
#
# [[16]]
# [1] 2 3 4
#
# [[17]]
# [1] 3 4 5
#
# [[18]]
# [1] 2 3
#
# [[19]]
# [1] 3 4
#
# [[20]]
# [1] 1 2
VoilĂ , 20 results.

Related

Find all combinations of the numbers in a vector. R programming

Are there any direct functions that can be used to get the combinations of all the items in the vector?
myVector <- c(1,2,3)
for (i in myVector)
for (j in myVector)
for (k in myVector)
print(paste(i,j,k,sep=","))
The screenshot of the first part of the output look like this. As there are three values 1,2,3 there will be
3 * 3 * 3 = 27 lines
I tried to get the permutations using the function permn() as,
permn(myVector)
But is giving only the 9 different values.
Screenshot of the output :
Is there any direct function that can produce such a result as shown in the first?
Using RcppAlgos::permuteGeneral.
r <- RcppAlgos::permuteGeneral(myVector, length(myVector), repetition=TRUE)
head(r, 3)
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 1 2
# [3,] 1 1 3
If you want the comma separated strings, do
apply(r, 1, paste, collapse=",")
# [1] "1,1,1" "1,1,2" "1,1,3" "1,2,1" "1,2,2" "1,2,3" "1,3,1"
# [8] "1,3,2" "1,3,3" "2,1,1" "2,1,2" "2,1,3" "2,2,1" "2,2,2"
# [15] "2,2,3" "2,3,1" "2,3,2" "2,3,3" "3,1,1" "3,1,2" "3,1,3"
# [22] "3,2,1" "3,2,2" "3,2,3" "3,3,1" "3,3,2" "3,3,3"
Or the list output, you've also shown
RcppAlgos::permuteGeneral(myVector, length(myVector), FUN=function(x)
paste(x, collapse=","), repetition=TRUE)
# [[1]]
# [1] "1,1,1"
#
# [[2]]
# [1] "1,1,2"
#
# [[3]]
# [1] "1,1,3"
#
# [[4]]
# [1] "1,2,1"
# ...
You may decide on your own :)
Use expand.grid :
tmp <- expand.grid(myVector, myVector, myVector)
tmp
# Var1 Var2 Var3
#1 1 1 1
#2 2 1 1
#3 3 1 1
#4 1 2 1
#5 2 2 1
#6 3 2 1
#...
#...
If you want to do this automatically for the length of myVector without manually specifying it 3 times you can use replicate.
tmp <- do.call(expand.grid, replicate(length(myVector),
myVector, simplify = FALSE))
To paste the values together you can do :
do.call(paste, c(tmp, sep = ','))
# [1] "1,1,1" "2,1,1" "3,1,1" "1,2,1" "2,2,1" "3,2,1" "1,3,1" "2,3,1"
# [9] "3,3,1" "1,1,2" "2,1,2" "3,1,2" "1,2,2" "2,2,2" "3,2,2" "1,3,2"
#[17] "2,3,2" "3,3,2" "1,1,3" "2,1,3" "3,1,3" "1,2,3" "2,2,3" "3,2,3"
#[25] "1,3,3" "2,3,3" "3,3,3"
Note that there is a permutations function in the gtools package that allows you to generalize permutation outputs:
library(gtools)
permutations(3, 3, 1:3, repeats.allowed = TRUE)
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 1 1 2
[3,] 1 1 3
[4,] 1 2 1
[5,] 1 2 2
[6,] 1 2 3
[7,] 1 3 1
[8,] 1 3 2
[9,] 1 3 3
[10,] 2 1 1
The function help describes the parameter settings.
It appears that pracma::combs does exactly this. That, and pracma::perms generate output sets which treat every element of the input as distinct, regardless of whether a value is repeated.

How to easily concatenate nested lists without losing the attributes?

I need a base solution to concatenate two lists into a specific nested structure while preserving the attributes.
Using c() gives me the wanted structure, but the attributes are gone.
Map(c, L1, L2)
# [[1]]
# [[1]][[1]]
# [1] 1 2
#
# [[1]][[2]]
# [1] 3 4
#
#
# [[2]]
# [[2]][[1]]
# [1] 1 2
#
# [[2]][[2]]
# [1] 3 4
Using list() saves the attributes, but I want the structure one level less deeply nested.
Map(list, L1, L2)
# [[1]]
# [[1]][[1]]
# [[1]][[1]][[1]]
# [1] 1 2
#
# attr(,"foo")
# [1] 42
#
# [[1]][[2]]
# [[1]][[2]][[1]]
# [1] 3 4
#
# attr(,"foo")
# [1] 42
#
#
# [[2]]
# [[2]][[1]]
# [[2]][[1]][[1]]
# [1] 1 2
#
# attr(,"foo")
# [1] 42
#
# [[2]][[2]]
# [[2]][[2]][[1]]
# [1] 3 4
#
# attr(,"foo")
# [1] 42
Finally following code gives me what I want
lapply(1:2, function(i) {
r <- c(L1[[i]], L2[[i]])
r[[1]] <- `attributes<-`(r[[1]], attributes(L1[[i]]))
r[[2]] <- `attributes<-`(r[[2]], attributes(L2[[i]]))
r
})
Is there perhaps a less awkward base R way to do this?
Wanted output
# [[1]]
# [[1]][[1]]
# [1] 1 2
# attr(,"foo")
# [1] 42
#
# [[1]][[2]]
# [1] 3 4
# attr(,"foo")
# [1] 42
#
#
# [[2]]
# [[2]][[1]]
# [1] 1 2
# attr(,"foo")
# [1] 42
#
# [[2]][[2]]
# [1] 3 4
# attr(,"foo")
# [1] 42
Data
L1 <- list(`attr<-`(list(1:2), "foo", 42), `attr<-`(list(1:2), "foo", 42))
L2 <- list(`attr<-`(list(3:4), "foo", 42), `attr<-`(list(3:4), "foo", 42))

multiply two lists of irregular length

I have lists like
a <- list(list(c(-2,1), 4:5, 2:3), list(c(0,2), c(-1,1)))
b <- list(7:9, c(5,-1))
> a
[[1]]
[[1]][[1]]
[1] -2 1
[[1]][[2]]
[1] 4 5
[[1]][[3]]
[1] 2 3
[[2]]
[[2]][[1]]
[1] 0 2
[[2]][[2]]
[1] -1 1
> b
[[1]]
[1] 7 8 9
[[2]]
[1] 5 -1
I want to multiply each of (-2, 1) from a[[1] with 7 from b[[1]] to get (-14, 7), each of (4, 5) with 8, each of (2, 3) with 9, and then each of (0, 2) with 5 and finally each of (-1, 1), with -1.
I can be sure that length(a[[i]])==length(b[[i]]) is TRUE for i=1,2 (in practice, i is way larger), so that there are the right number of entries for the desired multiplications.
However, it is not clear how many entries the a[[i]]) have (in the example, 3 for a[[1]] and 2 for a[[2]], or equivalently, how long the b[[i]] are), except that they'll have at least one entry. Hence, transforming a and b into matrices does not seem practical.
I am not sure that is relevant to the problem, but it will also be the case that we have as many entries in each of the a[[i]]) (i.e., 2) as we have a[[i]])s.
I was thinking of some combination of do.call and mapply, but could not get it to work.
We may indeed use mapply (and Map, which is the same as mapply but with SIMPLIFY = FALSE). Depending on the format (matrix as in #RonakShah's answer or a list as in your question), you may use
Map(mapply, a, b, MoreArgs = list(FUN = `*`))
# [[1]]
# [,1] [,2] [,3]
# [1,] -14 32 18
# [2,] 7 40 27
#
# [[2]]
# [,1] [,2]
# [1,] 0 1
# [2,] 10 -1
or
Map(Map, a, b, MoreArgs = list(f = `*`))
# [[1]]
# [[1]][[1]]
# [1] -14 7
#
# [[1]][[2]]
# [1] 32 40
#
# [[1]][[3]]
# [1] 18 27
#
#
#[[2]]
# [[2]][[1]]
# [1] 0 10
#
# [[2]][[2]]
# [1] 1 -1
A tidyverse alternative to the latter is
map2(a, b, map2, `*`)
Since, you can ensure length(a[[i]])==length(b[[i]]) we can use mapply inside lapply
lapply(seq_along(a), function(x) mapply("*", a[[x]], b[[x]]))
#[[1]]
# [,1] [,2] [,3]
#[1,] -14 32 18
#[2,] 7 40 27
#[[2]]
# [,1] [,2]
#[1,] 0 1
#[2,] 10 -1

List all combinations of strings that together cover all given elements

Say I am given the following strings:
1:{a,b,c,t}
2:{b,c,d}
3:{a,c,d}
4:{a,t}
I want to make a program that will give me all different combinations of these strings, where each combination has to include each given letter.
So for example the above combinations are strings {1&2, 1&3, 2&3&4, 1&2&3&4, 2&4}.
I was thinking of doing this with for loops, where the program would look at the first string, find which elements are missing, then work down through the list to find strings which have these letters. However I think this idea will only find combinations of two strings, and also it requires listing all letters to the program which seems very un-economical.
I think something like this should work.
sets <- list(c('a', 'b', 'c', 't'),
c('b', 'c', 'd'),
c('a', 'c', 'd'),
c('a', 't'))
combinations <- lapply(2:length(sets),
function(x) combn(1:length(sets), x, simplify=FALSE))
combinations <- unlist(combinations, FALSE)
combinations
# [[1]]
# [1] 1 2
#
# [[2]]
# [1] 1 3
#
# [[3]]
# [1] 1 4
#
# [[4]]
# [1] 2 3
#
# [[5]]
# [1] 2 4
#
# [[6]]
# [1] 3 4
#
# [[7]]
# [1] 1 2 3
#
# [[8]]
# [1] 1 2 4
#
# [[9]]
# [1] 1 3 4
#
# [[10]]
# [1] 2 3 4
#
# [[11]]
# [1] 1 2 3 4
u <- unique(unlist(sets))
u
# [1] "a" "b" "c" "t" "d"
Filter(function(x) length(setdiff(u, unlist(sets[x]))) == 0, combinations)
# [[1]]
# [1] 1 2
#
# [[2]]
# [1] 1 3
#
# [[3]]
# [1] 2 4
#
# [[4]]
# [1] 1 2 3
#
# [[5]]
# [1] 1 2 4
#
# [[6]]
# [1] 1 3 4
#
# [[7]]
# [1] 2 3 4
#
# [[8]]
# [1] 1 2 3 4
As a start...
I'll edit this answer when I have time. The following result is dependent on the order of choice. I haven't figured out how to flatten the list yet. If I could flatten it, I would sort each result then remove duplicates.
v = list(c("a","b","c","t"),c("b","c","d"),c("a","c","d"),c("a","t"))
allChars <- Reduce(union, v) # [1] "a" "b" "c" "t" "d"
charInList <- function(ch, li) which(sapply(li, function(vect) ch %in% vect))
locations <- sapply(allChars, function(ch) charInList(ch, v) )
# > locations
# $a
# [1] 1 3 4
#
# $b
# [1] 1 2
#
# $c
# [1] 1 2 3
#
# $t
# [1] 1 4
#
# $d
# [1] 2 3
findStillNeeded<-function(chosen){
haveChars <- Reduce(union, v[chosen])
stillNeed <- allChars[!allChars %in% haveChars]
if(length(stillNeed) == 0 ) return(chosen) #terminate if you dont need any more characters
return ( lapply(1:length(stillNeed), function(i) { #for each of the characters you still need
loc <- locations[[stillNeed[i]]] #find where the character is located
lapply(loc, function(j){
findStillNeeded(c(chosen, j)) #when you add this location to the choices, terminate if you dont need any more characters
})
}) )
}
result<-lapply(1:length(v), function(i){
findStillNeeded(i)
})

Splitting numeric vectors in R

If I have a vector, c(1,2,3,5,7,9,10,12)...and another vector c(3,7,10), how would I produce the following:
[[1]]
1,2,3
[[2]]
5,7
[[3]]
9,10
[[4]]
12
Notice how 3 7 and 10 become the last number of each list element (except the last one). Or in a sense the "breakpoint". I am sure there is a simple R function I am unknowledgeable of or having loss of memory.
Here's one way using cut and split:
split(x, cut(x, c(-Inf, y, Inf)))
#$`(-Inf,3]`
#[1] 1 2 3
#
#$`(3,7]`
#[1] 5 7
#
#$`(7,10]`
#[1] 9 10
#
#$`(10, Inf]`
#[1] 12
Could do
split(x, cut(x, unique(c(y, range(x)))))
## $`[1,3]`
## [1] 1 2 3
## $`(3,7]`
## [1] 5 7
## $`(7,10]`
## [1] 9 10
## $`(10,12]`
## [1] 12
Similar to #beginneR 's answer, but using findInterval instead of cut
split(x, findInterval(x, y + 1))
# $`0`
# [1] 1 2 3
#
# $`1`
# [1] 5 7
#
# $`2`
# [1] 9 10
#
# $`3`
# [1] 12

Resources