Nonogram solver: Difference between revisions

m
→‎{{header|Wren}}: Changed to Wren S/H and removed unnecessary import.
(→‎{{header|Common Lisp}}: fix off-by-one error introduced by my previous change)
m (→‎{{header|Wren}}: Changed to Wren S/H and removed unnecessary import.)
 
(14 intermediate revisions by 11 users not shown)
Line 49:
'''Extra credit''': generate nonograms with unique solutions, of desired height and width.
<br><br>
This task is the problem n.98 of the "[https://sites.google.com/site/prologsite/prolog-problems 99 Prolog Problems]" [https://web.archive.org/web/20230406102539/https://sites.google.com/site/prologsite/prolog-problems (archived)] by Werner Hett (also thanks to Paul Singleton for the idea and the examples).
<br><br>
; Related tasks
Line 60:
* http://picolisp.com/5000/!wiki?99p98 (PicoLisp)
<br><br>
 
=={{header|11l}}==
{{trans|Python 3}}
 
<syntaxhighlight lang="11l">F gen_row(w, s)
‘Create all patterns of a row or col that match given runs.’
F gen_seg([[Int]] o, Int sp) -> [[Int]]
I o.empty
R [[2] * sp]
[[Int]] r
L(x) 1 .< sp - o.len + 2
L(tail) @gen_seg(o[1..], sp - x)
r [+]= [2] * x [+] o[0] [+] tail
R r
 
R gen_seg(s.map(i -> [1] * i), w + 1 - sum(s)).map(x -> x[1..])
 
F deduce(hr, vr)
‘Fix inevitable value of cells, and propagate.’
F allowable(row)
R row.reduce((a, b) -> zip(a, b).map((x, y) -> x [|] y))
 
F fits(a, b)
R all(zip(a, b).map((x, y) -> x [&] y))
 
V (w, h) = (vr.len, hr.len)
V rows = hr.map(x -> gen_row(@w, x))
V cols = vr.map(x -> gen_row(@h, x))
V can_do = rows.map(allowable)
 
V mod_rows = Set[Int]()
V mod_cols = Set(0 .< w)
 
F fix_col(n)
‘See if any value in a given column is fixed;
if so, mark its corresponding row for future fixup.’
V c = @can_do.map(x -> x[@n])
@cols[n] = @cols[n].filter(x -> @@fits(x, @c))
L(x) @allowable(@cols[n])
V i = L.index
I x != @can_do[i][n]
@mod_rows.add(i)
@can_do[i][n] [&]= x
 
F fix_row(n)
‘Ditto, for rows.’
V c = @can_do[n]
@rows[n] = @rows[n].filter(x -> @@fits(x, @c))
L(x) @allowable(@rows[n])
V i = L.index
I x != @can_do[n][i]
@mod_cols.add(i)
@can_do[n][i] [&]= x
 
F show_gram(m)
L(x) m
print(x.map(i -> ‘x#.?’[i]).join(‘ ’))
print()
 
L !mod_cols.empty
L(i) mod_cols
fix_col(i)
mod_cols.clear()
L(i) mod_rows
fix_row(i)
mod_rows.clear()
 
I all(multiloop((0 .< w), (0 .< h), (j, i) -> @can_do[i][j] C (1, 2)))
print(‘Solution would be unique’)
E
print(‘Solution may not be unique, doing exhaustive search:’)
 
V out = [[Int]()] * h
 
F try_all(Int n) -> Int
I n >= @h
L(j) 0 .< @w
I @out.map(x -> x[@j]) !C @cols[j]
R 0
@show_gram(@out)
R 1
V sol = 0
L(x) @rows[n]
@out[n] = x
sol += @try_all(n + 1)
R sol
 
V n = try_all(0)
I n == 0
print(‘No solution.’)
E I n == 1
print(‘Unique solution.’)
E
print(n‘ solutions.’)
print()
 
F solve(p, show_runs = 1B)
[[[Int]]] s
L(l) p.split("\n")
s [+]= l.split(‘ ’).map(w -> w.map(c -> c.code - ‘A’.code + 1))
I show_runs
print(‘Horizontal runs: ’s[0])
print(‘Vertical runs: ’s[1])
deduce(s[0], s[1])
 
L(p) File(‘nonogram_problems.txt’).read().split("\n\n")
solve(p)
 
print(‘Extra example not solvable by deduction alone:’)
solve("B B A A\nB B A A")
 
print(‘Extra example where there is no solution:’)
solve("B A A\nA A A")</syntaxhighlight>
 
{{out}}
<pre>
Horizontal runs: [[3], [2, 1], [3, 2], [2, 2], [6], [1, 5], [6], [1], [2]]
Vertical runs: [[1, 2], [3, 1], [1, 5], [7, 1], [5], [3], [4], [3]]
Solution would be unique
. # # # . . . .
# # . # . . . .
. # # # . . # #
. . # # . . # #
. . # # # # # #
# . # # # # # .
# # # # # # . .
. . . . # . . .
. . . # # . . .
 
Unique solution.
 
(... etc. ...)
</pre>
 
=={{header|C sharp}}==
<langsyntaxhighlight lang="csharp">using System;
using System.Collections.Generic;
using static System.Linq.Enumerable;
Line 178 ⟶ 311:
}
 
}</langsyntaxhighlight>
{{out}}
<pre style="height:30ex;overflow:scroll">
Line 251 ⟶ 384:
=={{header|C++}}==
===The Solver===
<langsyntaxhighlight lang="cpp">
// A class to solve Nonogram (Hadje) Puzzles
// Nigel Galloway - January 23rd., 2017
Line 311 ⟶ 444:
return n.str();
}};
</syntaxhighlight>
</lang>
 
===The Task===
<langsyntaxhighlight lang="cpp">
// For the purpose of this task I provide a little code to read from a file in the required format
// Note though that Nonograms may contain blank lines and values greater than 24
Line 345 ⟶ 478:
std::cout << "\n" << myN.toStr() << std::endl;
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 431 ⟶ 564:
===Bonus GCHQ Xmas Puzzle===
[[https://www.gchq.gov.uk/news-article/christmas-card-cryptographic-twist-charity GCHQ Xmas Puzzle]] is a Nonogram. They say "We pre-shaded a few cells to help people get started. Without this, the puzzle would have been slightly ambiguous, though the error correction used in QR codes means that the URL would have been recovered anyway. As a small Easter egg, the pre-shaded cells spell out “GCHQ” in Morse code."
<langsyntaxhighlight lang="cpp">
int main(){
const std::vector<std::vector<int>> Ngchq={{ 7,3,1, 1,7},
Line 510 ⟶ 643:
std::cout << "\n" << myN.toStr() << std::endl;
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 541 ⟶ 674:
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">(defpackage :ac3
(:use :cl)
(:export :var
Line 715 ⟶ 848:
(nonogram (parse-nonogram (read-until-line s)
(read-until-line s)))))
(end-of-file ())))</langsyntaxhighlight>
{{out}}
<pre>CL-USER> (time (nonogram::solve-from-file "c:/Users/cro/Dropbox/Projects/rosetta-code/nonogram_problems.txt"))
Line 806 ⟶ 939:
=={{header|D}}==
{{trans|Python}}
<langsyntaxhighlight lang="d">import std.stdio, std.range, std.file, std.algorithm, std.string;
 
/// Create all patterns of a row or col that match given runs.
Line 941 ⟶ 1,074:
"Extra example where there is no solution:".writeln;
"B A A\nA A A".solve;
}</langsyntaxhighlight>
{{out}}
<pre>Horizontal runs: [[3], [2, 1], [3, 2], [2, 2], [6], [1, 5], [6], [1], [2]]
Line 1,060 ⟶ 1,193:
 
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight lang="fsharp">
(*
I define a discriminated union to provide Nonogram Solver functionality.
Line 1,096 ⟶ 1,229:
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))
</syntaxhighlight>
</lang>
For the purposes of this task I provide a little code to read the input from a file
<langsyntaxhighlight lang="fsharp">
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)
Line 1,106 ⟶ 1,239:
Some(fl (file.ReadLine().Split ' ') (file.ReadLine().Split ' '))
with | _ -> printfn "Error reading file" ; None
</syntaxhighlight>
</lang>
This may be used:
<langsyntaxhighlight lang="fsharp">
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"
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,197 ⟶ 1,330:
=={{header|Go}}==
{{trans|Java}}
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,380 ⟶ 1,513:
newPuzzle(puzzleData)
}
}</langsyntaxhighlight>
 
{{out}}
Line 1,451 ⟶ 1,584:
. . . . . . . . . . . . . . . . . # # # # # # # #
. . . . . . . . . . . . . . . . . . # # # # # # #
</pre>
 
 
=={{header|Haskell}}==
{{works with|GHC|8.10.7}}
{{libheader|csp}}
<syntaxhighlight lang="haskell">import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.CSP
import Data.List (transpose)
import System.Environment (getArgs)
import Text.ParserCombinators.ReadP (ReadP)
import qualified Text.ParserCombinators.ReadP as P
import Text.Printf (printf)
 
main :: IO ()
main = do
file <- parseArgs
printf "reading problem file from %s\n" file
ps <- parseProblems file
forM_ ps $ \p -> do
print p
putStrLn ""
printSolution $ solve p
putStrLn ""
 
-------------------------------------------------------------------------------
-- parsing
-------------------------------------------------------------------------------
 
parseArgs :: IO FilePath
parseArgs = do
args <- getArgs
case args of
[file] -> return file
_ -> ioError $ userError "expected exactly one command line argument, the name of the problem file"
 
data Problem = Problem
{ rows :: [[Int]]
, cols :: [[Int]]
} deriving (Show, Read, Eq, Ord)
 
entryP :: ReadP Int
entryP = do
n <- fromEnum <$> P.get
if n < 65 || n > 90
then P.pfail
else return $ n - 64
 
blankP, eolP :: ReadP Char
blankP = P.char ' '
eolP = P.char '\n'
 
entriesP :: ReadP [Int]
entriesP = ([] <$ blankP) <|> P.many1 entryP
 
lineP :: ReadP [[Int]]
lineP = P.sepBy1 entriesP blankP <* eolP
 
problemP :: ReadP Problem
problemP = Problem <$> lineP <*> lineP
 
problemsP :: ReadP [Problem]
problemsP = P.sepBy1 problemP (P.many blankP <* eolP) <* P.eof
 
parseProblems :: FilePath -> IO [Problem]
parseProblems file = do
s <- readFile file
case P.readP_to_S problemsP s of
[(ps, "")] -> return ps
_ -> ioError $ userError $ "error parsing file " <> file
 
-------------------------------------------------------------------------------
-- CSP
-------------------------------------------------------------------------------
 
solve :: Problem -> [[Bool]]
solve = oneCSPSolution . problemCSP
 
problemCSP :: Problem -> CSP r [[DV r Bool]]
problemCSP p = do
let rowCount = length $ rows p
colCount = length $ cols p
cells <- replicateM rowCount
$ replicateM colCount
$ mkDV [False, True]
 
forM_ (zip cells $ rows p) $ uncurry rowOrColCSP
forM_ (zip (transpose cells) $ cols p) $ uncurry rowOrColCSP
 
return cells
 
rowOrColCSP :: [DV r Bool] -> [Int] -> CSP r ()
rowOrColCSP ws [] = forM_ ws $ constraint1 not
rowOrColCSP ws xs = do
let vs = zip [0 ..] ws
n = length ws
 
blocks <- forM xs $ \x ->
mkDV [(i, i + x - 1) | i <- [0 .. n - x]] -- the blocks, given by first and last index
 
-- blocks must be separate and not overlapping
f blocks
 
-- cells in blocks are set
forM_ blocks $ \x ->
forM_ vs $ \(i, y) ->
constraint2 (\(x1, x2) b -> i < x1 || i > x2 || b) x y
 
-- cells before the first block are not set
forM_ vs $ \(i, y) ->
constraint2 (\(y', _) b -> i >= y' || not b) (head blocks) y
 
-- cells after the last block are not set
forM_ vs $ \(i, y) ->
constraint2 (\(_, y') b -> i <= y' || not b) (last blocks) y
 
-- cells between blocks are not set
forM_ (zip blocks $ tail blocks) $ \(x, y) ->
forM_ vs $ \(i, z) ->
constraint3 (\(_, x') (y', _) b -> i <= x' || i >= y' || not b) x y z
where
f :: [DV r (Int, Int)] -> CSP r ()
f (u : v : bs) = do
constraint2 (\(_, u') (v', _) -> v' >= u' + 2) u v
f $ v : bs
f _ = return ()
 
-------------------------------------------------------------------------------
-- printing
-------------------------------------------------------------------------------
 
printSolution :: [[Bool]] -> IO ()
printSolution bss =
forM_ bss $ \bs -> do
forM_ bs $ \b ->
putChar $ if b then '#' else '.'
putChar '\n'</syntaxhighlight>
 
{{out}}
<pre>
time cabal run nonogram-solver -- nonogram-problems.txt
 
reading problem file from nonogram-problems.txt
Problem {rows = [[3],[2,1],[3,2],[2,2],[6],[1,5],[6],[1],[2]], cols = [[1,2],[3,1],[1,5],[7,1],[5],[3],[4],[3]]}
 
.###....
##.#....
.###..##
..##..##
..######
#.#####.
######..
....#...
...##...
 
Problem {rows = [[6],[3,1,3],[1,3,1,3],[3,14],[1,1,1],[1,1,2,2],[5,2,2],[5,1,1],[5,3,3,3],[8,3,3,3]], cols = [[4],[4],[1,5],[3,4],[1,5],[1],[4,1],[2,2,2],[3,3],[1,1,2],[2,1,1],[1,1,2],[4,1],[1,1,2],[1,1,1],[2,1,2],[1,1,1],[3,4],[2,2,1],[4,1]]}
 
..........######....
........###.#..###..
...#..###...#....###
..###.##############
...#..#............#
..#.#.##..........##
#####..##........##.
#####...#........#..
#####..###.###.###..
########.###.###.###
 
Problem {rows = [[3,1],[2,4,1],[1,3,3],[2,4],[3,3,1,3],[3,2,2,1,3],[2,2,2,2,2],[2,1,1,2,1,1],[1,2,1,4],[1,1,2,2],[2,2,8],[2,2,2,4],[1,2,2,1,1,1],[3,3,5,1],[1,1,3,1,1,2],[2,3,1,3,3],[1,3,2,8],[4,3,8],[1,4,2,5],[1,4,2,2],[4,2,5],[5,3,5],[4,1,1],[4,2],[3,3]], cols = [[2,3],[3,1,3],[3,2,1,2],[2,4,4],[3,4,2,4,5],[2,5,2,4,6],[1,4,3,4,6,1],[4,3,3,6,2],[4,2,3,6,3],[1,2,4,2,1],[2,2,6],[1,1,6],[2,1,4,2],[4,2,6],[1,1,1,1,4],[2,4,7],[3,5,6],[3,2,4,2],[2,2,2],[6,3]]}
 
....###.#...........
....##.####.#.......
....#.###.###.......
..##.####...........
.###.###.#....###...
###..##.##...#.###..
##..##.##....##.##..
....##.#.#..##.#.#..
....#.##.#...####...
....#.#.##.....##...
.....##.##..########
....##.##...##..####
....#.##.##.#...#..#
###..###.#####.....#
#.#.###.#....#....##
##..###.#....###.###
.#.###.##.########..
.####.###.########..
...#.####.##.#####..
...#.####.##...##...
....####..##...#####
...#####.###...#####
...####.#..........#
..####.##...........
..###.###...........
 
Problem {rows = [[5],[2,3,2],[2,5,1],[2,8],[2,5,11],[1,1,2,1,6],[1,2,1,3],[2,1,1],[2,6,2],[15,4],[10,8],[2,1,4,3,6],[17],[17],[18],[1,14],[1,1,14],[5,9],[8],[7]], cols = [[5],[3,2],[2,1,2],[1,1,1],[1,1,1],[1,3],[2,2],[1,3,3],[1,3,3,1],[1,7,2],[1,9,1],[1,10],[1,10],[1,3,5],[1,8],[2,1,6],[3,1,7],[4,1,7],[6,1,8],[6,10],[7,10],[1,4,11],[1,2,11],[2,12],[3,13]]}
 
....................#####
..##..............###..##
.##..............#####..#
##.............########..
##....#####.###########..
#.#..##....#....######...
#..##.....#.......###....
##........#.............#
.##.....######.........##
..###############....####
.....##########..########
....##.#.####.###..######
........#################
........#################
.......##################
.......#...##############
.......#.#.##############
........#####...#########
.................########
..................#######
 
 
real 0m0,244s
user 0m0,208s
sys 0m0,031s
</pre>
 
=={{header|Java}}==
{{works with|Java|8}}
<langsyntaxhighlight lang="java">import java.util.*;
import static java.util.Arrays.*;
import static java.util.stream.Collectors.toList;
Line 1,596 ⟶ 1,953:
return countRemoved;
}
}</langsyntaxhighlight>
<pre>. # # # . . . .
# # . # . . . .
Line 1,666 ⟶ 2,023:
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">using Base.Iterators
 
struct NonogramPuzzle
Line 1,816 ⟶ 2,173:
 
processtestpuzzles(testnonograms)
</syntaxhighlight>
</lang>
<pre>
Puzzle 1:
Line 1,927 ⟶ 2,284:
=={{header|Kotlin}}==
{{trans|Java}}
<langsyntaxhighlight lang="scala">// version 1.2.0
 
import java.util.BitSet
Line 2,056 ⟶ 2,413:
newPuzzle(puzzleData)
}
}</langsyntaxhighlight>
 
{{out}}
Line 2,128 ⟶ 2,485:
. . . . . . . . . . . . . . . . . . # # # # # # #
</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">ClearAll[VisualizeGrid, Possibilities, TryRow, TryColumn]
VisualizeGrid[candgrid_List] := StringRiffle[StringJoin/@Replace[candgrid,{{0}->" ",{1}->"#",{0,1}|{1,0}->"."},{2}],"\n"]
Possibilities[clues_List, len_Integer] := Module[{spaces, numclue, spacecands, cands},
numclue = Length[clues];
spaces = len - Total[clues];
spacecands = IntegerPartitions[spaces, {numclue - 1}];
spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
cands = Catenate[Riffle[ConstantArray[1, #] & /@ clues, ConstantArray[0, #] & /@ #]] & /@ spacecands;
spacecands = IntegerPartitions[spaces, {numclue}];
spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
cands = Join[cands, Catenate[Riffle[ConstantArray[1, #] & /@ clues, ConstantArray[0, #] & /@ #]] & /@ spacecands];
cands = Join[cands, Catenate[Riffle[ConstantArray[0, #] & /@ #, ConstantArray[1, #] & /@ clues]] & /@ spacecands];
spacecands = IntegerPartitions[spaces, {numclue + 1}];
spacecands = DeleteDuplicates[Catenate[Permutations /@ spacecands]];
cands = Join[cands, Catenate[Riffle[ConstantArray[0, #] & /@ #, ConstantArray[1, #] & /@ clues]] & /@ spacecands];
cands
]
TryRow[candgrid_List, i_Integer, hclues_List] := Module[{row, clue, len, poss, newgrid},
row = candgrid[[i]];
clue = hclues[[i]];
len = Length[row];
poss = Possibilities[clue, len];
poss //= Select[MatchQ[Alternatives @@@ row]];
poss //= Transpose;
poss //= Map[Union];
newgrid = candgrid;
newgrid[[i]] = poss;
newgrid
]
TryColumn[candgrid_List, i_Integer, hclues_List] := Transpose[TryRow[Transpose[candgrid], i, hclues]]
puzzles = "C BA CB BB F AE F A B
AB CA AE GA E C D C
 
F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
 
CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
 
E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM";
puzzles = StringSplit[puzzles, "\n\n"];
puzzles = StringSplit[#, "\n"] & /@ puzzles;
puzzles = Map[StringSplit[#, " "] &, puzzles, {2}];
puzzles = Map[Characters, puzzles, {3}];
puzzles = puzzles /. Thread[CharacterRange["A", "Z"] -> (ToString /@ Range[26])];
puzzles = Map[ToExpression, puzzles, {4}];
 
Do[
hclues = puzzles[[n, 1]];
vclues = puzzles[[n, 2]];
{hsize, vsize} = {vclues // Length, hclues // Length};
cand = ConstantArray[{0, 1}, {vsize, hsize}];
oldcand = {};
While[oldcand =!= cand,
oldcand = cand;
Do[cand = TryRow[cand, i, hclues], {i, Length[hclues]}];
Do[cand = TryColumn[cand, i, vclues], {i, Length[vclues]}];
];
Print@VisualizeGrid[cand]
,
{n, 4}
]</syntaxhighlight>
{{out}}
<pre> ###
## #
### ##
## ##
######
# #####
######
#
##
 
######
### # ###
# ### # ###
### ##############
# # #
# # ## ##
##### ## ##
##### # #
##### ### ### ###
######## ### ### ###
 
### #
## #### #
# ### ###
## ####
### ### # ###
### ## ## # ###
## ## ## ## ##
## # # ## # #
# ## # ####
# # ## ##
## ## ########
## ## ## ####
# ## ## # # #
### ### ##### #
# # ### # # ##
## ### # ### ###
# ### ## ########
#### ### ########
# #### ## #####
# #### ## ##
#### ## #####
##### ### #####
#### # #
#### ##
### ###
 
#####
## ### ##
## ##### #
## ########
## ##### ###########
# # ## # ######
# ## # ###
## # #
## ###### ##
############### ####
########## ########
## # #### ### ######
#################
#################
##################
# ##############
# # ##############
##### #########
########
#######</pre>
 
=={{header|Nim}}==
To generate the sequence, we use the Java algorithm modified to directly generate bit strings (as integers) rather than character strings.
 
<langsyntaxhighlight Nimlang="nim">import std/[bitops, math, sequtils, strutils]
 
type
Line 2,142 ⟶ 2,634:
Possibility = int
 
# Possibilities described by towtwo masks and a list of integer values.
Possibilities = object
mask0: int # Mask indicating the positions of free cells.
Line 2,282 ⟶ 2,774:
echo ""
solve(rows, cols)
echo ""</langsyntaxhighlight>
 
{{out}}
Line 2,364 ⟶ 2,856:
# # # # # # # #
# # # # # # # </pre>
 
=={{header|Ol}}==
<syntaxhighlight lang="scheme">
(import (owl parse))
 
; notation parser
(define (subA x) (- x #\A -1))
 
(define line
(let-parse* (
(words (greedy+ (let-parse* (
(* (greedy* (imm #\space)))
(word (greedy+ (byte-if (lambda (x) (<= #\A x #\Z))))))
(map subA word))))
(* (maybe (imm #\newline) #f)))
words))
 
(define nonogram-parser
(let-parse* (
(rows line)
(cols line))
(cons rows cols)))
 
; nonogram printer
(define (print-nonogram ng solve)
(for-each (lambda (row y)
(for-each (lambda (x)
(if (list-ref (list-ref (car solve) y) x)
(display "X ")
(display ". ")))
(iota (length (cdr ng))))
(for-each (lambda (i)
(display " ")
(display i))
row)
(print))
(car ng)
(iota (length (car ng))))
(for-each (lambda (i)
(for-each (lambda (col)
(let ((n (lref col i)))
(if n (display n) (display " ")))
(display " "))
(cdr ng))
(print))
(iota (fold (lambda (f col) (max f (length col))) 0 (cdr ng)) 0)))
 
; possible permutation generator
(define (permutate blacks len)
; empty cells distibutions (with minimal count)
(define whites (append '(0) (repeat 1 (- (length blacks) 1)) '(0)))
(define total (- len (apply + blacks))) ; total summ of empty cells
 
(define (combine whites blacks)
; size of whites is always equal to size of blacks+1
(let loop ((line #null) (v #f) (w (reverse whites)) (b (reverse blacks)))
(if (null? w)
line
else
(loop (append (repeat v (car w)) line)
(not v)
b
(cdr w)))))
 
(map (lambda (whites) (combine whites blacks))
(let loop ((ll whites) (max total))
(if (null? (cdr ll))
(list (list max))
else
(define sum (apply + ll))
(define left (- max sum))
(if (eq? left 0)
(list ll)
else
(define head (car ll))
(fold (lambda (f i)
(define sublist (loop (cdr ll) (- max head i)))
(fold (lambda (f x)
(cons (cons (+ head i) x) f))
f
sublist))
#null
(iota (+ left 1))))))))
 
; siever of impossible combinations
(define (sieve rows cols) ; -> new cols
(fold (lambda (cols i)
; for every cell define a "definitely black" and "definitely white" cells
(define blacks (fold (lambda (f x)
(map (lambda (a b) (and a b)) f x))
(repeat #t (length cols))
(list-ref rows i)))
(define whites (fold (lambda (f x)
(map (lambda (a b) (or a b)) f x))
(repeat #f (length cols))
(list-ref rows i)))
; now filter the second list
(map (lambda (cols j)
(filter (lambda (col)
(not (or
(and (list-ref blacks j) (not (list-ref col i)))
(and (not (list-ref whites j)) (list-ref col i)))))
cols))
cols
(iota (length cols))))
cols
(iota (length rows))))
 
; main solver cycle
(define (solve rows-permuted cols-permuted)
(let loop ((rows rows-permuted) (cols cols-permuted) (flip #f))
(define new-cols (sieve rows cols))
 
(define fail (fold (lambda (f l) (or f (null? l))) #f new-cols))
(define done (fold (lambda (f l) (and f (null? (cdr l)))) #t new-cols))
 
(cond
(fail
#false)
(done
(if flip
(cons (map car new-cols) (map car rows))
(cons (map car rows) (map car new-cols))))
(else
(loop new-cols rows (not flip))))))
 
; -=( main )=----------------------------------
(define first "C BA CB BB F AE F A B
AB CA AE GA E C D C")
 
(define second "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA")
 
(define third "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC")
 
(define fourth "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM")
 
(for-each (lambda (str)
(print "nonogram:")
(print str) (print)
; decode nonogram notation
(define nonogram (parse nonogram-parser (str-iter str) #f #f #f))
 
; prepare arrays of all possible line b/w permutations
(define rows (car nonogram))
(define cols (cdr nonogram))
 
(define row-length (length cols))
(define col-length (length rows))
 
(define rows-permuted (map (lambda (x) (permutate x row-length)) rows))
(define cols-permuted (map (lambda (x) (permutate x col-length)) cols))
 
; solve nonogram
(define answer (solve rows-permuted cols-permuted))
 
; show the output
(if answer
(print-nonogram nonogram answer)
(print "Sorry, no aorrect answer found."))
(print))
(list first second third fourth))
</syntaxhighlight>
{{out}}
<pre style="height:60ex;overflow:scroll">
nonogram:
C BA CB BB F AE F A B
AB CA AE GA E C D C
 
. X X X . . . . 3
X X . X . . . . 2 1
. X X X . . X X 3 2
. . X X . . X X 2 2
. . X X X X X X 6
X . X X X X X . 1 5
X X X X X X . . 6
. . . . X . . . 1
. . . X X . . . 2
1 3 1 7 5 3 4 3
2 1 5 1
 
nonogram:
F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
 
. . . . . . . . . . . X X X X X X . . . 6
. . . . . . . . X X X . X . . X X X . . 3 1 3
. . . X . . X X X . . . X . . . . X X X 1 3 1 3
. . X X X . X X X X X X X X X X X X X X 3 14
. . . X . . X . . . . . . . . . . . . X 1 1 1
. . X . X . X X . . . . . . . . . . X X 1 1 2 2
X X X X X . . X X . . . . . . . . X X . 5 2 2
X X X X X . . . X . . . . . . . . X . . 5 1 1
X X X X X . . X X X . X X X . X X X . . 5 3 3 3
X X X X X X X X . X X X . X X X . X X X 8 3 3 3
4 4 1 3 1 1 4 2 3 1 2 1 4 1 1 2 1 3 2 4
5 4 5 1 2 3 1 1 1 1 1 1 1 1 4 2 1
2 2 1 2 2 1 2 1 1
 
nonogram:
CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
 
. . . . X X X . X . . . . . . . . . . . 3 1
. . . . X X . X X X X . X . . . . . . . 2 4 1
. . . . X . X X X . X X X . . . . . . . 1 3 3
. . X X . X X X X . . . . . . . . . . . 2 4
. X X X . X X X . X . . . . X X X . . . 3 3 1 3
. X X X . X X . X X . . . X . X X X . . 3 2 2 1 3
. X X . X X . X X . . . . X X . X X . . 2 2 2 2 2
. . . . X X . X . X . . X X . X . X . . 2 1 1 2 1 1
. . . . X . X X . X . . . X X X X . . . 1 2 1 4
. . . . X . X . X X . . . . . X X . . . 1 1 2 2
. . . . . X X . X X . . X X X X X X X X 2 2 8
. . . . X X . X X . . . X X . . X X X X 2 2 2 4
. . . . X . X X . X X . X . . . X . . X 1 2 2 1 1 1
X X X . . X X X . X X X X X . . . . . X 3 3 5 1
X . X . X X X . X . . . . X . . . . X X 1 1 3 1 1 2
X X . . X X X . X . . . . X X X . X X X 2 3 1 3 3
. X . X X X . X X . X X X X X X X X . . 1 3 2 8
. X X X X . X X X . X X X X X X X X . . 4 3 8
. . . X . X X X X . X X . X X X X X . . 1 4 2 5
. . . X . X X X X . X X . . . X X . . . 1 4 2 2
. . . . X X X X . . X X . . . X X X X X 4 2 5
. . . X X X X X . X X X . . . X X X X X 5 3 5
. . . X X X X . X . . . . . . . . . . X 4 1 1
. . X X X X . X X . . . . . . . . . . . 4 2
. . X X X . X X X . . . . . . . . . . . 3 3
2 3 3 2 3 2 1 4 4 1 2 1 2 4 1 2 3 3 2 6
3 1 2 4 4 5 4 3 2 2 2 1 1 2 1 4 5 2 2 3
3 1 4 2 2 3 3 3 4 6 6 4 6 1 7 6 4 2
2 4 4 4 6 6 2 2 1 2
5 6 6 2 3 1 4
1
 
nonogram:
E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM
 
. . . . . . . . . . . . . . . . . . . . X X X X X 5
. . X X . . . . . . . . . . . . . . X X X . . X X 2 3 2
. X X . . . . . . . . . . . . . . X X X X X . . X 2 5 1
X X . . . . . . . . . . . . . X X X X X X X X . . 2 8
X X . . . . X X X X X . X X X X X X X X X X X . . 2 5 11
X . X . . X X . . . . X . . . . X X X X X X . . . 1 1 2 1 6
X . . X X . . . . . X . . . . . . . X X X . . . . 1 2 1 3
X X . . . . . . . . X . . . . . . . . . . . . . X 2 1 1
. X X . . . . . X X X X X X . . . . . . . . . X X 2 6 2
. . X X X X X X X X X X X X X X X . . . . X X X X 15 4
. . . . . X X X X X X X X X X . . X X X X X X X X 10 8
. . . . X X . X . X X X X . X X X . . X X X X X X 2 1 4 3 6
. . . . . . . . X X X X X X X X X X X X X X X X X 17
. . . . . . . . X X X X X X X X X X X X X X X X X 17
. . . . . . . X X X X X X X X X X X X X X X X X X 18
. . . . . . . X . . . X X X X X X X X X X X X X X 1 14
. . . . . . . X . X . X X X X X X X X X X X X X X 1 1 14
. . . . . . . . X X X X X . . . X X X X X X X X X 5 9
. . . . . . . . . . . . . . . . . X X X X X X X X 8
. . . . . . . . . . . . . . . . . . X X X X X X X 7
5 3 2 1 1 1 2 1 1 1 1 1 1 1 1 2 3 4 6 6 7 1 1 2 3
2 1 1 1 3 2 3 3 7 9 10 10 3 8 1 1 1 1 10 10 4 2 12 13
2 1 1 3 3 2 1 5 6 7 7 8 11 11
</pre>
 
=={{header|Perl}}==
<langsyntaxhighlight lang="perl">use strict;
use warnings;
 
Line 2,406 ⟶ 3,163:
}
 
sub make patternsmakepatterns { # numbered to show the 'logical' order of operations
map { qr/^$_$/ # 7 convert strings to regex
} map { '[0.]*' # 6a prepend static pattern
Line 2,416 ⟶ 3,173:
. '[0.]*' # 6b append static pattern
} split ' ', shift; # 1 for each letter grouping
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,490 ⟶ 3,247:
=={{header|Phix}}==
Deduction only, no exhaustive search.
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>sequence x, y, grid
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
integer unsolved
<span style="color: #004080;">sequence</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">y</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">grid</span>
 
<span style="color: #004080;">integer</span> <span style="color: #000000;">unsolved</span>
function count_grid()
integer res = length(x)*length(y)
<span style="color: #008080;">function</span> <span style="color: #000000;">count_grid</span><span style="color: #0000FF;">()</span>
for i=1 to length(x) do
<span style="color: #004080;">integer</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)*</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span>
for j=1 to length(y) do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
res -= grid[i][j]!='?'
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">res</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'?'</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function match_mask(string neat, string mask, integer ms, integer me)
for i=ms to me do
<span style="color: #008080;">function</span> <span style="color: #000000;">match_mask</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">neat</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">ms</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">me</span><span style="color: #0000FF;">)</span>
if mask[i]!='?' then
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">ms</span> <span style="color: #008080;">to</span> <span style="color: #000000;">me</span> <span style="color: #008080;">do</span>
if mask[i]!=neat[i] then return 0 end if
<span style="color: #008080;">if</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'?'</span> <span style="color: #008080;">then</span>
end if
<span style="color: #008080;">if</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
return 1
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">1</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function innr(string mask, sequence blocks, integer mi=1, string res="", string neat=mask)
if length(blocks)=0 then
<span style="color: #008080;">function</span> <span style="color: #000000;">innr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">mi</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">=</span><span style="color: #008000;">""</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">string</span> <span style="color: #000000;">neat</span><span style="color: #0000FF;">=</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">)</span>
for i=mi to length(neat) do
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
neat[i] = ' '
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">mi</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">' '</span>
if match_mask(neat,mask,mi,length(mask)) then
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
if length(res)=0 then
<span style="color: #008080;">if</span> <span style="color: #000000;">match_mask</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mi</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">))</span> <span style="color: #008080;">then</span>
res = neat
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
else
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">neat</span>
for i=1 to length(neat) do
<span if neat[i]!style=res[i]"color: then#008080;">else</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
res[i] = '?'
<span style="color: #008080;">if</span> <span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
end if
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">'?'</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
else
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
integer b = blocks[1]
<span style="color: #008080;">else</span>
blocks = blocks[2..$]
<span style="color: #004080;">integer</span> <span style="color: #000000;">b</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
integer l = (sum(blocks)+length(blocks)-1),
<span style="color: #000000;">blocks</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
e = length(neat)-l-b
<span style="color: #004080;">integer</span> <span style="color: #000000;">l</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #7060A8;">sum</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)+</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span>
for i=mi to e do
<span style="color: #000000;">e</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">l</span><span style="color: #0000FF;">-</span><span style="color: #000000;">b</span>
for j=i to i+b-1 do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">mi</span> <span style="color: #008080;">to</span> <span style="color: #000000;">e</span> <span style="color: #008080;">do</span>
neat[j] = '#'
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">i</span> <span style="color: #008080;">to</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">'#'</span>
if i+b<=length(neat) then
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
neat[i+b] = ' '
<span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;"><=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
end if
<span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">' '</span>
if match_mask(neat,mask,mi,min(i+b,length(mask))) then
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
res = innr(mask,blocks,i+b+1,res,neat)
<span style="color: #008080;">if</span> <span style="color: #000000;">match_mask</span><span style="color: #0000FF;">(</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mi</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">min</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">)))</span> <span style="color: #008080;">then</span>
end if
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">innr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">neat</span><span style="color: #0000FF;">)</span>
neat[i] = ' '
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end for
<span style="color: #000000;">neat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">' '</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function inner(string mask, sequence blocks)
string res = innr(mask,blocks)
<span style="color: #008080;">function</span> <span style="color: #000000;">inner</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">blocks</span><span style="color: #0000FF;">)</span>
return iff(length(res)?res:mask)
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">innr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">,</span><span style="color: #000000;">blocks</span><span style="color: #0000FF;">)</span>
end function
<span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">res</span><span style="color: #0000FF;">:</span><span style="color: #000000;">mask</span><span style="color: #0000FF;">)</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
global function vmask(sequence source, integer column)
string res = repeat(' ',length(source))
<span style="color: #008080;">global</span> <span style="color: #008080;">function</span> <span style="color: #000000;">vmask</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">source</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">column</span><span style="color: #0000FF;">)</span>
for i=1 to length(source) do
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">source</span><span style="color: #0000FF;">))</span>
res[i] = source[i][column]
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">source</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">source</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">column</span><span style="color: #0000FF;">]</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function logic()
integer wasunsolved = unsolved
<span style="color: #008080;">function</span> <span style="color: #000000;">logic</span><span style="color: #0000FF;">()</span>
for i=1 to length(x) do
<span style="color: #004080;">integer</span> <span style="color: #000000;">wasunsolved</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">unsolved</span>
grid[i] = inner(grid[i],x[i])
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inner</span><span style="color: #0000FF;">(</span><span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">x</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
for j=1 to length(y) do
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
string tmp = inner(vmask(grid,j),y[j])
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
for i=1 to length(tmp) do
<span style="color: #004080;">string</span> <span style="color: #000000;">tmp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">inner</span><span style="color: #0000FF;">(</span><span style="color: #000000;">vmask</span><span style="color: #0000FF;">(</span><span style="color: #000000;">grid</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">),</span><span style="color: #000000;">y</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
grid[i][j] = tmp[i]
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tmp</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">grid</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tmp</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
unsolved = count_grid()
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return wasunsolved!=unsolved
<span style="color: #000000;">unsolved</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">count_grid</span><span style="color: #0000FF;">()</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">wasunsolved</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">unsolved</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
sequence tests=split("""
C BA CB BB F AE F A B
<span style="color: #004080;">sequence</span> <span style="color: #000000;">tests</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"""
AB CA AE GA E C D C
C BA CB BB F AE F A B
 
AB CA AE GA E C D C
F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC
 
D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA
CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC
 
BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF AAAAD BDG CEF CBDB BBB FC
E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM""",'\n')
E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G
--Alternatively:
E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"""</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'\n'</span><span style="color: #0000FF;">)</span>
--integer fn = open("nonogram_problems.txt","r")
<span style="color: #000080;font-style:italic;">--Alternatively:
--tests = get_text(fn,GT_LF_STRIPPED)
--integer fn = open("nonogram_problems.txt","r")
--close(fn)
--tests = get_text(fn,GT_LF_STRIPPED)
 
--close(fn)</span>
function unpack(string s)
sequence res = split(s)
<span style="color: #008080;">function</span> <span style="color: #000000;">unpack</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
for i=1 to length(res) do
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">split</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
string ri = res[i]
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
sequence r = {}
<span style="color: #004080;">string</span> <span style="color: #000000;">ri</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
for j=1 to length(ri) do
<span style="color: #004080;">sequence</span> <span style="color: #000000;">r</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
r &= ri[j]-'A'+1
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ri</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #000000;">r</span> <span style="color: #0000FF;">&=</span> <span style="color: #000000;">ri</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]-</span><span style="color: #008000;">'A'</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span>
res[i] = r
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">r</span>
return res
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
for i=1 to length(tests) by 3 do
x = unpack(tests[i])
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">by</span> <span style="color: #000000;">3</span> <span style="color: #008080;">do</span>
y = unpack(tests[i+1])
<span style="color: #000000;">x</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">unpack</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
grid = repeat(repeat('?',length(y)),length(x))
<span style="color: #000000;">y</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">unpack</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
unsolved = length(x)*length(y)
<span style="color: #000000;">grid</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'?'</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)),</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">))</span>
 
<span style="color: #000000;">unsolved</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">x</span><span style="color: #0000FF;">)*</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">y</span><span style="color: #0000FF;">)</span>
while unsolved do
if not logic() then
<span style="color: #008080;">while</span> <span style="color: #000000;">unsolved</span> <span style="color: #008080;">do</span>
?"partial"
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">logic</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">then</span>
exit
<span style="color: #0000FF;">?</span><span style="color: #008000;">"partial"</span>
end if
<span style="color: #008080;">exit</span>
end while
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
puts(1,join(grid,"\n")&"\n")
end for</lang>
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">grid</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)&</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre style="float:left">
Line 2,694 ⟶ 3,454:
########
#######
</pre>
 
=={{header|Picat}}==
<syntaxhighlight lang="picat">import util, sat.
 
main =>
Hr = "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
Hc = "E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM",
Lr = [token_to_hints(Token) : Token in split(Hr)],
Lc = [token_to_hints(Token) : Token in split(Hc)],
MaxR = len(Lr),
MaxC = len(Lc),
foreach (Hints in Lr)
constrain_starts(Hints,MaxC)
end,
foreach (Hints in Lc)
constrain_starts(Hints,MaxR)
end,
M = new_array(MaxR,MaxC),
M :: 0..1,
foreach ({R,Hints} in zip(1..MaxR, Lr))
sum([M[R,C] : C in 1..MaxC]) #= sum([Num : (Num,_) in Hints])
end,
foreach ({R,Hints} in zip(1..MaxR, Lr), (Num,Start) in Hints, C in 1..MaxC-Num+1)
Start #= C #=> sum([M[R,C+I] : I in 0..Num-1]) #= Num
end,
%
foreach ({C,Hints} in zip(1..MaxC, Lc))
sum([M[R,C] : R in 1..MaxR]) #= sum([Num : (Num,_) in Hints])
end,
foreach ({C,Hints} in zip(1..MaxC, Lc), (Num,Start) in Hints, R in 1..MaxR-Num+1)
Start #= R #=> sum([M[R+I,C] : I in 0..Num-1]) #= Num
end,
solve((Lr,Lc,M)),
foreach (R in 1..MaxR)
foreach (C in 1..MaxC)
printf("%2c", cond(M[R,C] == 1, '#', '.'))
end,
nl
end.
 
% convert "BCB" to [(2,_),(3,_),(2,_)]
% a hint is a pair (Num,Start), where Num is the length of the 1 segment and Start is the starting row number or column number
token_to_hints([]) = [].
token_to_hints([C|Cs]) = [(ord(C)-ord('A')+1, _)|token_to_hints(Cs)].
 
% there must be a gap between two neighboring segments
constrain_starts([(Num,Start)],Max) =>
Start :: 1..Max,
Start+Num-1 #<= Max.
constrain_starts([(Num1,Start1),(Num2,Start2)|L],Max) =>
Start1 :: 1..Max,
Start1+Num1 #< Start2,
constrain_starts([(Num2,Start2)|L],Max).
</syntaxhighlight>
{{out}}
<pre>
. . . . . . . . . . . . . . . . . . . . # # # # #
. . # # . . . . . . . . . . . . . . # # # . . # #
. # # . . . . . . . . . . . . . . # # # # # . . #
# # . . . . . . . . . . . . . # # # # # # # # . .
# # . . . . # # # # # . # # # # # # # # # # # . .
# . # . . # # . . . . # . . . . # # # # # # . . .
# . . # # . . . . . # . . . . . . . # # # . . . .
# # . . . . . . . . # . . . . . . . . . . . . . #
. # # . . . . . # # # # # # . . . . . . . . . # #
. . # # # # # # # # # # # # # # # . . . . # # # #
. . . . . # # # # # # # # # # . . # # # # # # # #
. . . . # # . # . # # # # . # # # . . # # # # # #
. . . . . . . . # # # # # # # # # # # # # # # # #
. . . . . . . . # # # # # # # # # # # # # # # # #
. . . . . . . # # # # # # # # # # # # # # # # # #
. . . . . . . # . . . # # # # # # # # # # # # # #
. . . . . . . # . # . # # # # # # # # # # # # # #
. . . . . . . . # # # # # . . . # # # # # # # # #
. . . . . . . . . . . . . . . . . # # # # # # # #
. . . . . . . . . . . . . . . . . . # # # # # # #
</pre>
 
Line 2,702 ⟶ 3,539:
 
Module solve-nonogram.pl
<syntaxhighlight lang="prolog">/*
<lang Prolog>/*
* Nonogram/paint-by-numbers solver in SWI-Prolog. Uses CLP(FD),
* in particular the automaton/3 (finite-state/RE) constraint.
Line 2,768 ⟶ 3,605:
nono(Rows, Cols, Grid),
label(Vars),
print(Grid).</langsyntaxhighlight>
File nonogram.pl, used to read data in a file.
<langsyntaxhighlight Prologlang="prolog">nonogram :-
open('C:/Users/Utilisateur/Documents/Prolog/Rosetta/nonogram/nonogram.txt',
read, In, []),
Line 2,793 ⟶ 3,630:
compute_values([X | T], Current, Tmp, R) :-
V is X - 64,
compute_values(T, [V | Current], Tmp, R).</langsyntaxhighlight>
 
=={{header|Python}}==
Line 2,799 ⟶ 3,636:
 
=== Python 2 ===
<langsyntaxhighlight lang="python">from itertools import izip
 
def gen_row(w, s):
Line 2,917 ⟶ 3,754:
solve("B A A\nA A A")
 
main()</langsyntaxhighlight>
{{out}}
<pre>
Line 2,940 ⟶ 3,777:
=== Python 3 ===
Above code altered to work with Python 3:
<langsyntaxhighlight lang="python">from functools import reduce
 
def gen_row(w, s):
Line 3,044 ⟶ 3,881:
print("Vertical runs:", s[1])
deduce(s[0], s[1])
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
<div><small>''<nowiki>[</nowiki>See [[Example:Nonogram solver/Racket]] for editing of this section<nowiki>]</nowiki>''</small></div>
{{Example:Nonogram solver/Racket}}
 
=={{header|Raku}}==
===Translation of Go===
{{trans|Go}}
<syntaxhighlight lang="raku" line># 20220401 Raku programming solution
 
sub reduce(\a, \b) {
my \countRemoved = $ = 0;
for ^+a -> \i {
my \commonOn = @ = True xx b.elems;
my \commonOff = @ = False xx b.elems;
 
a[i].map: -> \candidate { commonOn <<?&=>> candidate ;
commonOff <<?|=>> candidate }
# remove from b[j] all candidates that don't share the forced values
for ^+b -> \j {
my (\fi,\fj) = i, j;
for ((+b[j])^...0) -> \k {
my \cnd = b[j][k];
if (commonOn[fj] ?& !cnd[fi]) ?| (!commonOff[fj] ?& cnd[fi]) {
b[j][k..*-2] = b[j][k+1..*-1];
b[j].pop;
countRemoved++
}
}
return -1 if b[j].elems == 0
}
}
return countRemoved
}
 
sub genSequence(\ones, \numZeros) {
if ( my \le = ones.elems ) == 0 { return [~] '0' xx numZeros }
my @result;
loop ( my $x = 1; $x < ( numZeros -le+2); $x++ ) {
my @skipOne = ones[1..*];
for genSequence(@skipOne, numZeros -$x) -> \tail {
@result.push: ( '0' x $x )~ones[0]~tail
}
}
return @result
}
 
# If all the candidates for a row have a value in common for a certain cell,
# then it's the only possible outcome, and all the candidates from the
# corresponding column need to have that value for that cell too. The ones
# that don't, are removed. The same for all columns. It goes back and forth,
# until no more candidates can be removed or a list is empty (failure).
 
sub reduceMutual(\cols, \rows) {
return -1 if ( my \countRemoved1 = reduce(cols, rows) ) == -1 ;
return -1 if ( my \countRemoved2 = reduce(rows, cols) ) == -1 ;
return countRemoved1 + countRemoved2
}
 
# collect all possible solutions for the given clues
sub getCandidates(@data, \len) {
return gather for @data -> \s {
my \sumBytes = [+] (my @a = s.ords)>>.&{ $_ - 'A'.ord + 1 }
my @prep = @a.values.map: { [~] '1' xx ($_ - 'A'.ord + 1) }
take ( gather for genSequence(@prep, len -sumBytes+1) -> \r {
my \bits = r.substr(1..*).ords;
take ( bits.values.map: *.chr == '1' ).Array
} ).Array
}
}
 
sub newPuzzle (@data) {
 
my (@rowData,@colData) := @data.map: *.split: ' ' ;
 
my \rows = getCandidates(@rowData, @colData.elems);
my \cols = getCandidates(@colData, @rowData.elems);
 
loop {
my \numChanged = reduceMutual(cols, rows);
given (numChanged) { when -1 { say "No solution" andthen return }
when 0 { last } }
}
 
for rows -> \row {
for ^+cols -> \k { print row[0][k] ?? '# ' !! '. ' }
print "\n"
}
print "\n"
}
 
newPuzzle $_ for (
( "C BA CB BB F AE F A B", "AB CA AE GA E C D C" ),
 
( "F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
"D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA" ),
 
( "CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH "
~"BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
"BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF "
~"AAAAD BDG CEF CBDB BBB FC" ),
 
( "E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
"E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ "
~"ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM" ),
);</syntaxhighlight>
 
===Translation of Perl===
{{trans|Perl}}
<syntaxhighlight lang="raku" line>for './nonogram_problems.txt'.IO.lines.rotor(3, :partial) {
 
my (@rpats,@cpats) := @_[0,1]>>.&makepatterns;
my @rows = ( '.' x +@cpats ) xx +@rpats ;
 
loop (my $prev = ''; $prev ne ~@rows; ) {
$prev = ~@rows;
try(@rows, @rpats);
my @cols = (^+@cpats).map: { [~] @rows.map: { ~ s/.// } }
try(@cols, @cpats);
@rows = (^+@rpats).map: { [~] @cols.map: { ~ s/.// } }
}
say();
@rows ~~ /\./ ?? say "Failed" !! say TR/01/.@/ for @rows
}
 
sub try(@lines, @patterns) {
for ^+@lines -> $i {
my $pos = 0;
while ( @lines[$i] ~~ m:g/\./ and $pos < @lines[$i].chars ) {
for 0, 1 -> $try {
with @lines[$i] { S:pos($pos)/\./$try/ ~~ /<{@patterns[$i]}>/ or
s:pos($pos)/./{ 1 - $try }/ }
}
$pos++;
}
}
}
 
sub makepatterns($input) {
$input ==> split( ' ' )
==> map( *.comb )
==> map( *>>.&{ .ord - 64 } )
==> map( '<[1.]>**' <<~<< * )
==> map( *.join: '<[0.]>+' )
==> map( '^<[0.]>*' ~ * ~ '<[0.]>*$' )
}</syntaxhighlight>
 
=={{header|REXX}}==
Nonogram Solver/Rexx:
<langsyntaxhighlight lang="rexx">/*REXX*/
Parse Arg fn
Parse Var fn ou'.'
Line 3,367 ⟶ 4,348:
If ii > mx Then mx = ii
End
Return len</langsyntaxhighlight>
{{out}}
<pre>
Line 3,578 ⟶ 4,559:
24 @ . . . . . @ . . @ @ . . . . . . @ . @ . @ @ . .
25 @ @ @ @ @ @ @ . @ @ . . . @ . @ @ . . . @ @ @ @ @
</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-pattern}}
{{libheader|Wren-math}}
<syntaxhighlight lang="wren">import "./pattern" for Pattern
import "./math" for Nums, Boolean
 
var p = Pattern.new("/s")
 
var genSequence // recursive
genSequence = Fn.new { |ones, numZeros|
if (ones.isEmpty) return ["0" * numZeros]
var result = []
var x = 1
while (x < numZeros - ones.count + 2) {
var skipOne = ones.skip(1).toList
for (tail in genSequence.call(skipOne, numZeros - x)) {
result.add("0" * x + ones[0] + tail)
}
x = x + 1
}
return result
}
 
/* If all the candidates for a row have a value in common for a certain cell,
then it's the only possible outcome, and all the candidates from the
corresponding column need to have that value for that cell too. The ones
that don't, are removed. The same for all columns. It goes back and forth,
until no more candidates can be removed or a list is empty (failure).
*/
var reduce = Fn.new { |a, b|
var countRemoved = 0
for (i in 0...a.count) {
var commonOn = List.filled(b.count, true)
var commonOff = List.filled(b.count, false)
 
// determine which values all candidates of a[i] have in common
for (candidate in a[i]) {
for (i in 0...b.count) {
commonOn[i] = Boolean.and(commonOn[i], candidate[i])
commonOff[i] = Boolean.or(commonOff[i], candidate[i])
}
}
 
// remove from b[j] all candidates that don't share the forced values
for (j in 0...b.count) {
var fi = i
var fj = j
var removals = false
b[j].each { |cnd|
if ((commonOn[fj] && !cnd[fi]) || (!commonOff[fj] && cnd[fi])) {
b[j].remove(cnd)
removals = true
}
}
if (removals) countRemoved = countRemoved + 1
if (b[j].isEmpty) return -1
}
}
return countRemoved
}
 
var reduceMutual = Fn.new { |cols, rows|
var countRemoved1 = reduce.call(cols, rows)
if (countRemoved1 == -1) return -1
var countRemoved2 = reduce.call(rows, cols)
if (countRemoved2 == -1) return -1
return countRemoved1 + countRemoved2
}
 
// collect all possible solutions for the given clues
var getCandidates = Fn.new { |data, len|
var result = []
for (s in data) {
var lst = []
var a = s.bytes
var sumChars = Nums.sum(a.map { |b| b - 64 })
var prep = a.map { |b| "1" * (b - 64) }.toList
 
for (r in genSequence.call(prep, len - sumChars + 1)) {
var bits = r[1..-1].bytes
var len = bits.count
if (len % 64 != 0) len = (len/64).ceil * 64
var bitset = List.filled(len, false)
for (i in 0...bits.count.min(bitset.count)) bitset[i] = bits[i] == 49
lst.add(bitset)
}
result.add(lst)
}
return result
}
 
var newPuzzle = Fn.new { |data|
var rowData = p.splitAll(data[0])
var colData = p.splitAll(data[1])
var rows = getCandidates.call(rowData, colData.count)
var cols = getCandidates.call(colData, rowData.count)
 
while (true) {
var numChanged = reduceMutual.call(cols, rows)
if (numChanged == -1) {
System.print("No solution")
return
}
if (numChanged <= 0) break
}
 
for (row in rows) {
for (i in 0...cols.count) {
System.write(row[0][i] ? "# " : ". ")
}
System.print()
}
System.print()
}
 
var p1 = ["C BA CB BB F AE F A B", "AB CA AE GA E C D C"]
 
var p2 = [
"F CAC ACAC CN AAA AABB EBB EAA ECCC HCCC",
"D D AE CD AE A DA BBB CC AAB BAA AAB DA AAB AAA BAB AAA CD BBA DA"
]
 
var p3 = [
"CA BDA ACC BD CCAC CBBAC BBBBB BAABAA ABAD AABB BBH " +
"BBBD ABBAAA CCEA AACAAB BCACC ACBH DCH ADBE ADBB DBE ECE DAA DB CC",
"BC CAC CBAB BDD CDBDE BEBDF ADCDFA DCCFB DBCFC ABDBA BBF AAF BADB DBF " +
"AAAAD BDG CEF CBDB BBB FC"
]
 
var p4 = [
"E BCB BEA BH BEK AABAF ABAC BAA BFB OD JH BADCF Q Q R AN AAN EI H G",
"E CB BAB AAA AAA AC BB ACC ACCA AGB AIA AJ AJ " +
"ACE AH BAF CAG DAG FAH FJ GJ ADK ABK BL CM"
]
 
for (puzzleData in [p1, p2, p3, p4]) newPuzzle.call(puzzleData)</syntaxhighlight>
 
{{out}}
<pre>
. # # # . . . .
# # . # . . . .
. # # # . . # #
. . # # . . # #
. . # # # # # #
# . # # # # # .
# # # # # # . .
. . . . # . . .
. . . # # . . .
 
. . . . . . . . . . # # # # # # . . . .
. . . . . . . . # # # . # . . # # # . .
. . . # . . # # # . . . # . . . . # # #
. . # # # . # # # # # # # # # # # # # #
. . . # . . # . . . . . . . . . . . . #
. . # . # . # # . . . . . . . . . . # #
# # # # # . . # # . . . . . . . . # # .
# # # # # . . . # . . . . . . . . # . .
# # # # # . . # # # . # # # . # # # . .
# # # # # # # # . # # # . # # # . # # #
 
. . . . # # # . # . . . . . . . . . . .
. . . . # # . # # # # . # . . . . . . .
. . . . # . # # # . # # # . . . . . . .
. . # # . # # # # . . . . . . . . . . .
. # # # . # # # . # . . . . # # # . . .
# # # . . # # . # # . . . # . # # # . .
# # . . # # . # # . . . . # # . # # . .
. . . . # # . # . # . . # # . # . # . .
. . . . # . # # . # . . . # # # # . . .
. . . . # . # . # # . . . . . # # . . .
. . . . . # # . # # . . # # # # # # # #
. . . . # # . # # . . . # # . . # # # #
. . . . # . # # . # # . # . . . # . . #
# # # . . # # # . # # # # # . . . . . #
# . # . # # # . # . . . . # . . . . # #
# # . . # # # . # . . . . # # # . # # #
. # . # # # . # # . # # # # # # # # . .
. # # # # . # # # . # # # # # # # # . .
. . . # . # # # # . # # . # # # # # . .
. . . # . # # # # . # # . . . # # . . .
. . . . # # # # . . # # . . . # # # # #
. . . # # # # # . # # # . . . # # # # #
. . . # # # # . # . . . . . . . . . . #
. . # # # # . # # . . . . . . . . . . .
. . # # # . # # # . . . . . . . . . . .
 
. . . . . . . . . . . . . . . . . . . . # # # # #
. . # # . . . . . . . . . . . . . . # # # . . # #
. # # . . . . . . . . . . . . . . # # # # # . . #
# # . . . . . . . . . . . . . # # # # # # # # . .
# # . . . . # # # # # . # # # # # # # # # # # . .
# . # . . # # . . . . # . . . . # # # # # # . . .
# . . # # . . . . . # . . . . . . . # # # . . . .
# # . . . . . . . . # . . . . . . . . . . . . . #
. # # . . . . . # # # # # # . . . . . . . . . # #
. . # # # # # # # # # # # # # # # . . . . # # # #
. . . . . # # # # # # # # # # . . # # # # # # # #
. . . . # # . # . # # # # . # # # . . # # # # # #
. . . . . . . . # # # # # # # # # # # # # # # # #
. . . . . . . . # # # # # # # # # # # # # # # # #
. . . . . . . # # # # # # # # # # # # # # # # # #
. . . . . . . # . . . # # # # # # # # # # # # # #
. . . . . . . # . # . # # # # # # # # # # # # # #
. . . . . . . . # # # # # . . . # # # # # # # # #
. . . . . . . . . . . . . . . . . # # # # # # # #
. . . . . . . . . . . . . . . . . . # # # # # # #
</pre>
9,482

edits