patience_sort.ml

open Base

module Make (Comparable : Comparable.S) = struct
  let sort_into_piles list =
    let piles = Array.create ~len:(List.length list) [] in
    let bsearch len elem =
      let rec aux lo hi =
        if lo > hi then lo
        else
          let mid = (lo + hi) / 2 in
          if Comparable.compare elem (List.hd_exn piles.(mid)) <= 0 then
            aux lo (mid-1)
          else aux (mid + 1) hi
      in
      aux 0 (len - 1)
    in
    let len =
      List.fold ~init:0
        ~f:(fun len elem ->
            let idx = bsearch len elem in
            piles.(idx) <- elem :: piles.(idx) ;
            if idx = len then len + 1 else len )
        list
    in
    List.init len ~f:(fun idx -> piles.(idx))

  let rec merge_piles piles =
    let rec two_way_merge accu lista listb =
      match (lista, listb) with
      | (_ as rest), [] | [], (_ as rest) ->
        List.rev accu @ rest
      | x :: xs, y :: ys ->
        if Comparable.compare x y <= 0 then two_way_merge (x :: accu) xs listb
        else two_way_merge (y :: accu) lista ys
    in
    match piles with
    | [] ->
      []
    | [pile] ->
      pile
    | la :: lb :: rest ->
      two_way_merge [] (two_way_merge [] la lb) (merge_piles rest)

  let patience_sort list = merge_piles (sort_into_piles list)
end