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

$\endgroup$
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}}}
$\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$
  • 2
    $\begingroup$ The Cases[] variant: Cases[a : {__Integer} /; 1 <= Min[a] && Max[a] <= 3] /@ l. $\endgroup$ – J. M.'s discontentment Nov 13 '19 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$
  • 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 discontentment Nov 13 '19 at 16:11
10
$\begingroup$

Tersely:

Cases[{(1|2|3)..}] /@ l
| improve this answer | |
$\endgroup$
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
    $\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 discontentment Nov 13 '19 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$
5
$\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
    $\begingroup$ A slot-free variation: DeleteCases[l, {___, _?(Not @* Between[{1, 3}]), ___}, {2}]. $\endgroup$ – J. M.'s discontentment Nov 14 '19 at 10:46
3
$\begingroup$

My way to do it

l // Select[1 <= #[[1]] <= 3 &] /@ # &
| improve this answer | |
$\endgroup$
  • $\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 '19 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$ – wuyudi Dec 13 '19 at 9:08
3
$\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$
  • $\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 '19 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 '19 at 8:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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