How to resolve the algorithm Nonogram solver step by step in the F# programming language

Published on 12 May 2024 09:40 PM

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