36 lines
1.8 KiB
Forth
36 lines
1.8 KiB
Forth
(*
|
|
I define a discriminated union to provide Nonogram Solver functionality.
|
|
Nigel Galloway May 28th., 2016
|
|
*)
|
|
type N =
|
|
|X |B |V
|
|
static member fn n i =
|
|
let fn n i = [for g = 0 to i-n do yield Array.init (n+g) (fun e -> if e >= g then X else B)]
|
|
let rec fi n i = [
|
|
match n with
|
|
| h::t -> match t with
|
|
| [] -> for g in fn h i do yield Array.append g (Array.init (i-g.Length) (fun _ -> B))
|
|
| _ -> for g in fn h ((i-List.sum t)+t.Length) do for a in fi t (i-g.Length-1) do yield Array.concat[g;[|B|];a]
|
|
| [] -> yield Array.init i (fun _ -> B)
|
|
]
|
|
fi n i
|
|
static member fi n i = Array.map2 (fun n g -> match (n,g) with |X,X->X |B,B->B |_->V) n i
|
|
static member fg (n: N[]) (i: N[][]) g = n |> Seq.mapi (fun e n -> i.[e].[g] = n || i.[e].[g] = V) |> Seq.forall (fun n -> n)
|
|
static member fe (n: N[][]) = n|> Array.forall (fun n -> Array.forall (fun n -> n <> V) n)
|
|
static member fl n = n |> Array.Parallel.map (fun n -> Seq.reduce (fun n g -> N.fi n g) n)
|
|
static member fa (nga: list<N []>[]) ngb = Array.Parallel.mapi (fun i n -> List.filter (fun n -> N.fg n ngb i) n) nga
|
|
static member fo n i g e =
|
|
let na = N.fa n e
|
|
let ia = N.fl na
|
|
let ga = N.fa g ia
|
|
(na, ia, ga, (N.fl ga))
|
|
static member toStr n = match n with |X->"X"|B->"."|V->"?"
|
|
static member presolve ((na: list<N []>[]), (ga: list<N []>[])) =
|
|
let nb = N.fl na
|
|
let x = N.fa ga nb
|
|
let rec fn n i g e l =
|
|
let na,ia,ga,ea = N.fo n i g e
|
|
let el = ((Array.map (fun n -> List.length n) na), (Array.map (fun n -> List.length n) ga))
|
|
if ((fst el) = (fst l)) && ((snd el) = (snd l)) then (n,i,g,e,(Array.forall (fun n -> n = 1) (fst l))) else fn na ia ga ea el
|
|
fn na nb x (N.fl x) ((Array.map (fun n -> List.length n) na), (Array.map (fun n -> List.length n) ga))
|