8
$\begingroup$

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?

$\endgroup$

6 Answers 6

7
$\begingroup$

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}}}
$\endgroup$
7
$\begingroup$
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}}}

$\endgroup$
6
$\begingroup$
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}}}

$\endgroup$
3
$\begingroup$

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}}}

$\endgroup$
1
  • $\begingroup$ (+1) Nice, @Syed! $\endgroup$ Apr 12, 2023 at 5:08
2
$\begingroup$

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}}}*)     
$\endgroup$
3
  • 1
    $\begingroup$ The sublists must have at most one 3 meaning 0 or 1 entries. Perhaps you need a LessEqual there as well? $\endgroup$
    – Syed
    Apr 12, 2023 at 5:32
  • 1
    $\begingroup$ You're right Syed! Thanks for pointing that out. I'll correct it in a moment. :-) $\endgroup$ Apr 12, 2023 at 5:39
  • $\begingroup$ I've been trying to keep up with your work rate about list manipulations, and it's really training me. $\endgroup$ Apr 12, 2023 at 5:47
1
$\begingroup$

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}}

$\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.