Nonogram solver

Nonogram solver is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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):

Problem:                 Solution:

. . . . . . . .  3       . # # # . . . .  3
. . . . . . . .  2 1     # # . # . . . .  2 1
. . . . . . . .  3 2     . # # # . . # #  3 2
. . . . . . . .  2 2     . . # # . . # #  2 2
. . . . . . . .  6       . . # # # # # #  6
. . . . . . . .  1 5     # . # # # # # .  1 5
. . . . . . . .  6       # # # # # # . .  6
. . . . . . . .  1       . . . . # . . .  1
. . . . . . . .  2       . . . # # . . .  2
1 3 1 7 5 3 4 3          1 3 1 7 5 3 4 3
2 1 5 1                  2 1 5 1

The problem above could be represented by two lists of lists:

x = [[3], [2,1], [3,2], [2,2], [6], [1,5], [6], [1], [2]]
y = [[1,2], [3,1], [1,5], [7,1], [5], [3], [4], [3]]

A more compact representation of the same problem uses strings, where the letters represent the numbers, A=1, B=2, etc:

x = "C BA CB BB F AE F A B"
y = "AB CA AE GA E C D C"

For this task try to solve the problems read from a "nonogram_problems.txt" file, copied from this:

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

More info:
http://en.wikipedia.org/wiki/Nonogram

This task is the problem n.98 of the "99 Prolog Problems" by Werner Hett (also thanks to Paul Singleton for the idea and the examples):
https://sites.google.com/site/prologsite/prolog-problems

Some Haskell solutions:
http://www.haskell.org/haskellwiki/99_questions/Solutions/98
http://twanvl.nl/blog/haskell/Nonograms

PicoLisp solution:
http://picolisp.com/5000/!wiki?99p98

Bonus Problem: generate nonograms with unique solutions, of desired height and width.

Prolog

Works with SWI-Prolog version 6.5.3
module(clpfd) is written by Markus Triska
Solution written by Lars Buitinck
Module solve-nonogram.pl <lang Prolog>/*

• Nonogram/paint-by-numbers solver in SWI-Prolog. Uses CLP(FD),
• in particular the automaton/3 (finite-state/RE) constraint.
• Copyright (c) 2011 Lars Buitinck.
• Do with this code as you like, but don't remove the copyright notice.
• /

- use_module(library(clpfd)).

nono(RowSpec, ColSpec, Grid) :- rows(RowSpec, Grid), transpose(Grid, GridT), rows(ColSpec, GridT).

rows([], []). rows([C|Cs], [R|Rs]) :- row(C, R), rows(Cs, Rs).

row(Ks, Row) :- sum(Ks, #=, Ones), sum(Row, #=, Ones), arcs(Ks, Arcs, start, Final), append(Row, [0], RowZ), automaton(RowZ, [source(start), sink(Final)], [arc(start,0,start) | Arcs]).

% Make list of transition arcs for finite-state constraint. arcs([], [], Final, Final). arcs([K|Ks], Arcs, CurState, Final) :- gensym(state, NextState), ( K == 0 -> Arcs = [arc(CurState,0,CurState), arc(CurState,0,NextState) | Rest], arcs(Ks, Rest, NextState, Final) ; Arcs = [arc(CurState,1,NextState) | Rest], K1 #= K-1, arcs([K1|Ks], Rest, NextState, Final)).

make_grid(Grid, X, Y, Vars) :- length(Grid,X), make_rows(Grid, Y, Vars).

make_rows([], _, []). make_rows([R|Rs], Len, Vars) :- length(R, Len), make_rows(Rs, Len, Vars0), append(R, Vars0, Vars).

print([]). print([R|Rs]) :- print_row(R), print(Rs).

print_row([]) :- nl. print_row([X|R]) :- ( X == 0 -> write(' ') ; write('x')), print_row(R).

nonogram(Rows, Cols) :- length(Rows, X), length(Cols, Y), make_grid(Grid, X, Y, Vars), nono(Rows, Cols, Grid), label(Vars), print(Grid).

</lang> File nonogram.pl, used to read data in a file. <lang Prolog>nonogram :- open('C:/Users/Utilisateur/Documents/Prolog/Rosetta/nonogram/nonogram.txt', read, In, []), repeat, read_line_to_codes(In, Line_1), read_line_to_codes(In, Line_2), compute_values(Line_1, [], [], Lines), compute_values(Line_2, [], [], Columns), nonogram(Lines, Columns) , nl, nl, read_line_to_codes(In, end_of_file), close(In).

compute_values([], Current, Tmp, R) :- reverse(Current, R_Current), reverse([R_Current | Tmp], R).

compute_values([32 | T], Current, Tmp, R) :- !, reverse(Current, R_Current), compute_values(T, [], [R_Current | Tmp], R).

compute_values([X | T], Current, Tmp, R) :- V is X - 64, compute_values(T, [V | Current], Tmp, R). </lang>

Python

First fill cells by deduction, then search through all combinations. It could take up a huge amount of storage, depending on the board size. <lang python># create all patterns of a row or col that match given runs def genrow(w, s):

   def gen_pad(w, n):
       if n: return [[[2]*l] + r
               for l in range(1,w-n+1)
               for r in gen_pad(w-l, n-1) ]
       return [[[2]*w]]

   def interlace(z, o):
       l = [0] * (len(z) + len(o))
       l[0::2] = z
       l[1::2] = o
       return reduce(lambda a,b: a + b, l)

   ones = [[1]*i for i in s]
   return [interlace(x, ones)[1:-1] for x in gen_pad(w - sum(s) + 2, len(s))]

1. fix inevitable value of cells, and propagate

def deduce(hr, vr):

   def allowable(row):
       return reduce(lambda a,b:[x|y for x,y in zip(a,b)], row)

   def fits(a, b):
       return all([x&y for x,y in zip(a, b)])

   # see if any value in a given column is fixed; if so,
   # mark its corresponding row for future fixup
   def fix_col(n):
       del(fixable[-n-1])
       c = [x[n] for x in can_do]
       cols[n] = [x for x in cols[n] if fits(x,c)]
       for i,x in enumerate(allowable(cols[n])):
           v = x & can_do[i][n]
           if v == can_do[i][n]: continue
           fixable[i+1] = True
           can_do[i][n] = v

   # ditto, for rows
   def fix_row(n):
       del(fixable[n+1])
       c = can_do[n]
       rows[n] = [x for x in rows[n] if fits(x,c)]
       for i,x in enumerate(allowable(rows[n])):
           v = x & can_do[n][i]
           if v == can_do[n][i]: continue
           fixable[-i-1] = True
           can_do[n][i] = v

   def show_gram(m):
       # if there's 'x', something is wrong
       # if there's '?', needs more work
       for x in m: print ' '.join(["x#.?"[i] for i in x])
       print '-' * (2*len(vr) - 1)

   w, h = len(vr), len(hr)
   fixable = {}
   rows = [genrow(w, x) for x in hr]
   cols = [genrow(h, x) for x in vr]
   can_do = [allowable(x) for x in rows]

   # initially mark all columns for update
   for i in range(w): fixable[-i-1] = True

   while fixable:
       i = fixable.keys()[0]
       if i < 0: fix_col(-i-1)
       else: fix_row(i-1)

   show_gram(can_do)

   # return if solution is unique
   if all([can_do[i][j] in (1,2) for j in range(w) for i in range(h)]):
       return

   print "Solution not unique, doing exhaustive search:"
   def try_all(n = 0, out = [0] * h):
       if n >= h:
           for j in range(w):
               if [x[j] for x in out] not in cols[j]: return
           show_gram(out)
           return
       for x in rows[n]:
           out[n] = x
           try_all(n + 1)

   try_all()

def solve(p):

   s = [[[ord(c)-ord('A')+1 for c in w] for w in l.split()] for l in p.split('\n')]
   print "Horizontal runs:", s[0]
   print "Vertical runs:", s[1]
   deduce(s[0], s[1])
   print "\n"

1. read from file file

fn = 'nonogram_problems.txt' for p in [x for x in open(fn).read().split('\n\n') if x]:

   solve(p)

print "Extra example not solvable by deduction alone:" solve("B B A A\nB B A A")

print "Extra example where there's no solution:" solve("B A A\nA A A")</lang>

Output:

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]]
. # # # . . . .
# # . # . . . .
. # # # . . # #
. . # # . . # #
. . # # # # # #
# . # # # # # .
# # # # # # . .
. . . . # . . .
. . . # # . . .
---------------
(...etc...)

Racket

See: Example:Nonogram solver/Racket