Select a subset in the bit-strings with even 1s overlapped - thank you

Model 1

Consider the permutation list of 4-bit-strings:

list = Permutations[{0, 0, 1, 1}, {4}]


which outputs:

{{0, 0, 1, 1}, {0, 1, 0, 1}, {0, 1, 1, 0}, {1, 0, 0, 1}, {1, 0, 1, 0}, {1, 1, 0, 0}}.

We like to select a subset among these six 4-bit-strings such that any of the two among the subset, will have an even number of bit 1 overlaps.

One way to proceed is to define

overlap[x_, y_] = x.y;


So when there is an even number of 1s overlap among x and y from the list, then

EvenQ[overlap[x, y]] outputs True.

What missing now is the last step, we need to ensure the enumeration, from the first {0, 0, 1, 1} to the last {1, 1, 0, 0} in the list, picking up any two, say x and y, they further satisfy the constraint EvenQ[overlap[x, y]] outputs True.

We expect the answer is {{0, 0, 1, 1}, {1, 1, 0, 0}}.

But a possible form to achieve this last step is something like using

Select, EvenQ, overlap[#, #]] &


But something like this fail:

subset = Select[list, EvenQ[overlap[#, #]] &]


What will be the correct way to select the subset (each with even 1s overlapped in the same position in the bit-string)?

I have some laborious way to do it by enumeration, but I like to hear experts shortcut to do it. Thank you!

Model 2

I like to elaborate another toy model to test the wonderful answer @lericr. lericr's answer got it right for 4-bit string; but not more general example.

Consider the permutation list of 8-bit-strings:

 list = Permutations[{ 1, 1, 1, 1, 0, 0, 0, 0}, {8}]


which outputs:

{{1, 1, 1, 1, 0, 0, 0, 0}, {1, 1, 1, 0, 1, 0, 0, 0}, {1, 1, 1, 0, 0, 1, 0, 0}, {1, 1, 1, 0, 0, 0, 1, 0}, {1, 1, 1, 0, 0, 0, 0, 1}, {1, 1, 0, 1, 1, 0, 0, 0}, {1, 1, 0, 1, 0, 1, 0, 0}, {1, 1, 0, 1, 0, 0, 1, 0}, {1, 1, 0, 1, 0, 0, 0, 1}, {1, 1, 0, 0, 1, 1, 0, 0}, {1, 1, 0, 0, 1, 0, 1, 0}, {1, 1, 0, 0, 1, 0, 0, 1}, {1, 1, 0, 0, 0, 1, 1, 0}, {1, 1, 0, 0, 0, 1, 0, 1}, {1, 1, 0, 0, 0, 0, 1, 1}, {1, 0, 1, 1, 1, 0, 0, 0}, {1, 0, 1, 1, 0, 1, 0, 0}, {1, 0, 1, 1, 0, 0, 1, 0}, {1, 0, 1, 1, 0, 0, 0, 1}, {1, 0, 1, 0, 1, 1, 0, 0}, {1, 0, 1, 0, 1, 0, 1, 0}, {1, 0, 1, 0, 1, 0, 0, 1}, {1, 0, 1, 0, 0, 1, 1, 0}, {1, 0, 1, 0, 0, 1, 0, 1}, {1, 0, 1, 0, 0, 0, 1, 1}, {1, 0, 0, 1, 1, 1, 0, 0}, {1, 0, 0, 1, 1, 0, 1, 0}, {1, 0, 0, 1, 1, 0, 0, 1}, {1, 0, 0, 1, 0, 1, 1, 0}, {1, 0, 0, 1, 0, 1, 0, 1}, {1, 0, 0, 1, 0, 0, 1, 1}, {1, 0, 0, 0, 1, 1, 1, 0}, {1, 0, 0, 0, 1, 1, 0, 1}, {1, 0, 0, 0, 1, 0, 1, 1}, {1, 0, 0, 0, 0, 1, 1, 1}, {0, 1, 1, 1, 1, 0, 0, 0}, {0, 1, 1, 1, 0, 1, 0, 0}, {0, 1, 1, 1, 0, 0, 1, 0}, {0, 1, 1, 1, 0, 0, 0, 1}, {0, 1, 1, 0, 1, 1, 0, 0}, {0, 1, 1, 0, 1, 0, 1, 0}, {0, 1, 1, 0, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 1, 1, 0}, {0, 1, 1, 0, 0, 1, 0, 1}, {0, 1, 1, 0, 0, 0, 1, 1}, {0, 1, 0, 1, 1, 1, 0, 0}, {0, 1, 0, 1, 1, 0, 1, 0}, {0, 1, 0, 1, 1, 0, 0, 1}, {0, 1, 0, 1, 0, 1, 1, 0}, {0, 1, 0, 1, 0, 1, 0, 1}, {0, 1, 0, 1, 0, 0, 1, 1}, {0, 1, 0, 0, 1, 1, 1, 0}, {0, 1, 0, 0, 1, 1, 0, 1}, {0, 1, 0, 0, 1, 0, 1, 1}, {0, 1, 0, 0, 0, 1, 1, 1}, {0, 0, 1, 1, 1, 1, 0, 0}, {0, 0, 1, 1, 1, 0, 1, 0}, {0, 0, 1, 1, 1, 0, 0, 1}, {0, 0, 1, 1, 0, 1, 1, 0}, {0, 0, 1, 1, 0, 1, 0, 1}, {0, 0, 1, 1, 0, 0, 1, 1}, {0, 0, 1, 0, 1, 1, 1, 0}, {0, 0, 1, 0, 1, 1, 0, 1}, {0, 0, 1, 0, 1, 0, 1, 1}, {0, 0, 1, 0, 0, 1, 1, 1}, {0, 0, 0, 1, 1, 1, 1, 0}, {0, 0, 0, 1, 1, 1, 0, 1}, {0, 0, 0, 1, 1, 0, 1, 1}, {0, 0, 0, 1, 0, 1, 1, 1}, {0, 0, 0, 0, 1, 1, 1, 1}}

Then we expect to Select a subset so the subset contains at least only 14 out of the original 70 of 8-bit-strings. I expect a Correct Answer like this:

Correct Answer:: {{1, 1, 1, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 1, 1, 1}, {1, 1, 0, 0, 1, 1, 0, 0}, {1, 1, 0, 0, 0, 0, 1, 1}, {0, 0, 1, 1, 1, 1, 0, 0}, {0, 0, 1, 1, 0, 0, 1, 1}, {1, 0, 1, 0, 1, 0, 1, 0}, {1, 0, 1, 0, 0, 1, 0, 1}, {0, 1, 0, 1, 1, 0, 1, 0}, {0, 1, 0, 1, 0, 1, 0, 1}, {1, 0, 0, 1, 1, 0, 0, 1}, {1, 0, 0, 1, 0, 1, 1, 0}, {0, 1, 1, 0, 1, 0, 0, 1}, {0, 1, 1, 0, 0, 1, 1, 0}}.

Note that the lericr's EvenNeighbors[list[[1]], list] somehow fails but produces a subset of 38 such 8-bit-strings --- among many of them have an odd number of 1s overlapped. For your eys, we find

EvenNeighbors[target_, list_] := Select[list, EvenQ[overlap[target, #]] &]
EvenNeighbors[list[[1]], list]


list = Permutations[{0, 0, 1, 1}, {4}]
(*    {{0, 0, 1, 1}, {0, 1, 0, 1}, {0, 1, 1, 0},
{1, 0, 0, 1}, {1, 0, 1, 0}, {1, 1, 0, 0}}    *)


Compute which members are connected by having an even-valued overlap:

m = Outer[Boole[EvenQ[#1 . #2]] &, list, list, 1]
(*    {{1, 0, 0, 0, 0, 1},
{0, 1, 0, 0, 1, 0},
{0, 0, 1, 1, 0, 0},
{0, 0, 1, 1, 0, 0},
{0, 1, 0, 0, 1, 0},
{1, 0, 0, 0, 0, 1}}    *)


This represents a graph:

g = AdjacencyGraph[m]


Find all cliques of this graph:

c = FindClique[g, ∞, All]
(*    {{3, 4}, {2, 5}, {1, 6}}    *)


Look at the elements of the first clique, as an example:

list[[c[[1]]]]
(*    {{0, 1, 1, 0}, {1, 0, 0, 1}}    *)


model 2

list = Permutations[{1, 1, 1, 1, 0, 0, 0, 0}, {8}];
m = Outer[Boole[EvenQ[#1 . #2]] &, list, list, 1];
c = FindClique[g, ∞, All];


For example, the first clique:

list[[c[[1]]]]
(*    {{1, 1, 1, 0, 0, 0, 0, 1},
{1, 1, 0, 1, 0, 0, 1, 0},
{1, 1, 0, 0, 1, 1, 0, 0},
{1, 0, 1, 1, 0, 1, 0, 0},
{1, 0, 1, 0, 1, 0, 1, 0},
{1, 0, 0, 1, 1, 0, 0, 1},
{1, 0, 0, 0, 0, 1, 1, 1},
{0, 1, 1, 1, 1, 0, 0, 0},
{0, 1, 1, 0, 0, 1, 1, 0},
{0, 1, 0, 1, 0, 1, 0, 1},
{0, 1, 0, 0, 1, 0, 1, 1},
{0, 0, 1, 1, 0, 0, 1, 1},
{0, 0, 1, 0, 1, 1, 0, 1},
{0, 0, 0, 1, 1, 1, 1, 0}}    *)

Outer[Dot, %, %, 1] // MatrixForm


$$\left( \begin{array}{cccccccccccccc} 4 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 0 \\ 2 & 4 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 0 & 2 \\ 2 & 2 & 4 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 0 & 2 & 2 \\ 2 & 2 & 2 & 4 & 2 & 2 & 2 & 2 & 2 & 2 & 0 & 2 & 2 & 2 \\ 2 & 2 & 2 & 2 & 4 & 2 & 2 & 2 & 2 & 0 & 2 & 2 & 2 & 2 \\ 2 & 2 & 2 & 2 & 2 & 4 & 2 & 2 & 0 & 2 & 2 & 2 & 2 & 2 \\ 2 & 2 & 2 & 2 & 2 & 2 & 4 & 0 & 2 & 2 & 2 & 2 & 2 & 2 \\ 2 & 2 & 2 & 2 & 2 & 2 & 0 & 4 & 2 & 2 & 2 & 2 & 2 & 2 \\ 2 & 2 & 2 & 2 & 2 & 0 & 2 & 2 & 4 & 2 & 2 & 2 & 2 & 2 \\ 2 & 2 & 2 & 2 & 0 & 2 & 2 & 2 & 2 & 4 & 2 & 2 & 2 & 2 \\ 2 & 2 & 2 & 0 & 2 & 2 & 2 & 2 & 2 & 2 & 4 & 2 & 2 & 2 \\ 2 & 2 & 0 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 4 & 2 & 2 \\ 2 & 0 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 4 & 2 \\ 0 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 2 & 4 \\ \end{array} \right)$$

• Thanks Roman +1. Could you try the Toy Model 2 above list = Permutations[{ 1, 1, 1, 1, 0, 0, 0, 0}, {8}] Note that lericr's answer seems to fail. Do you get the Correct Answer I computed analytically? Nov 15, 2023 at 19:48
• your new answer to Model 2 looks correct to me! Nov 15, 2023 at 19:54
• But just curious that Permutations[{1, 1, 1, 1, 0, 0, 0, 0}, {8}] generates {1, 1, 1, 1, 0, 0, 0, 0} as the first in the set. How come your final answer chooses a rather weird basis, not including {1, 1, 1, 1, 0, 0, 0, 0} as the first one? Nov 15, 2023 at 19:55
• I have no idea how FindClique works. If you don't like the ordering, try c = FindClique[g, ∞, All] // Sort; which gives a first answer that you may like better. Nov 15, 2023 at 20:00

If you want to find all pairs that have even overlap:

Select[Tuples[list, 2], EvenQ@*Apply[overlap]]


But you said

We expect the answer is {{0, 0, 1, 1}, {1, 1, 0, 0}}

so I'm not sure I understand your question.

Update

Oh, maybe you want to first select an element of list and use that to generate a subset of elements that have even overlap with the given one. Try this:

EvenNeighbors[target_, list_] := Select[list, EvenQ[overlap[target, #]] &]


Demonstration:

EvenNeighbors[list[[1]], list]
(* {{0, 0, 1, 1}, {1, 1, 0, 0}} *)


Update 2

We're looking for a set where every pair of members in the set has even overlap. So, define yet another function:

AppendIfEvenOverlap[neighborhood_, candidate_] :=
If[
AllTrue[overlap[candidate, #] & /@ neighborhood, EvenQ],
Append[neighborhood, candidate],
neighborhood]


The idea here is that given an existing group that satisfies the rule, we'll accept a new candidate if its inclusion still satisfies the rule. This function does no checking around whether the given neighborhood does indeed satisfy the rule, nor does it prevent a result with duplicates. You'd need to apply it so that it works as desired, which in your specific case could be something like this:

Fold[AppendIfEvenOverlap, {list[[1]]}, Rest@list]


assuming that list[[1]] was your desired generator/seed. If you want some other generator, then you'll probably want something like this:

Fold[AppendIfEvenOverlap, {list[[3]]}, DeleteCases[list, list[[3]]]]


Alternatively you could add in the pre-condition check and use Union to avoid duplications.

• thanks, even 1s overlap, the even can be 0, 2, 4, etc ..., any even integer! Let me see Nov 15, 2023 at 19:22
• THANKS - I VOTED UP. The answer works for this example. list = Permutations[{0, 0, 1, 1}, {4}] But this is not yet quite correct, for a generic example. Say, let us consider list = Permutations[{ 1, 1, 1, 1, 0, 0,0, 0}, {8}] Your EvenNeighbors gives some output that did not give rise to subset of bitstrings that have even 1s overlap. See the updated question Model 2 for clarity. Thanks! Nov 15, 2023 at 19:34
• I misunderstood your question (which I indicated in my answer was a possibility). Nov 15, 2023 at 21:33
• See update..... Nov 15, 2023 at 21:50