# Fast Selections Testing on Inequality

Is there a functional idiom for fast selections testing on inequality?

For example, finding values from list a & b where the key is less than or equal to a value, in this case 4 or 9. An inefficient method is to test on inequality.

a = {{1, "r"}, {5, "s"}, {7, "t"}};
b = {{2, "u"}, {10, "v"}};

f[list_, value_] := Module[{found},
found = Select[list, First[#] <= value &];
found[[-1, 2]]]

{f[a, #] & /@ {4, 9}, f[b, #] & /@ {4, 9}}


{{r, t}, {u, u}}

More efficient is to fill the lists and make a fast selection.

fill[list_, maxvalue_] := Module[{counter = 0, test},
test[_] := False;
Scan[(test[#] = True) &, First /@ list];
range = Range[list[[1, 1]], maxvalue];
full = If[test[#], list[[++counter]], list[[counter]]] & /@ range;
full[[All, 1]] = range;
full]

a2 = fill[a, 11];
b2 = fill[b, 11];

g[list_, input_] := Module[{test, sowMatches},
Scan[(test[#] := True) &, input];
sowMatches[x_ /; test[x[]]] := Sow[x, x[]];
Last /@ Flatten[Last@Reap[Scan[sowMatches, list], input], 2]]

{g[a2, {4, 9}], g[b2, {4, 9}]}


{{r, t}, {u, u}}

Demonstrating timing.

Edit - Now including J.M.'s function as h[].

h[list_, value_] := Last@Pick[list[[All, 2]], UnitStep[list[[All, 1]] - value - 1], 0]


Timing code

a = {#, #} & /@ Sort@RandomSample[Range, 500];
b = {#, #} & /@ Sort@RandomSample[Range, 500];
minimuminput = Max[a[[1, 1]], b[[1, 1]]];
input = Sort[RandomSample[Range, 10000] + minimuminput];

timefa = First@Timing[fa = f[a, #] & /@ input];
timefb = First@Timing[fb = f[b, #] & /@ input];

timega = First@Timing[ga = g[fill[a, Max@input], input]];
timegb = First@Timing[gb = g[fill[b, Max@input], input]];

timeha = First@Timing[ha = h[a, #] & /@ input];
timehb = First@Timing[hb = h[b, #] & /@ input];

Print["Results are the same? ", {fa == ga == ha, fb == gb == hb}

TableForm[{{timefa, timega, timeha}, {timefb, timegb, timehb}},
TableHeadings -> {{"a", "b"}, {"f[]", "g[]", "h[]"}}]


Results are the same? {True, True} So pre-filling and fast selection is much faster than direct inequality testing on large lists. However, filling the list could be impractical for large data sets. Can anyone suggest an efficient method?

Edit - J.M.'s elegant solution performs very impressively.

• Can you test Last[Pick[list[[All, 2]], UnitStep[list[[All, 1]] - value], 0]]? – J. M. will be back soon Oct 15 '15 at 10:54
• That's interesting ... – Chris Degnen Oct 15 '15 at 10:56
• Thanks J.M. You should post that as an answer. – Chris Degnen Oct 15 '15 at 12:02
• If it suits your needs, you could write an answer based on my suggestion; I see that you did a few adjustments that I did not take into account. – J. M. will be back soon Oct 15 '15 at 12:03
• If your keys in the list are sorted, then the fastest would be a binary search. In that case, have a look here, you may adopt e.g. my solution (based on binary search) to your case rather easily. – Leonid Shifrin Oct 15 '15 at 14:06

J.M.'s solution, with '-1' added to select on <= rather than <.

h[list_, value_] := Last[Pick[list[[All, 2]],
UnitStep[list[[All, 1]] - value - 1], 0]]


As the list is sorted you can perform a binary search in $O(\log(n))$

<< Combinatorica
SeedRandom;
a = {#, #} & /@ Sort@RandomSample[Range, 500];

s[l_, k_] := l[[Floor@BinarySearch[l[[All, 1]], k], 2]]
s[a, 2000]

(* 1920 *)

a[[All, 1]][[1 ;; 10]]
(*{387, 1339, 1344, 1558, 1653, 1881, 1920, 2119, 2170, 2206}*)


Or the faster Leonid's version

Clear[sLeonid];
sLeonid =
Compile[{{lst, _Real, 2}, {pt, _Real}},
Module[{pos = -1, x = lst[[All, 1]], y = lst[[All, 2]], n0 = 1,
n1 = Length[lst], m = 0}, While[n0 <= n1, m = Floor[(n0 + n1)/2];
If[x[[m]] == pt, While[x[[m]] == pt && m < Length[lst], m++];
pos = If[m == Length[lst], m, m - 1];
Break[];];
If[x[[m]] < pt, n0 = m + 1, n1 = m - 1]];
If[pos == -1, pos = If[x[[m]] < pt, m, m - 1]];
Which[pos == 0, y[], pos == Length[x], y[[-1]], True,
y[[pos]]]], CompilationTarget -> "C"];

sLeonid[a, 2000]
(* 1920 *)


Some timings:

h[list_, value_] := Last[Pick[list[[All, 2]], UnitStep[list[[All, 1]] - value - 1], 0]]

a = {#, #} & /@ Sort@RandomSample[Range, 5000];
b = {#, #} & /@ Sort@RandomSample[Range, 5000];
minimuminput = Max[a[[1, 1]], b[[1, 1]]];
input = Sort[RandomSample[Range, 10000] + minimuminput];

timeLa = First@Timing[La = sLeonid[a, #] & /@ input];
timeLb = First@Timing[Lb = sLeonid[b, #] & /@ input];

timeha = First@Timing[ha = h[a, #] & /@ input];
timehb = First@Timing[hb = h[b, #] & /@ input];

Print["Results are the same? ", {La == ha, Lb == hb} ];
TableForm[{{timeLa, timeha}, {timeLb, timehb}},
TableHeadings -> {{"a", "b"}, {"Leonid's", "h[]"}}] • I am actually very surprised that the binary search version is so slow. Perhaps the lists are not long enough. No time to look deeper right now. +1, of course. – Leonid Shifrin Oct 15 '15 at 15:03
• @LeonidShifrin It's mostly calling overhead – Dr. belisarius Oct 15 '15 at 15:06

This seems to be reasonably fast:

a = {{1, "r"}, {5, "s"}, {7, "t"}};

FirstCase[Reverse @ a, {x_ /; x <= #, y_} :> y] & /@ {4, 9}


{"r", "t"}

• Timing result is about 3 seconds on Mathematica 10, twice as fast as the method using Select. – Chris Degnen Oct 15 '15 at 14:25

This isn't anywhere near as fast as J.M.'s solution, but appears slightly faster than the best of belisarius' solutions, although the difference is small enough that it could be because of CPU speed difference.

h[data_, max_] :=
Module[{keys, vals},
{keys, vals} = Transpose[data];
vals[[Position[keys, _?(# <= max &)][[-1, 1]]]]]

a = {{1, "r"}, {5, "s"}, {7, "t"}};
b = {{2, "u"}, {10, "v"}};
Outer[h, {a, b}, {4, 9}, 1]

{{"r", "t"}, {"u", "u"}}

SeedRandom;
aa = {#, #} & /@ Sort @ RandomSample[Range, 500];
input = Sort[RandomSample[Range, 10000] + aa[[1, 1]]];

First @ Timing[h[a, #] & /@ input;]

4.55674


Here is J.M.'s solution on my system for comparison.

jm[data_, max_] :=
Last[Pick[data[[All, 2]], UnitStep[data[[All, 1]] - max - 1], 0]]
First @ Timing[jm[aa, #] & /@ input;]

0.338045
`