FingerTree(https://github.com/sile/erl-finger-tree)を応用した OrderedSequence の実装例

ordseq.erl

-module(ordseq).

-export([
         new/0,
         is_ordseq/1,
         is_empty/1,
         len/1,
         in/2,
         out/1, out_r/1,
         peek/1, peek_r/1,
         foldl/3, foldr/3,
         from_list/1,
         to_list/1
        ]).

-export_type([
              ordseq/0,
              element/0,
              fold_fn/0
             ]).

-record(ordseq,
        {
          root = ordseq_ft:new() :: ordseq_ft:root_tree()
        }).

-type ordseq() :: #ordseq{}.
-type element() :: term().
-type fold_fn() :: fun((term(), element()) -> term()).

-spec new() -> ordseq().
new() ->
    #ordseq{}.

-spec is_ordseq(any()) -> boolean().
is_ordseq(#ordseq{}) -> true;
is_ordseq(_)         -> false.

-spec is_empty(ordseq()) -> boolean().
is_empty(#ordseq{root = Root}) -> ordseq_ft:is_empty(Root).

-spec in(element(), ordseq()) -> ordseq().
in(Elem, Seq) ->
    #ordseq{root = ordseq_ft:insert(Elem, Seq#ordseq.root)}.

-spec out(ordseq()) -> {empty, ordseq()} | {{value, element()}, ordseq()}.
out(Seq) ->
    case is_empty(Seq) of
        true  -> {empty, Seq};
        false ->
            {Head, Tail} = ordseq_ft:pop_l(Seq#ordseq.root),
            {{value, Head}, #ordseq{root = Tail}}
    end.

-spec out_r(ordseq()) -> {empty, ordseq()} | {{value, element()}, ordseq()}.
out_r(Seq) ->
    case is_empty(Seq) of
        true  -> {empty, Seq};
        false ->
            {Head, Tail} = ordseq_ft:pop_r(Seq#ordseq.root),
            {{value, Head}, #ordseq{root = Tail}}
    end.

-spec peek(ordseq()) -> empty | {value, element()}.
peek(Seq) ->
    case is_empty(Seq) of
        true  -> empty;
        false -> {value, ordseq_ft:head_l(Seq#ordseq.root)}
    end.

-spec peek_r(ordseq()) -> empty | {value, element()}.
peek_r(Seq) ->
    case is_empty(Seq) of
        true  -> empty;
        false -> {value, ordseq_ft:head_r(Seq#ordseq.root)}
    end.

-spec foldl(fold_fn(), term(), ordseq()) -> term().
foldl(Fn, Init, Seq) ->
    ordseq_ft:fold_l(Fn, Init, Seq#ordseq.root).

-spec foldr(fold_fn(), term(), ordseq()) -> term().
foldr(Fn, Init, Seq) ->
    ordseq_ft:fold_r(Fn, Init, Seq#ordseq.root).

-spec from_list([element()]) -> ordseq().
from_list(Elements) ->
    Tree = lists:foldr(fun ordseq_ft:push_l/2,
                       ordseq_ft:new(),
                       lists:sort(Elements)),
    #ordseq{root = Tree}.

-spec to_list(ordseq()) -> [element()].
to_list(Seq) ->
    foldr(fun (A, As) -> [A|As] end, [], Seq).

-spec len(ordseq()) -> non_neg_integer().
len(Seq) ->
    foldl(fun (_, Sum) -> Sum + 1 end,
          0,
          Seq).

ordseq_ft.erl

-module(ordseq_ft).

-export([
         new/0,
         is_empty/1,
         insert/2,
         push_l/2, push_r/2,
         pop_l/1, pop_r/1,
         head_l/1, head_r/1,
         fold_l/3, fold_r/3
        ]).

-export_type([
              root_tree/0
             ]).

-type element() :: term().

-type root_tree() :: tree(element()).

-type tree(X) :: empty |
                 {single, X} |
                 {deep, max(), X, tree(node(X)), X}.

-type max() :: element().

-type node(X) :: {node, max(), X, X} |
                 {node, max(), X, X, X}.

new() ->
    empty().

is_empty(empty) -> true;
is_empty(_)     -> false.
    
empty() ->
    empty.

single(A) ->
    {single, A}.

deep(Max, Pr, M, Sf) ->
    {deep, Max, Pr, M, Sf}.

node(A,B,C) ->    
    {node, get_max(get_max(A,B),C), A, B, C}.

push_l(A, Tree) ->
    MaxA = max_leaf(A), %% XXX: elementをtupleで囲む等しないと、内部表現と一致してしまう可能性がある
    case Tree of
        empty                         -> single(A);
        {single, B}                   -> deep(get_max(MaxA,max_leaf(B)), [A], empty(), [B]);
        {deep, Max, [B,C,D,E], M, Sf} -> deep(get_max(Max,MaxA), [A,B], push_l(node(C,D,E), M), Sf);
        {deep, Max, Pr, M, Sf}        -> deep(get_max(Max,MaxA), [A|Pr], M, Sf)
    end.

push_r(A, Tree) ->
    MaxA = max_leaf(A), %% XXX: elementをtupleで囲む等しないと、内部表現と一致してしまう可能性がある
    case Tree of
        empty                         -> single(A);
        {single, B}                   -> deep(get_max(MaxA,max_leaf(B)), [B], empty(), [A]);
        {deep, Max, Pr, M, [E,D,C,B]} -> deep(get_max(Max,MaxA), Pr, push_r(node(E,D,C), M), [B,A]);
        {deep, Max, Pr, M, Sf}        -> deep(get_max(Max,MaxA), Pr, M, Sf++[A])
    end.

pop_l({single, A})                -> {A, empty()};
pop_l({deep, Max, [A|Pr], M, Sf}) -> {A, deep_l(Max, Pr, M, Sf)}.

pop_r({single, A})          -> {A, empty()};
pop_r({deep, _, Pr, M, Sf}) -> {ButLast, Last} = list_pop_last(Sf),
                               {Last, deep_r(Pr, M, ButLast)}.

head_l({single, A})            -> A;
head_l({deep, _, [A|_], _, _}) -> A.

head_r({single, A})         -> A;
head_r({deep, _, _, _, Sf}) -> lists:last(Sf).

list_pop_last(List) ->
    list_pop_last(List, []).
list_pop_last([A], Acc) ->
    {lists:reverse(Acc), A};
list_pop_last([A|List], Acc) ->
    list_pop_last(List, [A|Acc]).

deep_l(Max, [], empty, Sf) ->
    digit_to_tree(Max, Sf);
deep_l(Max, [], M, Sf) ->
    {Head, Tail} = pop_l(M),
    deep(Max, node_to_digit(Head), Tail, Sf);
deep_l(Max, Pr, M, Sf) ->
    deep(Max, Pr, M, Sf).

deep_r(Pr, empty, []) ->
    digit_to_tree(max_digit(Pr), Pr);
deep_r(Pr, M, []) ->
    {Head, Tail} = pop_r(M),
    deep(max_leaf(Head), Pr, Tail, node_to_digit(Head));
deep_r(Pr, M, Sf) ->
    deep(max_digit(Sf), Pr, M, Sf).

digit_to_tree(Max, Digit) ->
    case Digit of
        []        -> empty(); %% XXX: 必要?
        [A]       -> single(A);
        [A,B]     -> deep(Max, [A],   empty, [B]);
        [A,B,C]   -> deep(Max, [A,B], empty, [C]);
        [A,B,C,D] -> deep(Max, [A,B], empty, [C,D])
    end.

node_to_digit({node, _, A, B})    -> [A, B];
node_to_digit({node, _, A, B, C}) -> [A, B, C].

head_leaf({single, A})            -> A;
head_leaf({deep, _, [A|_], _, _}) -> A.

fold_l(Fn, Init, Tree) ->
    fold_tree_l(Fn, Init, Tree).

fold_tree_l(Fn, Acc, Tree) ->
    case Tree of
        empty                -> Acc;
        {single, A}          -> fold_leaf_l(Fn, Acc, A);
        {deep, _, Pr, M, Sf} -> fold_digit_l(Fn, fold_tree_l(Fn, fold_digit_l(Fn, Acc, Pr), M), Sf)
    end.

fold_leaf_l(Fn, Acc, Leaf) ->
    case Leaf of
        {node, _, A, B}    -> fold_leaf_l(Fn, fold_leaf_l(Fn, Acc, A), B);
        {node, _, A, B, C} -> fold_leaf_l(Fn, fold_leaf_l(Fn, fold_leaf_l(Fn, Acc, A), B), C);
        Elem               -> Fn(Elem, Acc)
    end.

fold_digit_l(Fn, Acc, Digit) ->
    lists:foldl(fun (A, Acc0) -> fold_leaf_l(Fn, Acc0, A) end,
                Acc,
                Digit).

fold_r(Fn, Init, Tree) ->
    fold_tree_r(Fn, Init, Tree).

fold_tree_r(Fn, Acc, Tree) ->
    case Tree of
        empty                -> Acc;
        {single, A}          -> fold_leaf_r(Fn, Acc, A);
        {deep, _, Pr, M, Sf} -> fold_digit_r(Fn, fold_tree_r(Fn, fold_digit_r(Fn, Acc, Sf), M), Pr)
    end.

fold_leaf_r(Fn, Acc, Leaf) ->
    case Leaf of
        {node, _, A, B}    -> fold_leaf_r(Fn, fold_leaf_r(Fn, Acc, B), A);
        {node, _, A, B, C} -> fold_leaf_r(Fn, fold_leaf_r(Fn, fold_leaf_r(Fn, Acc, C), B), A);
        Elem               -> Fn(Elem, Acc)
    end.

fold_digit_r(Fn, Acc, Digit) ->
    lists:foldr(fun (A, Acc0) -> fold_leaf_r(Fn, Acc0, A) end,
                Acc,
                Digit).

insert(Elem, Tree)  ->
    case get_max(max_tree(Tree), Elem) of
        Elem  -> push_r(Elem, Tree);
        _     -> insert_to_tree(Elem, Tree)
    end.

insert_to_tree(Elem, Tree) ->
    case Tree of
        empty               -> push_l(Elem, Tree);
        {single, _}         -> push_l(Elem, Tree);
        {deep, _, Pr, M, _} ->
            PrMax = case M of  %% XXX: 複雑
                        empty -> max_digit(Pr);
                        _     -> max_leaf(head_leaf(M))
                    end,
            case max(Elem, PrMax) of
                Elem -> case get_max(Elem, get_max(PrMax, max_tree(M))) of
                            Elem -> insert_to_deep_sf(Elem, Tree);
                            _    -> insert_to_deep_m(Elem, Tree)
                        end;
                _    -> insert_to_deep_pr(Elem, Tree)
            end
    end.

insert_to_deep_pr(Elem, {deep, Max, Pr, M, Sf}) ->
    case insert_to_digit(Elem, Pr) of
        [A,B,C,D,E] -> deep(Max, [A,B], push_l(node(C,D,E),M), Sf);
        Pr1         -> deep(Max, Pr1, M, Sf)
    end.

insert_to_deep_m(Elem, {deep, Max, Pr, M, Sf}) ->
    M1 = insert_to_tree(Elem, M),
    deep(Max, Pr, M1, Sf).

insert_to_deep_sf(Elem, {deep, Max, Pr, M, Sf}) ->
    case insert_to_digit(Elem, Sf) of
        [A,B,C,D,E] -> deep(Max, Pr, push_r(node(A,B,C),M), [D,E]);
        Sf1         -> deep(Max, Pr, M, Sf1)
    end.

insert_to_digit(Elem, [A]) ->
    case get_max(Elem, A) of
        Elem -> push_to_leaf_r(Elem, A);
        _    -> insert_to_leaf(Elem, A)
    end;
insert_to_digit(Elem, [A|Digit]) ->
    case get_max(Elem, max_leaf(A)) of
        Elem -> [A | insert_to_digit(Elem, Digit)];
        _    -> insert_to_leaf(Elem, A) ++ Digit
    end.

push_to_leaf_r(Elem, Leaf) ->
    case Leaf of
        {node, _, A, B}    -> case push_to_leaf_r(Elem, B) of
                                  [B1]    -> [{node, Elem, A, B1}];
                                  [B1,B2] -> [{node, Elem, A, B1, B2}]
                              end;
        {node, _, A, B, C} -> case push_to_leaf_r(Elem, C) of
                                  [C1]    -> [{node, Elem, A, B, C1}];
                                  [C1,C2] -> [{node, max_leaf(B), A, B}, {node, Elem, C1, C2}]
                              end;
        Elem2 -> [Elem2, Elem]
    end.

insert_to_leaf(Elem, Leaf) ->
    case Leaf of
        {node, Max, A, B}    ->
            case get_max(Elem, max_leaf(A)) of
                Elem -> case insert_to_leaf(Elem, B) of
                            [B1]    -> [{node, Max, A, B1}];
                            [B1,B2] -> [{node, Max, A, B1, B2}]
                        end;
                _    -> case insert_to_leaf(Elem, A) of
                            [A1]    -> [{node, Max, A1, B}];
                            [A1,A2] -> [{node, Max, A1, A2, B}]
                        end
            end;
        {node, Max, A, B, C} ->
            case get_max(Elem, max_leaf(A)) of
                Elem -> case get_max(Elem, max_leaf(B)) of
                            Elem -> case insert_to_leaf(Elem, C) of
                                        [C1]    -> [{node, Max, A, B, C1}];
                                        [C1,C2] -> [{node, max_leaf(B), A, B}, {node, Max, C1, C2}]
                                    end;
                            _    -> case insert_to_leaf(Elem, C) of
                                        [B1]    -> [{node, Max, A, B1, C}];
                                        [B1,B2] -> [{node, max_leaf(B1), A, B1}, {node, Max, B2, C}]
                                    end
                        end;
                _    -> case insert_to_leaf(Elem, A) of
                            [A1]    -> [{node, Max, A1, B, C}];
                            [A1,A2] -> [{node, max_leaf(A2), A1, A2}, {node, Max, B, C}]
                        end
            end;
        Elem2 -> [Elem, Elem2]
    end.

get_max(A, minus_inf)    -> A;
get_max(minus_inf, B)    -> B;
get_max(A, B) when A > B -> A;
get_max(_, B)            -> B.

max_digit(Digit) ->
    max_leaf(lists:last(Digit)).

max_tree(Tree) ->
    case Tree of
        empty              -> minus_inf;
        {single, A}        -> max_leaf(A);
        {deep, M, _, _, _} -> M
    end.

max_leaf(Leaf) ->
    case Leaf of
        {node, M, _, _}    -> M;
        {node, M, _, _, _} -> M;
        Elem               -> Elem
    end.