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$
    – Display Name
    Commented Sep 2, 2020 at 20:02
  • $\begingroup$ As I love combinatorial approaches so the accepted answer must reflect it. $\endgroup$
    – Display Name
    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$
    – C. E.
    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$
    – Display Name
    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$

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.