3
$\begingroup$

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] 

Wrong Answer: {{1,1,1,1,0,0,0,0},{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,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},{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,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,0,0,1,1,1,1}}

$\endgroup$

2 Answers 2

5
$\begingroup$
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]

enter image description here

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];
g = AdjacencyGraph[m];
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) $$

$\endgroup$
4
  • $\begingroup$ 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? $\endgroup$
    – wonderich
    Nov 15, 2023 at 19:48
  • $\begingroup$ your new answer to Model 2 looks correct to me! $\endgroup$
    – wonderich
    Nov 15, 2023 at 19:54
  • $\begingroup$ 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? $\endgroup$
    – wonderich
    Nov 15, 2023 at 19:55
  • $\begingroup$ 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. $\endgroup$
    – Roman
    Nov 15, 2023 at 20:00
2
$\begingroup$

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.

$\endgroup$
4
  • $\begingroup$ thanks, even 1s overlap, the even can be 0, 2, 4, etc ..., any even integer! Let me see $\endgroup$
    – wonderich
    Nov 15, 2023 at 19:22
  • $\begingroup$ 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! $\endgroup$
    – wonderich
    Nov 15, 2023 at 19:34
  • $\begingroup$ I misunderstood your question (which I indicated in my answer was a possibility). $\endgroup$
    – lericr
    Nov 15, 2023 at 21:33
  • $\begingroup$ See update..... $\endgroup$
    – lericr
    Nov 15, 2023 at 21:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.