Can this code be written in a more functional style

Question

Referencing this question, I wonder if the following code can be written more concisely using a functional style, i.e. without For loops or ReplacePart?

Parti[A_, p_] := Module[{An, i = 1, j = 1}, 
 An = Drop[A, Flatten[Position[A, p]]]; 
 For [j = 1, j <= Length[An], j++, 
  If[An[[j]] < p, 
  An = ReplacePart[An, {j -> An[[i]], i -> An[[j]]}]; i++]; ]; 
  Insert[An, p, i] ]; 

Where

A1 = {3, 5, 6, 2, 1}; 
Parti[A1, First[A1]] 

has the expected output: {2,1,3,5,6}

Answer 1

Two more ways:

   parti1[a_, p_] := SortBy[a, {Sign[# - p] &, # == # &}]

or

   parti2[a_, p_] := Join[Select[a, # < p &], {p}, Select[a, # >= p &]]

With

  a = {3, 5, 6, 7, 2, 1, 2}; (* and *) p =3

both give

  {2, 1, 2, 3, 5, 6, 7}

Update: While the two methods above and Heike's two methods give exactly the same results, unfortunately, it turns out that Parti is a tougher nut than it seemed at first glance and none of these functions replicate Parti except for very special inputs. Here is why:

These functions, in effect, partition a list into lower and upper contour sets of the element p preserving the original ordering of the elements in each subset. With Parti, on the other hand, the orginial ordering is preserved only for the lower contour set, and the ordering of the elements in the upper contour set is not preserved. That is, when an element in the lower contour set moves it moves to the right of his previous left sibling and stays there, while an element on the upper contour set can move many times during the operation of Parti depending on the pattern of elements on its right.

For example, for the input list {3, 2, 5, 6, 2, 1} all four functions agree with Parti, i.e.,

 Parti[{3, 2, 5, 6, 2, 1}, 3]==parti1[[{3, 2, 5, 6, 2, 1}, 3]=={2, 2, 1, 3, 5, 6}

Yet, with a slight change in the list to {3, 2, 5, 2, 6, 1}, we get

  Parti[{3, 2, 5, 2, 6, 1}, 3] (* => {2, 2, 1, 3, 6, 5} *)

while parti1 and its siblings give

  parti1[{3, 2, 5, 2, 6, 1}, 3] (* => {2, 2, 1, 3, 5, 6} *)

Another example: for the input list {3, 2, 5, 6, 7, 8, 9, 2, 1}

   Parti[{3, 2, 5, 6, 7, 8, 9, 2, 1},5]   (* =>  {3, 2, 2, 1, 5, 8, 9, 6, 7}, but *)
   parti1[{3, 2, 5, 6, 7, 8, 9, 2, 1},5]  (* =>  {3, 2, 2, 1, 5, 6, 7, 8, 9}      *)

Thus, the elements of the upper contour set always move to the right but their final positions relative to each other cannot be determined in a simple manner without using finer pattern information.

So ... it seems that the parties are interesting, at best, as a first step towards an answer to OP's question, and, quite possibly, as just answers seeking an interesting question.

A new attempt: Try ReplaceRepeated and pattern matching:

  partiReplace[a_List, p_] := 
  With[{leftlist = Alternatives[Sequence @@ Select[a, # < p &]], 
  rightlist =  Alternatives[ Sequence @@ Select[a, # >= p &]]}, 
  (Drop[a, Flatten[Position[a, p]]] 
  //. {Shortest[beg___], i : rightlist, 
  Shortest[rgtn : rightlist ...], 
  j : leftlist, k : leftlist ..., end___} 
  -> {beg, j, rgtn, i, k, end}) 
  // Insert[#, p, 1 + Length@(leftlist)] &]

Tests: For the examples considered above, partiReplace gives the same result as Parti.

For a limited set of test data

  testdata = RandomReal[{0, 10}, {100, 21}];

we get

   Parti[Most@#, Last@#] == partiReplace[Most@#, Last@#] & @@ testdata 
   (* => True  *)

Answer 2

One way of doing this is to do something like

parti[lst_, p_] := Flatten[Reap[Sow[#, Sign[# - p]] & /@ lst, {-1, 0, 1}][[2]]]

If the list consists of integers only, you could also do something like

parti[lst_, p_] := Flatten[BinLists[lst, {{-Infinity, p, p+1, Infinity}}]]

Answer 3

Here's another solution that takes advantage of the Sign function, but exploits the fact that Sign is listable so we only have to call it once, and then uses the wonderful Pick function to extract the three lists before joining them back together.

Pillsy`Parti[A_, p_] :=
 With[{signs = Sign[A - p]},
  Join @@ (Pick[A, signs, #] & /@ {-1, 0, 1})];