Optimal output by given input: looping through two lists

user_12367858 0
Viewed 52

I want to find the optimal order/combination for a vector of length 9. Optimal in the meaning that three of the same symbols are a "bingo" and I want the most bingos.

To do this I think I have to loop through two lists: the vector indices (simulating a 3x3 matrix, bingos are horizontally, vertically and diagonally) and the combinations. I have done the following:

#data
input <- sample(c("A", "B", "C"), 9, replace = TRUE)
input_perm <- combinat::permn(input)

#simulating 3x3 matrix bingos: horizontally, vertically, diaginally
m <- list(
r1 = 1:3,
r2 = 4:6,
r3 = 7:9,
c1 = c(1, 4, 7),
c2 = c(2, 5, 8),
c3 = c(3, 6, 9),
d1 = c(1, 5, 9),
d2 = c(3, 5, 7))


output <- character()
for ( i in seq_along(m)) {
output[i] <- ifelse (length(unique(input[m[[i]]])) == 1, TRUE , FALSE) 
}
output <- list(output)

So I can do this for one possibility but how do I do this for all using the input_perm?

My desired output will be a list all combinations (362880)

[[1]]
[1] FALSE FALSE  TRUE  TRUE FALSE  TRUE FALSE FALSE

[[2]]
[1] FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE

[[3]]
[1]  TRUE  TRUE FALSE  TRUE FALSE FALSE  TRUE FALSE

and so on... so that I can filter the combinations with most bingos:

output[which.max(lapply(output, sum))]

But I think there will be a much better solution than looping through two list. Thanks in advance.

r
2 Answers

We may use a nested loop

out2 <- lapply(input_perm, function(inp) 
     unname(sapply(m, function(x) length(unique(inp[x])) == 1)))

-output

head(out2)
[[1]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[2]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[3]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[4]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[5]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[6]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE

Or if we use the for loop

out3 <- vector('list', length(input_perm))
for(i in seq_along(out3)) {
    tmp <- logical(length(m))
    for(j in seq_along(m)) {
       tmp[j] <- length(unique(input_perm[[i]][m[[j]]])) == 1
      }
     out3[[i]] <- tmp
}

-output

head(out3)
[[1]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[2]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[3]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[4]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[5]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE  TRUE

[[6]]
[1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE
user_37322710

Maybe you can try the base R code below

mat <- outer(
    seq_along(input_perm),
    seq_along(m),
    FUN = Vectorize(function(p, q) length(unique(input_perm[[p]][m[[q]]])) == 1)
)
rSum <- rowSums(mat)
res <- subset(mat, rSum == max(rSum))
user_121587570
Related