13
$\begingroup$

How can one find the range in which a number falls, from given list of numbers?

f[x_, list_List] := ???
(*
Return {a,b} where
a & b belongs to list
{a,b} forms shortest possible interval which match condition
if a<=x<=b {a,b}
if x <= a {-∞,a}
if x >= b {b,∞}
*)

f Should also consider outer ranges $-\infty$ and $\infty $

$\endgroup$
3
  • $\begingroup$ And what do you want to happen with f if x is an element of list? $\endgroup$ Commented Jan 21, 2012 at 10:16
  • $\begingroup$ it should return two ranges then $\endgroup$ Commented Jan 21, 2012 at 10:21
  • $\begingroup$ And when there is only one element in the list , and if it is x then it should return {{-∞,x},{x,∞}} $\endgroup$ Commented Jan 21, 2012 at 10:26

13 Answers 13

12
$\begingroup$

Interpolation

I propose using Interpolation.

list = Prime ~Array~ 3000;
intf = Interpolation[
         {list, Range@Length@list}\[Transpose],
         InterpolationOrder -> 0
       ];

Then, for point x:

x = 12225.4;

Which[
 x < First@list , {-∞, First@list},
 x > Last@list  , {Last@list, ∞},
 True           , list[[#-1 ;; #]]& @ intf @ x
]
{12211, 12227}

This could all be done inside Interpolation as well:

intf2 =
  Interpolation[
    Join[
      {{First@list, {-∞, 2}}},
      Thread[{Rest@list, Partition[list, 2, 1]}],
      {{Last@list + 1, {Last@list, ∞}}}
    ],
    InterpolationOrder -> 0
  ];

intf2[12225.4]
{12211, 12227}

Ordering

The method above was written from the perspective of repeated searching within the same list, and as noted in the comments it is assumed that the input list is sorted and free of duplicates.

If these assumptions do not hold other methods become appealing. After a review of others answers seeking inspiration, including those by kglr, celtschk and Leonid, I find Leonid's use of UnitStep to have great promise but his function is hobbled by the comparatively slow function Position. We can replace it with a use of Ordering.

  • This function requires a sorted list as input, but including the overhead of Sort I still find it faster than other methods I tried such as a separate application of Ordering in an earlier revision of this answer.

  • I use an explicit Subtract for performance.

Code:

seekOrdered[x_, list_] /; x < First @ list := {-∞, First @ list}

seekOrdered[x_, list_] /; x >= Last @ list := {Last @ list, ∞}

seekOrdered[x_, list_] := 
  list[[# ;; # + 1]] & @@ Ordering[UnitStep @ Subtract[x, list], -1]

Here are comparative timings including Leonid's getInterval, celtschk's function, and a variation of kglr's interval2 using Replace rather than ReplaceList to return a single interval (in the case of ambiguous matches) for somewhat better performance. (Credit to Ali Hashmi for noting this.)

The various functions I am comparing take slightly different interpretations of the end point behavior requested therefore output does not precisely match. It should be possible to change the behavior of my function with a bit of tinkering should that be required for a particular application.

The other functions as I will be timing them:

getInterval[ints_List, num_] := 
  Position[UnitStep[ints - num], 1, 1, 
    1] /. {{{1}} -> {-Infinity, First@ints}, {} -> {Last@ints, Infinity}, {{n_}} :> 
     ints[[n - 1 ;; n]]};

celtsF[x_, list_List] := 
 Module[{pos = Last@Ordering@Ordering[Append[list, x]]}, 
  Which[pos == 1, {-Infinity, First@list}, 
   pos == Length[list] + 1, {Last@list, Infinity}, True, list[[{pos - 1, pos}]]]]

interval2fast[x_, list_List] := 
 Replace[#, {___, a_, x, b_, ___} :> {a, b}] &@
  Join[{-Infinity}, Sort[Join[list, {x}]], {Infinity}]

Benchmark 1:

list = Prime ~Array~ 3000;

xs = RandomInteger[{-100, 30000}, 5000];

interval2fast[#, list] & /@ xs;  // RepeatedTiming // First
getInterval[list, #] & /@ xs;    // RepeatedTiming // First
celtsF[#, list] & /@ xs;         // RepeatedTiming // First
seekOrdered[#, list] & /@ xs;    // RepeatedTiming // First

1.25

0.5890

0.224

0.114

With a packed input list:

list = Developer`ToPackedArray @ list;

(* other code the same *)

1.16

0.5370

0.129

0.0689

With Reals rather than Integers for the search elements:

xs = RandomReal[{-100, 30000}, 5000];

(* other code the same *)

1.54

0.5674

0.855

0.0981

With Reals rather than Integers for the list:

list = Sort @ RandomReal[27000, 3000];

(* other code the same *)

1.88

0.552

0.129

0.0895

Of course for this repeated application Interpolation is faster still:

intf2 /@ xs; // RepeatedTiming // First // Quiet

0.0112

$\endgroup$
3
  • $\begingroup$ Yet another non-obvious gem +1 $\endgroup$
    – kglr
    Commented Jan 21, 2012 at 13:05
  • 3
    $\begingroup$ This method requires pre-sorted input data without duplicates. For an arbitrary list you need to pre-process the list with DeleteDuplicates@Sort or Union. Interpolation gives error messages when input data is unsorted or contains duplicates. $\endgroup$
    – kglr
    Commented Jan 21, 2012 at 16:06
  • $\begingroup$ @kguler Indeed. Thank you for stating that. I made assumptions on the meaning and structure of a "given list of numbers." $\endgroup$
    – Mr.Wizard
    Commented Jan 22, 2012 at 7:09
11
$\begingroup$

You can make use of BinCounts. I think this is a very simple to understand solution because BinCounts does almost exactly what you need already.

f[x_, list_List] :=
 Module[{bins},
  bins = Join[{-Infinity}, Sort[list], {Infinity}];
  First@Pick[Partition[bins, 2, 1], BinCounts[{x}, {bins}], 1]
 ]

But it won't give you two intervals if the number is part of both. Of course it's very easy to put in an extra check and include this feature if you need it, but I just wanted to show the concept now.

$\endgroup$
0
6
$\begingroup$

Assuming the list list is already ordered, the following should answer your question:

f[x_,list_List]:=
  Module[{pos=Last@Ordering@Ordering[Append[list,x]]},
    Which[pos==1,{-Infinity,First@list},
          pos==Length[list]+1,{Last@list,Infinity},
          True,list[[{pos-1,pos}]]]]
$\endgroup$
1
  • $\begingroup$ I just largely recreated this method without intending to copy your answer. +1 of course, and sorry for not noticing this answer long ago. My code performs somewhat faster because I used the second parameter of Ordering thereby avoiding a full second pass. My current answer is written to include the sort explicitly, but for a direct comparison see the code in this revision. $\endgroup$
    – Mr.Wizard
    Commented Feb 5, 2017 at 1:34
6
$\begingroup$

My favorite:

 interval[x_,list_List]:=ReplaceList[Append[Prepend[Sort@list, -Infinity], 
        Infinity], {___, a_, b_, ___} /; (a <= x <= b) :> {a, b}]

EDIT: Much faster if we eliminate the condition checking as follows:

 interval2[x_, list_List] := ReplaceList[#, {___, a_, x, b_, ___} :> {a, b}  ] &@
   Join[{-Infinity}, Sort[Join[list, {x}]], {Infinity}]
$\endgroup$
17
  • $\begingroup$ This is clever, but it is going to be quite inefficient. This is 10,000X slower than InterpolatingFunction on the data in my answer. This may or may not matter, but it should be noted. $\endgroup$
    – Mr.Wizard
    Commented Jan 21, 2012 at 12:30
  • $\begingroup$ Mr.Wizard, i agree. Both your InterpolatingFunction method and Pick-based method in my other answer (after removing Sort from the definition) are uncomparably faster than ReplaceList. However, ReplaceList and pattern-based approaches often have this hard-to-resist simplicity. $\endgroup$
    – kglr
    Commented Jan 21, 2012 at 13:02
  • 1
    $\begingroup$ @AliHashmi I just checked again and I find ReplaceList marginally slower on the test currently at the bottom of my answer. $\endgroup$
    – Mr.Wizard
    Commented Feb 5, 2017 at 0:51
  • 1
    $\begingroup$ @AliHashmi I think I got it right this time. Since I have your eyes on it would you mind checking for me? $\endgroup$
    – Mr.Wizard
    Commented Feb 5, 2017 at 1:27
  • 1
    $\begingroup$ @AliHashmi I took a break for dinner but now I am playing with this problem again. Contrary to an earlier statement ReplaceList does produce different output, e.g. interval2[2, {1, 2, 3}] gives {{1, 2}, {2, 3}}, but that is not the output requested in the Question. Perhaps kglr will comment when he is surprised to see this long chain of comments on an old post. $\endgroup$
    – Mr.Wizard
    Commented Feb 5, 2017 at 3:21
6
$\begingroup$

Here is another version:

ClearAll[getInterval];
getInterval[ints_List, num_] :=
 Position[UnitStep[ints - num], 1, 1, 1] /.
  {
    {{1}} -> { -Infinity, First@ints},
    {} -> {Last@ints, Infinity},
    {{n_}} :> ints[[n - 1 ;; n]]
  };
$\endgroup$
1
  • $\begingroup$ Now this is really fast !! wish there was a +2 here $\endgroup$
    – Ali Hashmi
    Commented Feb 5, 2017 at 0:34
5
$\begingroup$
intervals[x_, list_List] :=
  Cases[
    Partition[Flatten[{-Infinity, Union[list], Infinity}], 2, 1]
  , {l_, u_} /; l <= x <= u
  ]

Use cases:

In[53]:= intervals[3, Range[10]]
Out[53]= {{2,3},{3,4}}

In[54]:= intervals[3, 2 * Range[10]]
Out[54]= {{2,4}}

intervals[-3, Range[10]]
Out[55]= {{-∞,2}}

In[56]:= intervals[999, Range[10]]
Out[56]= {{10,∞}}

In[58]:= intervals[37, {13,8,1,28,87,14,61,20,91,92,37,93,76,83,32}]
Out[58]= {{32,37},{37,61}}
$\endgroup$
2
  • 1
    $\begingroup$ While working on this question I was surprised to find that out Sort[{4, 3, 2, 1, -∞, ∞}] yielded {1, 2, 3, 4, -∞, ∞} (and Union too). $\endgroup$
    – WReach
    Commented Jan 21, 2012 at 22:54
  • 3
    $\begingroup$ That's because Sort[] uses OrderedQ[] by default. Try Sort[{4, 3, 2, 1, -∞, ∞}, Less]. $\endgroup$ Commented Jan 21, 2012 at 23:49
4
$\begingroup$

As it turns out, Combinatorica has the function BinarySearch[] implemented. The code in the package is attributed to Paul Abbott. What follows is a modification of the routine that gives results in the format desired by the OP:

bisect[k_?NumericQ, l_List] := 
 Block[{n = Length[l], lo, mid, hi, el},
   {lo, hi} = {1, n};
   While[lo <= hi,
    If[(el = l[[mid = Quotient[lo + hi, 2]]]) === k,
     Which[
      mid == 1,
      Return[{{-Infinity, First[l]}, Take[l, 2]}],
      mid == n,
      Return[{Take[l, -2], {Last[l], Infinity}}],
      True,
      Return[Partition[Take[l, mid + {-1, 1}], 2, 1]]]];
    If[el > k, hi = mid - 1, lo = mid + 1]
    ];
   Which[
    lo == 1,
    Return[{-Infinity, First[l]}],
    lo == n + 1,
    Return[{Last[l], Infinity}],
    True,
    Return[l[[{lo - 1, lo}]]]
    ]
   ] /; VectorQ[l, NumericQ]

I'll leave to you how to handle the case of the singleton list.

$\endgroup$
3
$\begingroup$

Among many alternatives you can use something like

glblub1[x_, data_List] := Pick[#, IntervalMemberQ[Interval@#, x] & /@ #]& @
                              ( Partition[#, 2, 1]& @
                                Append[Prepend[Sort@data, -Infinity], Infinity])

or

glblub2[x_, data_List] := Pick[#, (#1 <= x <= #2) & @@@ #]& @ 
                              ( Partition[#, 2, 1]& @
                                Append[Prepend[Sort@data, -Infinity], Infinity]) 

If x is a member of the list and you wish to return x rather than two intervals containing x use as

Intersection@@glblub1[x,data]
Intersection@@glblub2[x,data]

or just redefine the two functions by prefixing both with Intersection@@.

$\endgroup$
3
$\begingroup$

WReach's answer prompted me to write another answer:

intervals[x_?NumericQ, list_List] := 
 With[{sl = Sort[Flatten[{-Infinity, list, Infinity}], LessEqual]},
   sl[[{#, # + 1}]] & /@ 
    Flatten[Position[
      Times @@@ Partition[Sign[x - sl], 2, 1], -1 | 0]]] /; 
  VectorQ[list, NumericQ]
$\endgroup$
0
$\begingroup$

Assuming the list is sorted, the easiest approach i can think of is as follows:

rangeFind[list_, y_] := First@Select[Join[{{-Infinity, First@list}},
Partition[list, 2, 1], {{Last@list + 1, Infinity}}], #[[1]] <= y <= #[[2]] &]
$\endgroup$
0
$\begingroup$

Adding a Piecewise solution.

With

SeedRandom[1213]
data = RandomReal[{-200, 200}, 30]

and

f[x_, list_] :=
 Piecewise[{#, x <= Last@#} & /@
   Partition[Join[{-∞}, Sort@list, {∞}], 2, 1]]

Then

f[#, data] & /@ {-400, 0, 400}
{{-∞,-198.392},{-15.7702,3.96342},{196.004,∞}}

Hope this helps.

$\endgroup$
0
$\begingroup$
f[x_?NumericQ, list_List] :=
 Module[
  {list2 = Join[list, {-Infinity, Infinity}]},
  {Max[Select[list, # <= x &]],
   Min[Select[list2, # >= x &]]}]

SeedRandom[1]

lis = RandomReal[1, 5]

(*  {0.817389, 0.11142, 0.789526, 0.187803, 0.241361}  *)

{#, f[#, lis]} & /@ Range[0, 1, .1] // Grid

enter image description here

$\endgroup$
0
$\begingroup$

Another possible solution:

rangeFind[list_, val_] := With[{ranges = Partition[Sort@list, 2, 1]}, 
ranges[[# + 1]] &@LengthWhile[ranges, ! (#[[1]] <= val <= #[[2]]) &]]
$\endgroup$
1
  • $\begingroup$ @Mr.Wizard and 4.5 x faster than my approach :p Ordering is nicer. Lesson learnt $\endgroup$
    – Ali Hashmi
    Commented Feb 5, 2017 at 1:45

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.