How to select 2 pairs of distinct twins form a list of 4-tuples?

Question

Given a list of 4-tuples as follows.

data = Tuples[Range@6, 4];

I want to select any 4-tuples with two pairs of different twins, for example, as follows:

• {1,2,1,2}
• {2,2,3,3}
• {4,5,5,4}
• etc

Attempt

First I select any association with length of 2 as follows

filter1 = Select[Counts /@ data, Length@# == 2 &]

Second I want to select only any association with value of 2. How to do this?

Answer 1

We can use Permutations once on {1, 1, 2, 2} to get a list of part indices and extract the associated Parts of each 2-subset of the base set:

positions = Permutations[{1, 1, 2, 2}];

pairs = Subsets[Range @ 6, {2}];

We can use pairs and positions with Outer or Distribute or Tuples:

res1 = Join @@ Outer[Part, pairs, positions, 1];

res2 == Part @@@ Distribute[{pairs, positions}, List];

res3 = Distribute[{pairs, positions}, List, List, List, Part];

res4 = Part @@@ Tuples[{pairs, positions}];

res5 = Tuples[p[pairs, positions]] /. p -> Part;

res1 == res2 == res3 == res4 == res5

True

You can also use Extract instead of Part:

res6 = Join @@ (Extract[#, List /@ positions] & /@ pairs);

res6 == res1

True

res1

Answer 2

Another way

Select[data, Values[Counts[#]] === {2, 2} &]

Answer 3

Try this:

Pick[data, Values[Counts[#]] === {2, 2} & /@ data]

A pattern based approach:

Cases[
 data,
 {x_, x_, y_, y_} | {x_, y_, x_, y_} | {x_, y_, y_, x_} /; x != y
 ]

or

Select[
 data,
 MatchQ[Sort[#], {x_, x_, y_, y_} /; x != y] &
 ]

Answer 4

Another approach is to construct the desired tuples directly without selection from a larger set:

Subsets[Range@6, {2}] // 
 Map[Join[#, #] &] // 
 Map[Permutations] // 
 Flatten[#, 1] &

Answer 5

Since the result of Permutations[{i, i, j, j}] is

    {{i, i, j, j}, {i, j, i, j}, {i, j, j, i}, {j, i, i, j}, {j, i, j, 
  i}, {j, j, i, i}}

We can use the method as below

Permutations[{#1, #1, #2, #2}] & @@@ Subsets[Range[6], {2}] // 
 Flatten[#, 1] &

Or

Permutations[{i, i, j, j}] /. Thread[{i, j} -> #] & /@ 
      Subsets[Range[6], {2}] // Flatten[#, 1] &

Or

Outer[#1 /. Thread[{i, j} -> #2] &, Permutations[{i, i, j, j}], 
      Subsets[Range[6], {2}], 1] // Flatten[#, 1] &

Answer 6

data//Extract[#,Position[Tally/@#, {{_,2},{_,2}}]]&

{{1, 1, 2, 2}, {1, 1, 3, 3}, {1, 1, 4, 4}, {1, 1, 5, 5}, {1, 1, 6, 6}, {1, 2, 1, 2}, {1, 2, 2, 1}, {1, 3, 1, 3}, {1, 3, 3, 1}, {1, 4, 1, 4}, {1, 4, 4, 1}, {1, 5, 1, 5}, {1, 5, 5, 1}, {1, 6, 1, 6}, {1, 6, 6, 1}, {2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 1}, {2, 2, 3, 3}, {2, 2, 4, 4}, {2, 2, 5, 5}, {2, 2, 6, 6}, {2, 3, 2, 3}, {2, 3, 3, 2}, {2, 4, 2, 4}, {2, 4, 4, 2}, {2, 5, 2, 5}, {2, 5, 5, 2}, {2, 6, 2, 6}, {2, 6, 6, 2}, {3, 1, 1, 3}, {3, 1, 3, 1}, {3, 2, 2, 3}, {3, 2, 3, 2}, {3, 3, 1, 1}, {3, 3, 2, 2}, {3, 3, 4, 4}, {3, 3, 5, 5}, {3, 3, 6, 6}, {3, 4, 3, 4}, {3, 4, 4, 3}, {3, 5, 3, 5}, {3, 5, 5, 3}, {3, 6, 3, 6}, {3, 6, 6, 3}, {4, 1, 1, 4}, {4, 1, 4, 1}, {4, 2, 2, 4}, {4, 2, 4, 2}, {4, 3, 3, 4}, {4, 3, 4, 3}, {4, 4, 1, 1}, {4, 4, 2, 2}, {4, 4, 3, 3}, {4, 4, 5, 5}, {4, 4, 6, 6}, {4, 5, 4, 5}, {4, 5, 5, 4}, {4, 6, 4, 6}, {4, 6, 6, 4}, {5, 1, 1, 5}, {5, 1, 5, 1}, {5, 2, 2, 5}, {5, 2, 5, 2}, {5, 3, 3, 5}, {5, 3, 5, 3}, {5, 4, 4, 5}, {5, 4, 5, 4}, {5, 5, 1, 1}, {5, 5, 2, 2}, {5, 5, 3, 3}, {5, 5, 4, 4}, {5, 5, 6, 6}, {5, 6, 5, 6}, {5, 6, 6, 5}, {6, 1, 1, 6}, {6, 1, 6, 1}, {6, 2, 2, 6}, {6, 2, 6, 2}, {6, 3, 3, 6}, {6, 3, 6, 3}, {6, 4, 4, 6}, {6, 4, 6, 4}, {6, 5, 5, 6}, {6, 5, 6, 5}, {6, 6, 1, 1}, {6, 6, 2, 2}, {6, 6, 3, 3}, {6, 6, 4, 4}, {6, 6, 5, 5}}