Suppose I have a sorted list of things

{thing1, thing2, thing3, ...}

and a binary comparison function that says whether one thing should come before another in that sort order. (I say "things" because they need not be numbers; they can be arbitrary data structures.)

I now seek a function that takes

• a sorted list of things,
• a comparison function, and
• a thing

and returns the first pair of adjacent things in the list that the new thing should be inserted between. That is, return the first adjacent pair {a,b} such that comp(a,x) and comp(x,b) are true, where comp() is the comparison function.

For example,

pigeon[{1,3,5,7}, Less, 4]

should return

{3,5}

(EDIT: If the given thing is less than the first element, a, of the list, then return {Null, a}. Likewise, if it's greater than the last element, z, then return {z, Null}. Additionally, we need to either assume that the comparison function returns true for two identical elements (ie, it's like LessEqual rather than Less) or that the list of things doesn't contain the thing being pigeoned. Thanks to High Performance Mark for catching that!)

My first thought was to use Split and then take the Last and First, respectively, of the resulting two sublists. I'll post that as an answer (or feel f开发者_如何学Goree to beat me to it) but I imagine there's a more efficient or elegant way.

Using BinarySearch

Assumption: No repeated elements in list.

BinarySearch has an alternative form:

BinarySearch[l,k,f]
gives the position of k in the list obtained from l by applying f to 
each element in l.  

which may be used if your list is sorted by the results of the aforementioned "f".

Clear["Global`*"]; Needs["Combinatorica`"];
ret[list_, f_, elem_] := Module[{pos, last},
  pos[l_, e_, g_] := IntegerPart[BinarySearch[l, g[e], g]];
  {
   list[[pos[list, elem, f]]] /. List -> Null,
   If[(last = pos[list, elem, f] + 1) > Length@list, Null, list[[last]]]
  }
 ]  

a = {1, 2, 3, 4, 5};
b = SelectionSort[a, Cos[#1] < Cos[#2] &]

{3, 4, 2, 5, 1}  

Table[{x, N[Cos[x], 2], ret[b, Cos, x]}, 
     {x, 1, 6}]  

{{1,  0.54, {1, Null}}, 
 {2, -0.42, {2, 5}}, 
 {3, -0.99, {3, 4}}, 
 {4, -0.65, {4, 2}}, 
 {5,  0.28, {5, 1}}, 
 {6,  0.96, {1, Null}}
}  

ret[b, Cos, Pi]  
{Null, 3}

I think this is a good solution:

Needs["Combinatorica`"]
pigeon[list_, func_, x_] := 
  Join[{Null}, list, {Null}]
    [[ {# - 1/2, # + 1/2}& @
     BinarySearch[list, 0.5, 
      Piecewise[{{0, func[#, x]}, {1, True}}] &] + 1 ]]

giving:

> pigeon[{1, 3, 5, 7}, LessEqual, 0]
{Null, 1}

> pigeon[{1, 3, 5, 7}, LessEqual, 3]
{3, 5}

> pigeon[{1, 3, 5, 7}, LessEqual, 4]
{3, 5}

> pigeon[{1, 3, 5, 7}, LessEqual, 9]
{7, Null}

Explanation: the Piecewise function is applied inside the BinarySearch to the list {1, 3, 5, 7}, to check which elements are LessEqual, the BinarySearch than finds the position of the end of this mark, and the relevant elements are returned. This implementation uses only BinarySearch, so it suppose to be quite efficient.

This function can be easily changed to return in the second case {1, 3} instead.
Alternatively, if 'x' can be an element of 'list', something like this:

Needs["Combinatorica`"]
pigeon[list_, func_, 
  x_] := (Join[{Null}, 
    list, {Null}])[[Select[{# - 1/2, #, # + 1/2} &@
      BinarySearch[list, 0, 
       Piecewise[{{0, # == x}, {-1, func[#, x]}, {1, True}}] &], 
     IntegerQ] + 1]]

will give:

> pigeon[{1, 3, 5, 7}, LessEqual, 3]
{3}

It's late, so here's a partial solution to a partially specified function:

f[l_List, compFun_Symbol, el_] := 
 Sort[l, compFun] /. {a___, b_ /; compFun[b, el], 
    c_ /; compFun[el, c], d___} -> {b, c}

I've taken the liberty of not requiring that the list supplied to the function f be sorted, since the input arguments include the comparison function. This function works well as long as (a) the element el is not a member of l and (b) there are elements in l sorted to both left and right of el. It probably doesn't work for LessEqual or GreaterEqual either.

If you care to clarify what you'd like the function to return when either or both of (a) and (b) is not met, I'll be happy to have another look at this in the morning.

EDIT:

I think this satisfies the revised requirements. As before, it doesn't require that the input list be already sorted.

f2[l_List, compFun_, el_] := Sort[Append[l, el], compFun] /. 
{a___, el, b___} :> {If[{a}==={}, Null, Last@{a}], If[{b}==={}, Null, First@{b}]}

I'll leave it to others to judge the elegance and efficiency of this solution (I can see some obvious improvements in the latter respect). Now to get back to work.

One possible approach:

lst = {1, 3, 5, 7, 9, 11}

{Last@#1, First@#2} & @@ GatherBy[lst, Less[4, #] &]

Output = {3, 5}

Alternatively, SplitBy may be substituted for GatherBy.

Here's a solution using Select (note the third argument) that takes at most one pass through the list, stopping when it finds the pigeonhole:

pigeon[l_, f_, x_] := Module[{p, r},
  p = Null;
  r = Select[l, If[f[x,#], True, p = #; False]&, 1];
  If[r==={}, {Last@l, Null}, {p, First@r}]]

Examples:

> pigeon[{1,3,5,7}, LessEqual, 4]
{3, 5}

> pigeon[{1,3,5,7}, LessEqual, 0]
{Null, 1}

> pigeon[{1,3,5,7}, LessEqual, 9]
{7, Null}

Here's another binary search answer:

(* Helper for pigeon. Additional arguments a and b give current bounds on the 
   indices of the pigeonhole. *)
pigeon0[l_, f_, x_, a_, b_] := Which[
  b-a==1,                    {l[[a]], l[[b]]},
  f[x, l[[Floor[(a+b)/2]]]], pigeon0[l, f, x, a, Floor[(a+b)/2]],
  True,                      pigeon0[l, f, x, Floor[(a+b)/2], b]]

pigeon[l_, f_, x_] := Which[
  f[x, First@l],                 {Null, First@l},
  f[Last@l, x] && !f[x, Last@l], {Last@l, Null},
  True,                          pigeon0[l, f, x, 1, Length@l]]

I tried it like this:

> l = Sort@RandomReal[{0,1}, {10^6}];
> pigeon[l, LessEqual, .5]
{0.4999991874459364, 0.5000000938493356}

That matches my other answer (the one with Select) but is much faster.

Other examples:

> pigeon[{1,3,5,7}, LessEqual, 4]
{3, 5}

> pigeon[{1,3,5,7}, LessEqual, 0]
{Null, 1}

> pigeon[{1,3,5,7}, LessEqual, 9]
{7, Null}