shanten.fs

module Shanten.Direct

module CountList = begin
    type T = (int*int) list

    let empty = List.empty<int*int>
    let ofSeq pred s =
        seq { for k,vs in Seq.groupBy pred s do yield k,Seq.length vs}
        |> Seq.sortBy fst
        |> List.ofSeq

    let total (list:T) =
        List.fold (fun acc (k,v) -> v+acc) 0 list

    let rec incdec key num (list:T) (acc:T) =
        match list with
        | [] -> List.rev acc
        | (k, v)::tl when k=key && num < 0 && v <= -num -> incdec key num tl acc // just remove key
        | (k, v)::tl when k=key -> incdec key num tl <| (key, v+num)::acc
        | _else::tl -> incdec key num tl <| _else::acc

    let decBy k n t = incdec k -n t []
    let dec k t = decBy k 1 t
    let decAll ks t = List.fold (fun acc v -> dec v acc) t ks
    let decAllBy ks t = List.fold (fun acc (k,n) -> decBy k n acc) t ks
end

module Shanten = begin
    type State =
        { sets : int
        ; forms: int
        ; pairs: int
        ; h: CountList.T
        ; setList: int list list
        }
        static member init h = {sets = 0; pairs = 0; forms = 0; h = h; setList = []};

    let count (s:State) =
        8 - 2*s.sets - s.pairs - s.forms

    module Set = begin
        let same n v = [for i = 1 to n do yield v]
        let cons k1 k2 = [for i = k1 to k2 do yield i]

        let (|Same|_|) n s =
            match s with
            | (k,v)::_ when v=n -> Some <| same n k
            | _ -> None

        let (|Cons|_|) s =
            match s with
            | (k1,_)::_::(k2,_)::_
                when (k1 > 10) && (k1 % 10 < 8) && (k2 = 2 + k1)
                -> Some <| cons k1 k2
            | _ -> None
    end

    let consumeSet smth (st:State) =
        let cs = CountList.ofSeq id smth
        {st with h = (CountList.decAllBy cs st.h); sets = st.sets+1; setList = smth::st.setList}

    let traverse h =
        let results = ref List.empty<State>
        let steps = ref 0

        let rec cutPair (st:State) =
            let pairs = List.filter (snd >> (<=) 2) st.h
            let starts =
                pairs
                |> List.map (fun (k,_) ->
                    {st with h=(CountList.decBy k 2 st.h);pairs=1;setList=[Set.same 2 k]})
            List.iter (cutSet 0) (st::starts)
        and cutSet offset (st:State) =
            steps := !steps + 1
            let {sets = S; h = H; setList = R} = st
            let ss = List.skip offset st.h
            match ss with
            | [] -> cutForm 0 st
            | _ ->
                match ss with
                | Set.Same 3 r -> cutSet offset <| consumeSet r st
                | _ -> ()
                match ss with
                | Set.Cons r -> cutSet offset <| consumeSet r st
                | _ -> ()
                cutSet (offset+1) st
        and cutForm offset (st:State) =
            let st' = {st with setList = List.rev st.setList}
            results := st'::!results

        h |> State.init |> cutPair
        printfn "steps: %d" <| !steps
        !results
end

let main _ =
    let r =
//        [3; 3; 3; 21; 21; 22; 22; 22; 23; 23; 23; 24; 24]
//        [4; 5; 6; 1; 1; 1; 11; 11; 15; 15; 22; 23; 24]
        [11; 11; 11; 12; 13; 14; 15; 16; 17; 18; 19; 19; 19; 13]
        |> CountList.ofSeq id
        |> Shanten.traverse
        |> List.rev
    printfn "-------------------- in generation order --------------------"
    r |> List.iter (printfn "%A")
    printfn "-------------------- by shanten --------------------"
    r
        |> List.sortBy (fun t -> (Shanten.count t, List.length t.h))
        |> List.iter (printfn "%A")
    printfn "%d at all" <| List.length r
    0