# How to take lists containing exactly 2 identical elements?

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.

• 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. Aug 27, 2017 at 19:25
• @kirma: See my edit. Aug 27, 2017 at 19:57

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}

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]