How to resolve the algorithm Nonogram solver step by step in the F# programming language
How to resolve the algorithm Nonogram solver step by step in the F# programming language
Table of Contents
Problem Statement
A nonogram is a puzzle that provides numeric clues used to fill in a grid of cells, establishing for each cell whether it is filled or not. The puzzle solution is typically a picture of some kind. Each row and column of a rectangular grid is annotated with the lengths of its distinct runs of occupied cells. Using only these lengths you should find one valid configuration of empty and occupied cells, or show a failure message. The problem above could be represented by two lists of lists: A more compact representation of the same problem uses strings, where the letters represent the numbers, A=1, B=2, etc: For this task, try to solve the 4 problems below, read from a “nonogram_problems.txt” file that has this content (the blank lines are separators): Extra credit: generate nonograms with unique solutions, of desired height and width.
This task is the problem n.98 of the "99 Prolog Problems" (archived) by Werner Hett (also thanks to Paul Singleton for the idea and the examples).
Let's start with the solution:
Step by Step solution about How to resolve the algorithm Nonogram solver step by step in the F# programming language
Source code in the fsharp programming language
(*
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))
let fe (n : array<string>) i = n |> Array.collect (fun n -> [|N.fn [for g in n -> ((int)g-64)] i|])
let fl (n : array<string>) (i : array<string>) = (fe n i.Length), (fe i n.Length)
let rFile =
try
use file = File.OpenText @"nonogram.txt"
Some(fl (file.ReadLine().Split ' ') (file.ReadLine().Split ' '))
with | _ -> printfn "Error reading file" ; None
let n,i,g,e,l = N.presolve rFile.Value
if l then i |> Array.iter (fun n -> n |> Array.iter (fun n -> printf "%s" (N.toStr n));printfn "") else printfn "No unique solution"
You may also check:How to resolve the algorithm String length step by step in the OCaml programming language
You may also check:How to resolve the algorithm Tic-tac-toe step by step in the Tcl programming language
You may also check:How to resolve the algorithm Combinations and permutations step by step in the Tcl programming language
You may also check:How to resolve the algorithm Program name step by step in the Go programming language
You may also check:How to resolve the algorithm Hello world/Graphical step by step in the RapidQ programming language