R Recursively Create Set of Solutions Based on Uniqueness and Overlap Factor-CodePudding

I have a set of solutions, but I'm trying to parse them down to make them more different from one another by using a max overlap. Here's the solution set (and a view of the zero's and one's - they're binary variables indicating whether or not things A-F are chosen), and my pseudocode attempt to solve it (more details below the code):

solutions <- list(c(1, 0, 0, 1, 1, 1), c(0, 1, 0, 0, 1, 1), c(0, 1, 0, 1, 1, 1), c(1, 0, 0, 1, 0, 1))

1 0 0 1 1 1
0 1 0 0 1 1
0 1 0 1 1 1
1 0 0 1 0 1

# Pseudocode attempt
k = 2 #max allowed overlaps
i = 1 #counter

final_solutions <- list() #list of final solutions that are valid

while (i <= length(solutions)) {
    if (i == 1) { #putting the first solution in, no checking
        final_solutions[i] <- solutions[[i]]
    }
    j = 0 #number of overlaps 
    for (member in final_solutions) { #iterate through all solutions that have been validated
        if overlap(solution[[i]], member) > k {
              j = j   1
        }
    }
    if (j == 0) { final_solutions <- append(final_solutions, solution[[i]]) }
}

Basically I'm now trying to iterate through this list and only keep solutions that share at most two common 1's with the other solutions in the set.

So, first I would take the first solution (1, 0, 0, 1, 1, 1) and add it into my set.

Next I would look at (0, 1, 0, 0, 1, 1). It shares the 1 in the last two positions with the first solution, so that's fine and it would be added.

Next, I look at the third solution, (0, 1, 0, 1, 1, 1). It shares the 1 in the last three positions with the first solution, as well as the second 1 and the last two 1's with the second solution. It is not added to the set.

Finally, looking at the fourth solution (1, 0, 0, 1, 0, 1) - its three 1's are shared with the first solution, so it is not added.

I'm thinking something like the pseudocode above but would appreciate any help / help with fixing that syntax as I'm not very good with lists!

CodePudding user response：

If you want a recursive way, here might be one option by defining a recursion fucntion f

f <- function(lst) {
  if (length(lst) == 1) {
    return(lst)
  }
  nlst <- tail(lst, 1)
  plst <- head(lst, -1)
  v <- Recall(plst)
  if (all(nlst[[1]] %*% do.call(cbind,plst) <= 2)) {
    v <- c(v, nlst)
  }
  v
}

and you will see

> f(solutions)
[[1]]
[1] 1 0 0 1 1 1

[[2]]
[1] 0 1 0 0 1 1

Or, we can use Reduce but following the same idea

Reduce(
  function(x, y) {
    if (all(y %*% do.call(cbind, x) <= 2)) {
      return(c(x, list(y)))
    }
    x
  },
  solutions[-1],
  init = solutions[1]
)

which gives

[[1]]
[1] 1 0 0 1 1 1

[[2]]
[1] 0 1 0 0 1 1