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

Improve this question
$\endgroup$

5 Answers 5

Reset to default
6
$\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}}}
Improve this answer
$\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}}}

Improve this answer
$\endgroup$
5
$\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}}}

Improve this answer
$\endgroup$
2
$\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}}}

Improve this answer
$\endgroup$
1
  • $\begingroup$ (+1) Nice, @Syed! $\endgroup$
    – E. Chan-López
    Apr 12 at 5:08
1
$\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}}}*)
Improve this answer
$\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 at 5:32
  • 1
    $\begingroup$ You're right Syed! Thanks for pointing that out. I'll correct it in a moment. :-) $\endgroup$
    – E. Chan-López
    Apr 12 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$
    – E. Chan-López
    Apr 12 at 5:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.