let comb n =
    let rec comb1 mask cost acc = function
        | 0 -> if cost = 0 then acc else (mask, cost) :: acc
        | x ->
            let acc = comb2 (mask lor x) (cost+1) acc (x lsr 1) in
                      comb1  mask         cost    acc (x lsr 1)
    and comb2 mask cost acc = function
        | 0 -> (mask, cost) :: acc
        | x -> comb1 mask cost acc (x lsr 1) in
    comb1 0 0 [] (1 lsl (n - 2))

let apply mask cost (state, (c1, c2)) =
    let rec apply' prev mask = function
        | []    -> [ prev ]
        | head :: tail ->
            if (mask land 1)=1 then head :: apply' prev (mask lsr 1) tail
                               else prev :: apply' head (mask lsr 1) tail in
    (match state with
    | []       -> []
    | hd :: tl -> apply' hd mask tl), (c1 + 1, c2 + cost)

let drawamida mask n =
    let rec amida s mask = function
        | 0 -> s
        | x -> if (mask land 1) = 0 then amida (s ^ " |") (mask lsr 1) (x-1)
                                    else amida (s ^ "-|") (mask lsr 1) (x-1) in
    amida "|" mask (n - 1)

let rec equal arg1 arg2 = match arg1, arg2 with
    | [], []                -> true
    | h1 :: t1, h2 :: t2    -> if h1 <> h2 then false else equal t1 t2
    | _, _                  -> false

let solve targetstate options limitcost initstate =
    let rec loop target options best current =
        let bestsoln, bestcost  = best in
        let curstate, curoption, cursoln, curcost = current in
        let costcomp (c1, c2) (m1, m2) = c1 >= m1 ||  c2 >= m2 in
        if (costcomp curcost bestcost) then best else (
            if equal target curstate then cursoln, curcost else (
                match curoption with
                    | []       -> best
                    | (mask, cost) :: tl ->
                        let newstate, newcost = apply mask cost (curstate, curcost) in
                        let best =  loop target options best (newstate, options, (mask :: cursoln), newcost) in
                                    loop target options best (curstate, tl, cursoln, curcost)
            )
        ) in
    loop targetstate options ([], limitcost) (initstate, options, [], (0, 0))

let main target =
    let rec prt = function | [] -> print_endline "" | hd :: tl -> let _ = Printf.printf "%d " hd in prt tl in
    let rec seq n   = function [] -> [] | _ :: tl -> n :: (seq (n+1) tl) in
    let len         = List.length target in
    let start       = seq 0 target in
    let _           = prt start in
    let best, (c,d) = solve target (comb len) (len, len * len) start in
    let rec prt2 n  = function [] -> () | hd :: tl -> (print_endline (drawamida hd n); prt2 n tl) in
    let _           = prt2 len (List.rev best) in
    let _           = prt target  in
    Printf.printf "Height=%d, Lines=%d\n" c d

let _ = main [ 3; 5; 2; 4; 0; 1]