# Select a list from a list of lists based on how often their elements are present

I have the following list of lists as an example:

L1 = {{1, 2, 4, 7}, {1, 7, 12, 15}, {1, 13, 3, 2}, {1, 15, 14, 13}, {2, 3, 23, 4}, {3, 13, 20, 24}, {3, 24, 22, 23}, {4, 8, 6, 7}, {4, 23, 32, 8}, {5, 6, 8, 31}, {5, 9, 10, 12}, {5, 12, 7, 6}, {5, 31, 28, 9}, {8, 32, 30, 31}, {9, 27, 11, 10}, {9, 28, 26, 27}, {10, 11, 15, 12}, {11, 16, 14, 15}, {11, 27, 17, 16}, {13, 14, 16, 20}, {16, 17, 18, 20}, {17, 25, 19, 18}, {17, 27, 26, 25}, {18, 19, 24, 20}, {19, 21, 22, 24}, {19, 25, 29, 21}, {21, 29, 30, 32}, {21, 32, 23,
22}, {25, 26, 28, 29}, {28, 31, 30, 29}};


I want to write something that gives the following selection as output:

Lnew = {{4, 23, 32, 8}, {5, 31, 28, 9}, {11, 27, 17, 16}, {19, 25, 29, 21}, {12, 15, 1, 7}, {3, 13, 20, 24} };


The criteria are as follows: Each number from Lnew should be present 4x in the original list of lists L1.

For example, the number 4 is four times present in L1: {1, 2, 4, 7}, {2, 3, 23, 4}, {4, 8, 6, 7} and {4, 23, 32, 8}.

The number 3 is only three times present in L1: {2, 3, 23, 4}, {3, 13, 20, 24} and {3, 24, 22, 23}. Similarly, the number 7 is also only present three times. The numbers 23, 32 and 8 are four times present. Therefore, only {4,23,32,8} should be present in the new list.

Does anyone know how I (a beginner in Mathematica) can tackle this without using too advanced code? Thank you :)

• What's the extra structure for? Why isn't Lnew just {4, 23, 32, 8, 5, 31, 28, 9, 11, 27, 17, 16, 19, 25, 29, 21, 12, 15, 1, 7, 3, 13, 20, 24} May 4, 2023 at 22:39
• "Therefore, only {4,23,32,8} should be present in the new list". But that's not the case. Lnew has 6 lists of 4 elements each. May 4, 2023 at 22:42
• Based on just the textual description, this would be pretty easy starting with something like Select[Counts[Flatten@L1], EqualTo[4]], but since I don't understand the extra structure, I'm not sure that's an acceptable answer. May 4, 2023 at 22:45
• "a beginner in Matlab". Did you mean "Mathematica"? May 4, 2023 at 22:46
• Oh, I think I see. The {4,23,32,8} is already in L1. So, were selecting elements from L1 that satisfy the criteria that each of their elements appears 4 times in the whole of L1. May 4, 2023 at 22:48

L1 = {{1, 2, 4, 7}, {1, 7, 12, 15}, {1, 13, 3, 2}, {1, 15, 14,
13}, {2, 3, 23, 4}, {3, 13, 20, 24}, {3, 24, 22, 23}, {4, 8, 6,
7}, {4, 23, 32, 8}, {5, 6, 8, 31}, {5, 9, 10, 12}, {5, 12, 7,
6}, {5, 31, 28, 9}, {8, 32, 30, 31}, {9, 27, 11, 10}, {9, 28, 26,
27}, {10, 11, 15, 12}, {11, 16, 14, 15}, {11, 27, 17, 16}, {13,
14, 16, 20}, {16, 17, 18, 20}, {17, 25, 19, 18}, {17, 27, 26,
25}, {18, 19, 24, 20}, {19, 21, 22, 24}, {19, 25, 29, 21}, {21,
29, 30, 32}, {21, 32, 23, 22}, {25, 26, 28, 29}, {28, 31, 30,
29}};

items2bRemoved = Counts[Flatten[L1]] // Select[# != 4 &] // Keys

DeleteCases[L1, _?(ContainsAny[items2bRemoved])]


{{1, 7, 12, 15}, {3, 13, 20, 24}, {4, 23, 32, 8}, {5, 31, 28, 9}, {11, 27, 17, 16}, {19, 25, 29, 21}}

• Could I also make a new list of lists containing the {a,b,c,d} lists that were deleted using this method? That would be L2 = {{1, 2, 4, 7}, {1, 13, 3, 2}, {1, 15, 14, 13}, {2, 3, 23, 4}, {3, 24, 22, 23}, {4, 8, 6, 7}, {5, 6, 8, 31}, {5, 9, 10, 12}, {5, 12, 7, 6}, {8, 32, 30, 31}, {9, 27, 11, 10}, {9, 28, 26, 27}, {10, 11, 15, 12}, {11, 16, 14, 15}, {13, 14, 16, 20}, {16, 17, 18, 20}, {17, 25, 19, 18}, {17, 27, 26, 25}, {18, 19, 24, 20}, {19, 21, 22, 24}, {21, 29, 30, 32}, {21, 32, 23, 22}, {25, 26, 28, 29}, {28, 31, 30, 29}}. May 5, 2023 at 13:21
• @PTeeuwen, Use Cases instead of DeleteCases.
– Syed
May 5, 2023 at 13:25
With[
{counts = Counts[Flatten@L1]},
Select[L1, Lookup[counts, #] === {4, 4, 4, 4} &]]

• Thank you! I just found another option that I posted in a comment. May 4, 2023 at 23:13
Select[MinMax[Count[L1, #, 2] & /@ #] == {4, 4} &] @L1

{{1, 7, 12, 15}, {3, 13, 20, 24}, {4, 23, 32, 8}, {5, 31, 28, 9},
{11, 27, 17, 16}, {19, 25, 29, 21}}


This seems to work.

Lnew = { };
For[i = 0, i<= Length[L1]-1, i++;
n = { };
For[j = 0, j<= Length[L1[[i]]]-1, j++;
AppendTo[n, Count[Flatten[L1], L1[[i]][[j]]]]
]
If[AllTrue[n, # == 4&], AppendTo[Lnew, L1[[i]]]
]
]
Lnew