Selecting elements from a list under multiple conditions

Question

Suppose there is the following list:

l={{{3, 3, 3, 2}, {3, 3, 3, 1, 1}, {3, 3, 2, 2, 1}, {3, 3, 2, 1, 1, 
   1}, {3, 3, 1, 1, 1, 1, 1}, {3, 2, 2, 2, 2}, {3, 2, 2, 2, 1, 1}, {3,
    2, 2, 1, 1, 1, 1}, {3, 2, 1, 1, 1, 1, 1, 1}, {3, 1, 1, 1, 1, 1, 1,
    1, 1}, {2, 2, 2, 2, 2, 1}, {2, 2, 2, 2, 1, 1, 1}, {2, 2, 2, 1, 1, 
   1, 1, 1}, {2, 2, 1, 1, 1, 1, 1, 1, 1}, {2, 1, 1, 1, 1, 1, 1, 1, 1, 
   1}, {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}}, {{3, 3, 3, 3}, {3, 3, 3, 2,
    1}, {3, 3, 3, 1, 1, 1}, {3, 3, 2, 2, 2}, {3, 3, 2, 2, 1, 1}, {3, 
   3, 2, 1, 1, 1, 1}, {3, 3, 1, 1, 1, 1, 1, 1}, {3, 2, 2, 2, 2, 
   1}, {3, 2, 2, 2, 1, 1, 1}, {3, 2, 2, 1, 1, 1, 1, 1}, {3, 2, 1, 1, 
   1, 1, 1, 1, 1}, {3, 1, 1, 1, 1, 1, 1, 1, 1, 1}, {2, 2, 2, 2, 2, 
   2}, {2, 2, 2, 2, 2, 1, 1}, {2, 2, 2, 2, 1, 1, 1, 1}, {2, 2, 2, 1, 
   1, 1, 1, 1, 1}, {2, 2, 1, 1, 1, 1, 1, 1, 1, 1}, {2, 1, 1, 1, 1, 1, 
   1, 1, 1, 1, 1}, {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}}}

I want to select sublists that satisfy the following conditions:

1. Each sublist can at most have one 3.
2. Each sublist can at most have three 2s.
3. Each element can at most have three 1s.

The following sublists would remain:

{{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}

and the rest of sublists should be dropped. Is there a way to have more than one condition when selecting sublists from a nested list/array in this case?

Answer 1

In this case, a slightly more intricate approach using Counts[] is useful:

Select[(And @@ Thread[Lookup[Counts[#], {1, 2, 3}, 0] <= {3, 3, 1}]) &] /@ l
   {{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}

Answer 2

Pick[l, Map[Count[#, 3] < 2 && Count[#, 2] < 4 && Count[#, 1] < 4 &, 
l, {2}]]

{{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}

Answer 3

Pick[l, Map[VectorLessEqual[{BinCounts[#, {1/2, 3 + 1/2, 1}] , {3, 3, 1} }]&, l, {-2}] ]

{{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}

Answer 4

Using DeleteCases:

DeleteCases[l, {a___
  , OrderlessPatternSequence[
   Repeated[3, {2, ∞}] |
     Repeated[2, {4, ∞}] |
     Repeated[1, {4, ∞}]
   ]
  , b___
  }
 , {2}
 ]

{{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}

Answer 5

Using GroupBy, Count and Lookup:

Lookup[
    GroupBy[Join @@ l,
        Function[
            And[LessEqual[0, Count[#, 3], 1],
                    LessEqual[1, Count[#, 2], 3],
                    LessEqual[1, Count[#, 1], 3]
                ]
        ],
        Map[List, #] &
    ],
    True
 ]

(*{{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}*)

Or equivalently:

Lookup[
    Table[
        GroupBy[l[[i]],
            Function[
                    And[LessEqual[0, Count[#, 3], 1],
                        LessEqual[1, Count[#, 2], 3],
                        LessEqual[1, Count[#, 1], 3]
                    ]
                ]
        ],
        {i, 1, Length @l}
    ],
    True
 ]

 (*{{{3, 2, 2, 2, 1, 1}}, {{3, 2, 2, 2, 1, 1, 1}}}*)     

Answer 6

Not the shortest solution, but very readable (for me):

Extract[l,
 Position[{True ..}] @
  Query[All, All,
    {LessThan[2] @* Count[3],
     LessThan[4] @* Count[2],
     LessThan[4] @* Count[1]}] @ l]

{{3, 2, 2, 2, 1, 1}, {3, 2, 2, 2, 1, 1, 1}}