Реализация хвостовой рекурсивной версии функции быстрой сортировки в F#/OCaml

Прямой стиль:

let rec quicksort list =
    match list with
    | [] -> []
    | [element] -> [element]
    | pivot::rest ->
        let left, right = List.partition (fun element -> element < pivot) rest in
        let sorted_left = quicksort left in
        let sorted_right = quicksort right in
        sorted_left @ [pivot] @ sorted_right

Мой первый, наивный перевод очень похож на версию Лорана, за исключением немного странного отступа, чтобы показать, что вызовы с продолжениями на самом деле являются своего рода привязкой:

let rec quicksort list cont =
    match list with
    | [] -> cont []
    | element::[] -> cont [element]
    | pivot::rest ->
        let left, right = List.partition (fun element -> element < pivot) rest in
        quicksort left (fun sorted_left ->
        quicksort right (fun sorted_right ->
        cont (sorted_left @ [pivot] @ sorted_right)))
let qsort li = quicksort li (fun x -> x)

В отличие от Лорана, я легко проверяю, что cont не забыто: CPS-функции, переведенные из прямого стиля, обладают тем свойством, что продолжение используется линейно, один и только один раз в каждой ветви, в хвостовой позиции. Легко проверить, что ни один такой вызов не был забыт.

Но на самом деле, для большинства запусков быстрой сортировки (предположим, что вы получаете примерно логарифмическое поведение, потому что вам не повезло или вы сначала перетасовали входные данные), стек вызовов не является проблемой, поскольку он растет только логарифмически. Гораздо большее беспокойство вызывают частые вызовы @, которые линейны по левому параметру. Обычный метод оптимизации состоит в том, чтобы определить функции не как возвращающие список, а как «добавляющие входные данные в список-накопитель»:

let rec quicksort list accu =
    match list with
    | [] -> accu
    | element::[] -> element::accu
    | pivot::rest ->
        let left, right = List.partition (fun element -> element < pivot) rest in
        let sorted_right = quicksort right accu in
        quicksort left (pivot :: sorted_right)
let qsort li = quicksort li []

Конечно, это можно снова превратить в CPS:

let rec quicksort list accu cont =
    match list with
    | [] -> cont accu
    | element::[] -> cont (element::accu)
    | pivot::rest ->
        let left, right = List.partition (fun element -> element < pivot) rest in
        quicksort right accu (fun sorted_right ->
        quicksort left (pivot :: sorted_right) cont)
let qsort li = quicksort li [] (fun x -> x)    

Теперь последний трюк — «дефункционализировать» продолжения, превратив их в структуру данных (предположим, что выделение структур данных немного более эффективно, чем выделение замыкания):

type 'a cont =
  | Left of 'a list * 'a * 'a cont
  | Return
let rec quicksort list accu cont =
    match list with
    | [] -> eval_cont cont accu
    | element::[] -> eval_cont cont (element::accu)
    | pivot::rest ->
        let left, right = List.partition (fun element -> element < pivot) rest in
        quicksort right accu (Left (left, pivot, cont))
and eval_cont = function
  | Left (left, pivot, cont) ->
    (fun sorted_right -> quicksort left (pivot :: sorted_right) cont)
  | Return -> (fun x -> x)
let qsort li = quicksort li [] Return

Наконец, я выбрал стиль function .. fun для eval_cont, чтобы было очевидно, что это всего лишь фрагменты кода из версии CPS, но следующая версия, вероятно, лучше оптимизирована за счет повышения арности:

and eval_cont cont accu = match cont with
  | Left (left, pivot, cont) ->
    quicksort left (pivot :: accu) cont
  | Return -> accu

Быстрая попытка, кажется, работает:

let rec quicksort list cont =
    match list with
    | [] -> cont []
    | element::[] -> cont [element]
    | pivot::rest ->
        let ``elements smaller than pivot``, ``elements larger or equal to pivot`` =
            rest |> List.partition (fun element -> element < pivot)
        quicksort ``elements smaller than pivot``
            (fun x -> quicksort ``elements larger or equal to pivot`` (fun y -> cont (x @ [pivot] @ y)))

> quicksort [2; 6; 3; 8; 5; 1; 9; 4] id;;
val it : int list = [1; 2; 3; 4; 5; 6; 8; 9]

Изменить:

Конечно, этот код крайне неэффективен. Я надеюсь, что никто не будет использовать его в реальном коде. Код было нетрудно написать, но продолжения могут быть трудными для чтения и могут быть подвержены ошибкам (легко забыть вызов cont). Если вы хотите больше поиграть, вы можете написать монаду-продолжение (Брайан написал запись в блоге об этом).

Монада продолжения (украдена отсюда) также можно использовать (обычно это делает код более читабельным):

type ContinuationMonad() =
    // ma -> (a -> mb) -> mb
    member this.Bind (m, f) = fun c -> m (fun a -> f a c)
    // a -> ma
    member this.Return x = fun k -> k x
    // ma -> ma
    member this.ReturnFrom m = m
let cont = ContinuationMonad()

// Monadic definition of QuickSort
// it's shame F# doesn't allow us to use generic monad code
// (we need to use 'cont' monad here)
// otherwise we could run the same code as Identity monad, for instance
// producing direct (non-cont) behavior
let rec qsm = function
     |[]    -> cont.Return []
     |x::xs -> cont {
        let l,r = List.partition ((>=)x) xs
        let! ls = qsm l 
        let! rs = qsm r
        return (ls @ x :: rs) }

// Here we run our cont with id
let qs xs = qsm xs id     

printf "%A" (qs [2;6;3;8;5;1;9;4])