An alternative to the built-in sort routine

sort.erl

-module(sort).

-export([bu_merge/1]).
-export([bench/0]).

-ifdef(TEST).
-include_lib("eqc/include/eqc.hrl").
-include_lib("eunit/include/eunit.hrl").
-endif.

-define(BOOST_THRESHOLD, 8).

bu_merge(L) ->
    sort(fun erlang:'<'/2, L).

%% ----------------------------------------------------------------------
take(_Lt, X1, Xr, []) -> [X1 | Xr];
take(Lt, X1, Xr, [Y1|Yr]) ->
    case Lt(X1, Y1) of
	true -> [X1 | take(Lt, Y1, Yr, Xr)];
	false -> [Y1 | take(Lt, X1, Xr, Yr)]
    end.

merge(_Lt, [], Ys) -> Ys;
merge(Lt, [X1 | Xr], Ys) ->
    take(Lt, X1, Xr, Ys).

mergepairs(_Lt, L1, [], _K) -> [L1];
mergepairs(Lt, L1, [L2 | Lr] = Ls, K) ->
    case K rem 2 == 1 of
	true ->
	    [L1 | Ls];
	false ->
	    mergepairs(Lt, merge(Lt, L1, L2), Lr, K div 2)
    end.

insert(_Lt, X, []) -> [X];
insert(Lt, X, [R | Run]) ->
    case Lt(R, X) of
	true -> [X, R | Run];
	false -> [R | insert(Lt, X, Run)]
    end.

boost(_Lt, 0, Run, Xs) ->
    {Run, Xs};
boost(_Lt, _K, Run, []) ->
    {Run, []};
boost(Lt, K, Run, [X | Xs]) ->
    boost(Lt, K-1, insert(Lt, X, Run), Xs).

nextrun(_Lt, Run, [], _K) -> {Run, []};
nextrun(Lt, [H | _] = Run, [X|Xr] = Xs, K) ->
    case Lt(X, H) of
	true when K >= ?BOOST_THRESHOLD ->
	    {Run, Xs};
	true when K < ?BOOST_THRESHOLD ->
	    boost(Lt, ?BOOST_THRESHOLD - K, Run, Xs);
	false ->
	    nextrun(Lt, [X|Run], Xr, K+1)
    end.

sorting(Lt, [], Ls, _R) ->
    [H | _] = mergepairs(Lt, [], Ls, 0),
    H;
sorting(Lt, [X | Xs], Ls, R) ->
    {RevRun, Tail} = nextrun(Lt, [X], Xs, 0),
    sorting(Lt,
	    Tail,
	    mergepairs(Lt, lists:reverse(RevRun),
		       Ls,
		       R+1),
	    R+1).

sort(_Lt, []) -> [];
sort(_Lt, [_] = Xs) -> Xs;
sort(Lt, [X1, X2] = Xs) ->
    case Lt(X1, X2) of
	true ->
	    Xs;
	false ->
	    [X2, X1]
    end;
sort(Lt, Xs) ->
    sorting(Lt, Xs, [], 0).

bench() ->
    Xs = [crypto:rand_uniform(1, 10000000) || _ <- lists:seq(1, 1000000)],
    Sorted = lists:sort(Xs),
    {Us1, _} = timer:tc(sort, bu_merge, [Xs]),
    {Us2, _} = timer:tc(lists, sort, [fun erlang:'=<'/2, Xs]),
    {Us3, _} = timer:tc(lists, sort, [Xs]),
    {SUs1, _} = timer:tc(sort, bu_merge, [Sorted]),
    {SUs2, _} = timer:tc(lists, sort, [fun erlang:'=<'/2, Sorted]),
    {SUs3, _} = timer:tc(lists, sort, [Sorted]),
    [{random, {Us1 / 1000, Us2 / 1000, Us3 / 1000}},
     {smooth, {SUs1 / 1000, SUs2 / 1000, SUs3 / 1000}}].

-ifdef(EUNIT).
-ifdef(EQC).

is_sorted([]) ->
    true;
is_sorted([_]) ->
    true;
is_sorted([X1, X2 | Rest]) when X1 =< X2 -> is_sorted([X2 | Rest]);
is_sorted([X1, X2 | _Rest]) when X1 >  X2 -> false.

prop_sorted() ->
    ?FORALL(L, list(int()),
	    true =:= is_sorted(bu_merge(L))).

prop_agree() ->
    ?FORALL(L, list(int()),
	    lists:sort(L) =:= bu_merge(L)).

eqc_sorted_test() ->
    ?assert(eqc:quickcheck(eqc:numtests(1000, prop_sorted()))).

eqc_agree_test() ->
    ?assert(eqc:quickcheck(eqc:numtests(1000, prop_agree()))).

-endif.
-endif.

%%% Benchmarks:

%% 13> sort:bench().
%% [{random,{1820.92,1713.423,826.749}},
%%  {smooth,{99.481,141.274,77.964}}]