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

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?

• data[[Flatten@Position[Sort /@ data, {x_, x_, y_, y_} /; x != y]]] does work as well but too complicated. Commented Sep 2, 2020 at 20:02
• As I love combinatorial approaches so the accepted answer must reflect it. Commented Sep 3, 2020 at 11:03

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


Another way

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


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] &


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] &


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] &
]

• @WissenMachtFrei Fixed that now. Commented Sep 2, 2020 at 19:38
• Thank you very much. As always, I am waiting for other answers (if any) before deciding the accepted answer. Commented Sep 2, 2020 at 19:43
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}}

data = Tuples[Range @ 6, 4];


Using Cases with OrderlessPatternSequence

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


{{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}}