trans.ml

let alphabet = ['a'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g'; 
    'h'; 'i'; 'j'; 'k'; 'l'; 'm'; 'n'; 'o'; 'p'; 'q'; 
    'r'; 's'; 't'; 'u'; 'v'; 'w'; 'x'; 'y'; 'z']

let rec nth l = function
    0   ->  List.hd l
|   i   ->  nth (List.tl l) (i - 1) 

let rec trans1 = function
    []      -> []
|   x::xs   -> nth alphabet x :: trans1 xs

let rec test1 l = function
    0   -> ();
|   i   -> 
        let _ = trans1 l in
        test1 l (i - 1);;

type 'a tree =
    L of 'a
|   N of int * 'a tree * 'a tree

let join = function
    ((L _) as t1), ((L _) as t2)                  -> N(2, t1, t2)
|   ((L _) as t1), ((N(n, _, _)) as t2) |
    ((N(n, _, _)) as t1), ((L _) as t2)           -> N(n + 1, t1, t2)
|   ((N(n1, _, _)) as t1), ((N (n2, _, _)) as t2) -> N(n1 + n2, t1, t2)

let rec inner = function
    []          -> []
|   x::[]       -> [x]
|   x::(y::xs)  -> (join (x, y)) :: inner xs

let rec build_tree = function
    x::[]       -> x
|   xs          -> build_tree (inner xs)

let rec extract_tree = function
    0, N(_, (L e), r)                   -> e
|   1, N(2, (L _), (L r))        -> r
|   n, N(c, (L _), r)            ->
        extract_tree (n - 1, r)
|   n, N(n1, l, (L e)) when n + 1 == n1 -> e
|   n, N(c, (N(cl, _, _) as l), r)      ->
        if n < cl then
            extract_tree (n, l)
        else
            extract_tree (n - cl, r)
|   _   -> failwith "error"

let alphabet_tree         = build_tree (List.map (fun x -> L x) alphabet)
let check_extract_tree () = 
    let rec loop i =
        if i > 25 then []
        else extract_tree (i, alphabet_tree) :: loop (i + 1)
    in
    loop 0

let rec trans2 l =
    match l with
        []      -> []
    |   x::xs   -> extract_tree (x, alphabet_tree) :: trans2 xs

let rec test2 l = function
    0   -> ();
|   i   -> 
        let _ = trans2 l in
        test2 l (i - 1);;

(*
test1 [1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1] 1000000
test1 [25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25] 1000000
test2 [1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1] 1000000
test2 [25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25; 25] 1000000
*)