8
$\begingroup$

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?

Improve this question
$\endgroup$

9 Answers 9

Reset to default
7
$\begingroup$

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

Tersely:

Cases[{(1|2|3)..}] /@ l
Improve this answer
$\endgroup$
10
$\begingroup$

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

Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ The Cases[] variant: Cases[a : {__Integer} /; 1 <= Min[a] && Max[a] <= 3] /@ l. $\endgroup$
    – J. M.'s eventual burnout ♦
    Nov 13, 2019 at 15:48
10
$\begingroup$

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
Improve this answer
$\endgroup$
1
  • 2
    $\begingroup$ Very nice. If you want to incorporate the check for integer entries: Select[AllTrue[Through @* (IntegerQ && Between[{1, 3}])]] /@ l. $\endgroup$
    – J. M.'s eventual burnout ♦
    Nov 13, 2019 at 16:11
8
$\begingroup$

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

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ 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}]]. $\endgroup$
    – J. M.'s eventual burnout ♦
    Nov 13, 2019 at 15:52
7
$\begingroup$ 
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}}}}

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

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ A slot-free variation: DeleteCases[l, {___, _?(Not @* Between[{1, 3}]), ___}, {2}]. $\endgroup$
    – J. M.'s eventual burnout ♦
    Nov 14, 2019 at 10:46
4
$\begingroup$

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

enter image description here

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 :

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Mr.Wizard
    Dec 12, 2019 at 8:00
  • $\begingroup$ Ah yes, I missed that list. thank you for your advices, I will fix everything this afternoon $\endgroup$
    – Alucard
    Dec 12, 2019 at 8:14
3
$\begingroup$

My way to do it

l // Select[1 <= #[[1]] <= 3 &] /@ # &
Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – Mark R
    Dec 13, 2019 at 8:02
  • $\begingroup$ @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. $\endgroup$
    – AsukaMinato
    Dec 13, 2019 at 9:08

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.