3
$\begingroup$

I have L which is a big list of small list as follows.

L = Tuples[{a, b, c, d}, 3]

I want to take only small lists containing exactly 2 identical elements, for example, {a,b,a}, {b,b,a}, {a,b,b}, etc but not {a,a,a}, {b,b,b} and {c,c,c}.

How to do so?

Edit

This question came in my mind while I was trying to compare my explicit calculation on the following problem with iteration performed by Mathematica.

Assume that there are only 365 days in a year. Among 250 students, what is the probability in which there is exactly a single pair consists of exactly 2 students with the same birthday?

I reduced the problem by changing the days to blood types and the 250 students to 3 students just for simplicity.

$\endgroup$
2
  • 1
    $\begingroup$ I think this question should be sharpened a bit. What if lists are of length 4, and there are two pairs of identical elements, say {a, a, b, b}? Should such a list be accepted? How about a case like {a, a, a, b, b}? Answer by @C.E. would accept this. Without more precision, multiple answers with differing results on extended cases of longer than 3-tuples are possible. $\endgroup$
    – kirma
    Aug 27, 2017 at 19:25
  • 1
    $\begingroup$ @kirma: See my edit. $\endgroup$ Aug 27, 2017 at 19:57

2 Answers 2

4
$\begingroup$
Select[L, 2 === Length@Union@# &]

Update: I realized that DeleteDuplicates should be slightly faster than Union even on small lists. If enough of them this could make a noticeable difference, so I figured I'd do some testing.

Setup, first build a large set of lists:

Length[L = Tuples[syms = a /@ Range[180], 3]]

output:

5832000

RepeatedTiming[Select[2 === Length@Union@# &]@L;]

{15.0, Null}

RepeatedTiming[Select[2 === Length@DeleteDuplicates@# &]@L;]

{14., Null}

So by the time we've got almost 6 million Unions vs DeleteDuplicates at length 3 lists it does make a bit of a difference.

And just to compare against the fastest (by far) of C.E.'s nice examples:

RepeatedTiming[ Cases[{Except[x_] ..., x_, Except[x_] ..., x_, Except[x_] ...}]@L;]

{14., Null}

so equivalent at this level of testing to the DeleteDuplicates example but faster than the original Union. All of these much faster than:

RepeatedTiming[Select[2 === Max@(Last /@ Tally[#]) &]@L;]

{41.061, Null}

$\endgroup$
2
$\begingroup$

Define

syms = {a, b, c, d};
l = Tuples[syms, 3]

A pattern based option:

Cases[l, {Except[x_] ..., x_, Except[x_] ..., x_, Except[x_] ...}]

and an option not using patterns:

ops = Count /@ syms;
Select[l, MemberQ[2]@*Through@*ops]
$\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.