Finding first instance of a relationship between elements in two lists

Suppose I have two lists, say:

A = {1,5,10,200,50,7}
B = {4,3,19,78}


For each element in A, I would like to find the index of the first element in B which exceeds that element, (or 0 if none do) i.e. :

result = {1,3,3,0,4,3}


Clever syntax much appreciated!

• Thanks for all the great suggestions, all helping to educate this newbie in different ways. I ought to have mentioned that my particular need here isn't performance critical and only needed for small lists, but thanks for the answers addressing the general case too. Commented Aug 24, 2012 at 23:22

This is a compiled solution that should be very fast.

Clear@firstInstance;
With[{part = CompileGetElement},
firstInstance = Compile[{{A, _Integer, 1}, {B, _Integer, 1}},
Module[{res = Table[0, {Length[A]}], i = 1, j = 1,
lenA = Length[A], lenB = Length[B]},
For[i, i <= lenA, i++,
While[part[A, i] >= part[B, j], If[j == lenB, j = 0; Break[], j++]];
res[[i]] = j;
j = 1;
];
res
],
CompilationTarget -> "C",
RuntimeOptions -> "Speed"
]
]


Use it as firstInstance[A, B]

• +1. I should now be wary that my monopoly on ugly compiled code has been broken :). Commented Aug 24, 2012 at 15:01
• @LeonidShifrin I watch and learn... and then sneak up from behind! :D
– rm -rf
Commented Aug 24, 2012 at 15:06
• That's what I noticed :). Then, a little bit of advice: ConstantArray is not compilable, use Table instead. Commented Aug 24, 2012 at 15:08
• Aha! Thanks, I should've checked the result... it does have MainEvaluate[ Hold[ConstantArray][ I0, I3]] that I should've spotted.
– rm -rf
Commented Aug 24, 2012 at 15:12
• Well, normally this won't affect the performance all that much, depends on the code in question. Usually you can gain a few percent speedup this way, sometimes more. Commented Aug 24, 2012 at 15:14
 a = {1, 5, 10, 200, 50, 7};
b = {4, 3, 19, 78};
Position[#, -1, 1, 1] & /@ (Sign@(# - b) & /@ a) /. {} -> {0} // Flatten
(* {1, 3, 3, 0, 4, 3} *)


Update: Per whuber's suggestion, removing out-of-order elements from b, and re-mapping position numbers using a parallel list of position indices:

With[{b0 = FoldList[Max, First@b, Rest@b]},
indices = Pick[Range@Length@b, MapThread[ Equal, {b, b0}]];
(Position[#, -1, 1, 1] & /@ (Sign@(# - Union@b0) & /@ a) /. {} -> {{0}} // Flatten)


Few more alternatives for creating indices:

indices2 = Pick[Range@Length@b, Equal @@@ Transpose[{b, b0}]]
(* as suggested by J.M:  *)
indices3=Fold[If[#1 === {}||Last[b[[#1]]] < b[[#2]],Append[#1, #2], #1] &,{},
Range[Length[b]]]

• (+1) This has optimal efficiency O(Length[a] Log[Length[b]]. If you want the ultimate (asymptotic, general purpose) speedup, first pre-process b (with O(Length(b)) effort) to remove out-of-order elements altogether, because they will never be found. Notice in the example, for instance, that the target for the position searches only has to be b0={4,19,78} with the 3 omitted. Easy preprocessing produces this shortened vector along with a parallel list of indexes, {1,3,4}, which will convert indexes into b0 into indexes into b. Commented Aug 24, 2012 at 18:44
• @whuber, great suggestions. I will check if i can incorporate them in the next edit.
– kglr
Commented Aug 24, 2012 at 19:38
• FWIW, Here is my first attempt at the preprocessing, in case it's any use. I'm sure you can do better :-). indexes = Select[Range[Length[b]] (Boole[# > 0] & /@ Differences[FoldList[Max, First[b] - 1, b]]), # > 0 &]; b0 = Union[FoldList[Max, First[b], b]];. I expect Union to be (sub)linear in length[b] because its argument is already sorted. Commented Aug 24, 2012 at 19:42
• Another way to do @whuber's suggestion: Fold[If[#1 === {} || Last[b[[#1]]] < b[[#2]], Append[#1, #2], #1] &, {}, Range[Length[b]]]. Commented Aug 24, 2012 at 23:35
• @J.M., whuber thank you both. I added few alternatives for creating the index set including your suggestions.
– kglr
Commented Aug 25, 2012 at 0:18

One quick way is :

If[Length[#] == 0, 0, #[[1, 1]]] & /@ (With[{Local = #},
Position[B, _?(# > Local &)]] & /@ A)


Another using Mr.Wizard's suggestion :

Flatten[If[Or @@ # == False, 0,
Position[#, True, 1,
1]] & /@ (With[{Local = #}, Thread[B > Local]] & /@ A)]

• Excellent, much appreciated. Commented Aug 24, 2012 at 12:35
• It would be better to use the fourth argument of Position to short-circuit the search on the first find. Commented Aug 24, 2012 at 12:43
• @Mr.Wizard Thanks, I had forgotten about it. Commented Aug 24, 2012 at 12:46

Here's my take:

A = {1, 5, 10, 200, 50, 7};
B = {4, 3, 19, 78};

First[Flatten[Position[B - #, _?Positive, 1, 1]] /. {} -> {0}] & /@ A
{1, 3, 3, 0, 4, 3}

a = {1, 5, 10, 200, 50, 7};
b = {4, 3, 19, 78};

Mod[
1 + Table[LengthWhile[b, # <= i &], {i, a}],
Length@b + 1
]

 {1, 3, 3, 0, 4, 3}


Here is a first attempt to create an efficient solution for long b lists.

I decided to experiment with something I'm not really comfortable with, but Leonid mentioned once: using a side-effect in PatternTest. It strikes me as quite obfuscated but maybe that is only because I don't expect it.

  untilLarger[a_, b_] :=
Module[{dat, min, max, f, test, m = -∞},
test[x_] /; x > m := (Sow[m = x]; True);
dat = Join @@@ Reap[Position[b, _?test]]\[Transpose];
{min, max} = dat[[{1, -1}, 2]];
f[n_] /; n < min = 1;
f[n_] /; n >= max = 0;
f[n_] := Cases[dat, {y_, x_} /; x > n, 1, 1][[1, 1]];
f /@ a
]

untilLarger[a, b]

 {1, 3, 3, 0, 4, 3}

• +1. We were obviously thinking along the same direction. Commented Aug 24, 2012 at 12:51
• Your second solution doesn't give the right result. For example, try with {a, b} = {{8, 2, 17, 4, 6, 6, 4, 6, 4, 2}, {5, 6, 4, 9, 10, 9, 8, 0, 3, 5}} and manually work out the answer for the fifth element in a. I believe this is fixed by checking for >= instead of >. However, making this change leads to other issues with duplicates in longer lists and Interpolation complains. For an example of a case where Interpolation fails, try: SeedRandom[1234]; X = RandomInteger[{0, 20}, 10^3]; Y = RandomInteger[{0, 10}, 10^6];
– rm -rf
Commented Aug 24, 2012 at 15:25
• @R.M I rewrote the second method to use Cases instead of Interpolation as I got the intervals wrong with the latter. Please tell me if it works correctly now. Commented Aug 24, 2012 at 21:29
• It does. Both our solutions have different limiting factors. Yours is limited by the length of b, whereas mine is limited by that of a. I'm still surprised that it is as fast as it is, what with the Apply, Position, Reap/Sow and Cases...
– rm -rf
Commented Aug 24, 2012 at 23:54

FirstPosition (for versions 10.2+)

FirstPosition[UnitStep[B - #], 1, 0 &][[1]] & /@ A


{1, 3, 3, 0, 4, 3}

FirstPosition[B, _?(Function[t, # <= t]), 0 &][[1]] & /@ A


{1, 3, 3, 0, 4, 3}

The only relevant elements of B are those that remain when taking the largest monotonous subsequence. Below which is a list containing the positions of the elements of that subsequence.

With[{which = Pick[#, Positive[Append[Differences[#], 1]]] &[Ordering[B]]},
With[{sz1 = Length[A], sz2 = Length[which]},
With[{ord = TakeList[Ordering[Ordering[Join[A, B[[which]]]]], {sz1, sz2}]},
With[{counts = Differences[Prepend[Last[ord], 0]]},

{1, 3, 3, 0, 4, 3}

If B contains duplicates then which contains the position of all occurences, so the correctness is a bit subtle in that case. It is the order of the arguments of Join` that ensures it.