DouKaku?

module I = Int64

let build_answer () =
    let addm m1 m2 = I.logor (I.shift_left m1 16) (I.of_int m2) in

    let sep m =
        let f s = (m lsr (4 * s)) land 15 in
        f 3 lor f 2, f 1 lor f 0 in

    let pat = [
        0x1248; 0x1284; 0x1428; 0x1482; 0x1824; 0x1842;
        0x2148; 0x2184; 0x2418; 0x2481; 0x2814; 0x2841;
        0x4128; 0x4182; 0x4218; 0x4281; 0x4812; 0x4821;
        0x8124; 0x8142; 0x8214; 0x8241; 0x8412; 0x8421 ] in

    let rec loop n acc tmp m0 m1 m2 lis =
        if n = 0 then tmp :: acc else match lis with
        | []       -> acc
        | hd :: tl ->
            let mm = hd in
            let mu, ml = sep mm in
            let acc = (match n, m0 land mm, m1 land mu, m2 land ml with
                | 4, 0, _, _
                | 2, 0, _, _ -> loop (n-1) acc (addm tmp mm) (m0 lor mm) (m1 lor mu) (m2 lor ml) pat
                | _, 0, 0, 0 -> loop (n-1) acc (addm tmp mm) (m0 lor mm) 0 0 pat
                | _          -> acc) in
            loop n acc tmp m0 m1 m2 tl in
    loop 4 [] 0L 0 0 0 pat

let test_answer ans =
    let sr4 m = I.shift_right_logical m 4 in

    let count target ans mask =
        let rec loop acc m = function
            | [] -> acc
            | hd :: tl -> if acc > 1 then acc
                                     else loop (if I.logand hd m = m then acc + 1 else acc) m tl in
        loop 0 (I.logand target (I.lognot mask)) ans in

    let ismin target ans mask =
        let rec im target ans mask = function
            | 0L -> true
            | m  -> if I.logand mask m = 0L && count target ans (I.logor mask m) = 1 then false
                    else im target ans mask (sr4 m) in
        im target ans mask 0xF000000000000000L in

    let rec check ans target arr n curm m =
        if m = 0L then arr else
            let nextm = I.logor curm m in
            let m4 = sr4 m in
            match count target ans nextm with
            | 0 -> arr
            | 1 -> let arr = if ismin target ans nextm then (arr.(n-1) <- arr.(n-1) + 1; arr)
                        else check ans target arr (n-1) nextm m4 in
                    check ans target arr n curm m4
            | _ ->  check ans target (check ans target arr (n-1) (I.logor curm m) m4) n curm m4 in

    let loop ans arr target =
(*        let _ = Printf.printf "%16LX\n%!" target in *)
        check ans target arr 16 0L 0xF000000000000000L in
    List.fold_left (loop ans) (Array.create 17 0)
        (List.filter (fun x -> Int64.logand x 0x1248L = 0x1248L) ans)

let _ =
    let ans = build_answer () in
    let arr = test_answer ans in
    Array.iteri (fun i m -> Printf.printf "%2d: %5d\n" i (m*24)) arr