8
$\begingroup$

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?

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

7 Answers 7

Reset to default
5
$\begingroup$

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

enter image description here

Improve this answer
$\endgroup$
7
$\begingroup$

Another way

Select[data, Values[Counts[#]] === {2, 2} &]
Improve this answer
$\endgroup$
0
7
$\begingroup$

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] &
Improve this answer
$\endgroup$
0
6
$\begingroup$

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] &
Improve this answer
$\endgroup$
5
$\begingroup$

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

Improve this answer
$\endgroup$
3
$\begingroup$ 
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}}

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.