Selecting elements of a list based on range

Suppose I have the following list:

l={{{5}, {4, 1}, {3, 2}, {3, 1, 1}, {2, 2, 1}, {2, 1, 1, 1}, {1, 1, 1,
1, 1}}, {{6}, {5, 1}, {4, 2}, {4, 1, 1}, {3, 3}, {3, 2, 1}, {3, 1,
1, 1}, {2, 2, 2}, {2, 2, 1, 1}, {2, 1, 1, 1, 1}, {1, 1, 1, 1, 1,
1}}}

I want to select those elements that have entries from 1 to 3, such that I get:

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

namely we dropped the elements that have integers beyond the range 1 to 3. I can not figure out how to use selection command in this case and wonder if selection is the best way at all?

When in doubt, one can always take the straightforward approach:

Select[VectorQ[#, IntegerQ[#] && Between[#, {1, 3}] &] &] /@ l
{{{3, 2}, {3, 1, 1}, {2, 2, 1}, {2, 1, 1, 1}, {1, 1, 1, 1, 1}},
{{3, 3}, {3, 2, 1}, {3, 1, 1, 1}, {2, 2, 2}, {2, 2, 1, 1},
{2, 1, 1, 1, 1}, {1, 1, 1, 1, 1, 1}}}

Tersely:

Cases[{(1|2|3)..}] /@ l

Another possibility:

l /. a:{__Integer} /; Min[a]<1 || Max[a]>3 -> Nothing

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

• The Cases[] variant: Cases[a : {__Integer} /; 1 <= Min[a] && Max[a] <= 3] /@ l. Commented Nov 13, 2019 at 15:48

If you're interested in an idiomatic approach that uses curried operators:

Select[AllTrue[Between[{1, 3}]]] /@ l

edit

When there are only a few different integers you want to retain, the following is also an option:

Select[ContainsOnly[Range[1, 3]]] /@ l
• Very nice. If you want to incorporate the check for integer entries: Select[AllTrue[Through @* (IntegerQ && Between[{1, 3}])]] /@ l. Commented Nov 13, 2019 at 16:11

Another approach:

Pick[l, Map[ContainsOnly[#, Range[3]] &, l, {2}], True]

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

• The third argument of Pick[] is True by default, so Pick[l, Map[ContainsOnly[#, Range[3]] &, l, {2}]] suffices. A variation: Pick[l, Map[Complement[#, {1, 2, 3}] === {} &, l, {2}]]. Commented Nov 13, 2019 at 15:52
Map[Select[FreeQ[0]]] @ Clip[l, {1, 3}, {0, 0}]

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

DeleteCases[l, {___, _?(!Between[#, {1, 3}] &), ___}, {2}]

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

• A slot-free variation: DeleteCases[l, {___, _?(Not @* Between[{1, 3}]), ___}, {2}]. Commented Nov 14, 2019 at 10:46

my function:

Pick[l, And @@@ # & /@ Map[Abs[#] <= 3 &, l, {3}]]

Now since it has been a while since I used mathematica i decided to seize the opportunity and run some benchmarks so that I could refresh my memory while doing something fun. please if you have any advice or if you notice any error feel free to point them out.

For simplicity i have generated a 2 2-level list composed by 1000000 nested lists with variable lenght and different range of elements:

list = RandomInteger[{1, 5}, #] & /@ RandomInteger[{1, 5}, 1000000];
list2 =  RandomInteger[{1, 5}, #] & /@ RandomInteger[{1, 500}, 1000000];

then, starting from the solutions you guys provided, I defined some functions and each one of them has been given the name of the authors. I had to slightly modify them in order to make them work with my sample list, I hope I didn't make a mess. i will run the benchmark again if necessary.

jmfun[a_List] := Select[VectorQ[#, IntegerQ[#] && Between[#, {1, 3}] &] &]@a;
carlfun[b_List] := b /. a : {__Integer} /; Min[a] < 1 || Max[a] > 3 -> Nothing;
sjoerdfun[c_List] := Select[ContainsOnly[Range[1, 3]]]@c;
sjoerdfun2[c_List] := Select[AllTrue[Between[{1, 3}]]]@c;
jmxsjoerdfun[a_List] := Select[AllTrue[Through@*(IntegerQ && Between[{1,3}])]]@a;
wizarfun[a_List] := Cases[{(1 | 2 | 3) ..}]@a;
alxfun[c_List] := Pick[c, Map[ContainsOnly[#, Range[3]] &, c, {1}]];
jmxalxfun[c_List] := Pick[c, Map[Complement[#, {1, 2, 3}] === {} &, c]];
kglrfun[c_List] := Select[##, FreeQ[0]] &@Clip[c, {1, 3}, {0, 0}];
subafun[c_List] := DeleteCases[c, {___, _?(! Between[#, {1, 3}] &), ___}, {1}];
alucardfun[d_List] := Pick[d, And @@@ Map[ Abs[# ] <= 3 &, d, {2}]];

you may notice i didn't add wuyudi's answer to the benchmark, the reason is that I don't understand anymore how it works and hence I could not define a working function with it.

the code i used for the benchmark:

authors = {  jmfun,   carlfun, sjoerdfun , sjoerdfun2 , jmxsjoerdfun,
wizarfun, alxfun, jmxalxfun, kglrfun, subafun, alucardfun};
results = {AbsoluteTiming[#[list]][[1]], #} & /@ authors // Sort;
results2 = {AbsoluteTiming[#[list2]][[1]], #} & /@ authors // Sort;

in the end the results were plotted on 2 different barchart plots. the first one has a linear scale:

Rasterize[
Labeled[Framed[
BarChart[results[[;; , 1]], ChartStyle -> "DarkRainbow",
AxesLabel -> Automatic, ChartLegends -> results[[;; , 2]],
ChartLabels ->
Placed[results[[;; , 2]], Above, Rotate[#, 67 Degree] &],
LabelStyle -> Directive[Blue, Thick, Italic],
ScalingFunctions -> "Log"]], " test 1: Linear plot", Top,
LabelStyle ->
Directive[Bold, FontFamily -> "Helvetica", FontSize -> 18]]]

the second one with a logarithmic scale:

Rasterize[
Labeled[Framed[
BarChart[results2[[;; , 1]], ChartStyle -> "DarkRainbow",
AxesLabel -> Automatic, ChartLegends -> results[[;; , 2]],
ChartLabels ->
Placed[results[[;; , 2]], Above, Rotate[#, 67 Degree] &],
LabelStyle -> Directive[Blue, Thick, Italic],
ScalingFunctions -> "Log"]], " test 2: Log plot", Top,
LabelStyle ->
Directive[Bold, FontFamily -> "Helvetica", FontSize -> 18]]]

which gives :

• Thanks for the benchmarking. A few points: (1) In alucardfun you have the unbound Symbol list which I think is unintentional. (2) I think you can use results = {AbsoluteTiming[#[list]][[1]], #} & /@ authors // Sort (3) Consider adding a second benchmark with longer sublists, e.g. RandomInteger[{1, 500}, 100000] and using ScalingFunctions -> "Log" in BarChart. Commented Dec 12, 2019 at 8:00
• Ah yes, I missed that list. thank you for your advices, I will fix everything this afternoon Commented Dec 12, 2019 at 8:14

My way to do it

l // Select[1 <= #[[1]] <= 3 &] /@ # &
• While your formula works with the supplied data, if you change the list l to include another element such as {1,1,5}, it fails. The general problem statement is that we should select any list with elements that are between 1 and 3 and you are only checking the first element for that condition. Commented Dec 13, 2019 at 8:02
• @MarkR actually,you can use this to test l={{{1}, {3, 4}}, {3}}, the code given from others almost can't deal with it. That's the reason why this sort of list is unrecommended in mma. Commented Dec 13, 2019 at 9:08
list =
{{{5}, {4, 1}, {3, 2}, {3, 1, 1}, {2, 2, 1}, {2, 1, 1, 1}, {1, 1, 1, 1, 1}},
{{6}, {5, 1}, {4, 2}, {4, 1, 1}, {3, 3}, {3, 2, 1},
{3, 1, 1, 1}, {2, 2, 2}, {2, 2, 1, 1}, {2, 1, 1, 1, 1}, {1, 1, 1, 1, 1, 1}}};

Using SequenceSplit (new in 11.3)

f[a_, b_] :=
Catenate @ SequenceSplit[#, {x_} /; ! ContainsOnly[x, b]] & /@ a
f[list, {1, 2, 3}]

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

f[list, #] & /@ {{2, 3}, {1}, {2}, {3}} // Column

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

l = {{{5}, {4, 1}, {3, 2}, {3, 1, 1}, {2, 2, 1}, {2, 1, 1, 1}, {1, 1,
1, 1, 1}}, {{6}, {5, 1}, {4, 2}, {4, 1, 1}, {3, 3}, {3, 2, 1}, {3,
1, 1, 1}, {2, 2, 2}, {2, 2, 1, 1}, {2, 1, 1, 1, 1}, {1, 1, 1, 1,
1, 1}}}

l /. v_?VectorQ /; MemberQ[v, Except[Alternatives @@ Range[3]]] :>
Nothing

Result:

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