Nonograms / Paint by Numbers / Griddlers

Nonograms / Paint by Numbers / Griddlers are "picture logic puzzles in which cells in a grid have to be colored or left blank according to numbers given at the side of the grid to reveal a hidden picture. In this puzzle type, the numbers measure how many unbroken lines of filled-in squares there are in any given row or column. For example, a clue of "4 8 3" would mean there are sets of four, eight, and three filled squares, in that order, with at least one blank square between successive groups." [1]

Simon Tatham's Portable Puzzle Collection has an excellent implementation of these puzzles, under the name "Pattern". They run under Windows, OS X, Linux, and as a Java applet in a browser.

As usual, the powerful answer set solver clingo makes short work of these puzzles. The source files are:

• nonogram.lp (clingo input file describing the nonogram puzzle type)
  

  % constraint(Type,N,I,Len) - the Ith group in row/col N must be Len blocks long
  % row(Y). Y is a valid row number.
  % col(X). X is a valid column number.
  % color(X,Y). From a column constraint, we infer that (X,Y) is colored in
  % rowcolor(X,Y). From a row constraint, we infer that (X,Y) is colored in
  % rowrun(Y,I,X). The Ith run in row Y starts at cell (X,Y).
  % colrun(X,I,Y). The Ith run in col X starts at cell (X,Y).
  
  % This following lines simplifies data entry directly into clingo by allowing
  % constraints to be entered as a group.  This could easily be elminated with
  % some pre-processing in, say, Perl.
  %
  % constraints(col/row,I,A,B,C,...) - The lengths of blocks of filled-in
  %    cells in column/row I are A,B,C,...
  constraint(Type,N,1,A) :- constraints(Type,N,A).
  constraint(Type,N,1,A) :- constraints(Type,N,A,B).
  constraint(Type,N,1,A) :- constraints(Type,N,A,B,C).
  constraint(Type,N,1,A) :- constraints(Type,N,A,B,C,D).
  constraint(Type,N,1,A) :- constraints(Type,N,A,B,C,D,E).
  constraint(Type,N,1,A) :- constraints(Type,N,A,B,C,D,E,F).
  constraint(Type,N,1,A) :- constraints(Type,N,A,B,C,D,E,F,G).
  constraint(Type,N,2,B) :- constraints(Type,N,A,B).
  constraint(Type,N,2,B) :- constraints(Type,N,A,B,C).
  constraint(Type,N,2,B) :- constraints(Type,N,A,B,C,D).
  constraint(Type,N,2,B) :- constraints(Type,N,A,B,C,D,E).
  constraint(Type,N,2,B) :- constraints(Type,N,A,B,C,D,E,F).
  constraint(Type,N,2,B) :- constraints(Type,N,A,B,C,D,E,F,G).
  constraint(Type,N,3,C) :- constraints(Type,N,A,B,C).
  constraint(Type,N,3,C) :- constraints(Type,N,A,B,C,D).
  constraint(Type,N,3,C) :- constraints(Type,N,A,B,C,D,E).
  constraint(Type,N,3,C) :- constraints(Type,N,A,B,C,D,E,F).
  constraint(Type,N,3,C) :- constraints(Type,N,A,B,C,D,E,F,G).
  constraint(Type,N,4,D) :- constraints(Type,N,A,B,C,D).
  constraint(Type,N,4,D) :- constraints(Type,N,A,B,C,D,E).
  constraint(Type,N,4,D) :- constraints(Type,N,A,B,C,D,E,F).
  constraint(Type,N,4,D) :- constraints(Type,N,A,B,C,D,E,F,G).
  constraint(Type,N,5,E) :- constraints(Type,N,A,B,C,D,E).
  constraint(Type,N,5,E) :- constraints(Type,N,A,B,C,D,E,F).
  constraint(Type,N,5,E) :- constraints(Type,N,A,B,C,D,E,F,G).
  constraint(Type,N,6,F) :- constraints(Type,N,A,B,C,D,E,F).
  constraint(Type,N,6,F) :- constraints(Type,N,A,B,C,D,E,F,G).
  constraint(Type,N,7,G) :- constraints(Type,N,A,B,C,D,E,F,G).
  
  
  row(1..ymax).
  col(1..xmax).
  ymax(ymax).
  xmax(xmax).
  % For each constraint, choose a starting cell for the run.
  1 { rowrun(Y,I,X) : col(X) : col(X+Len-1) } 1 :- constraint(row,Y,I,Len).
  1 { colrun(X,I,Y) : row(Y) : row(Y+Len-1) } 1 :- constraint(col,X,I,Len).
  
  % Must leave at least one space between two adjacent run.
  :- rowrun(N,I,Start1), rowrun(N,J,Start2), constraint(row,N,I,Len), I < J, Start2 < Start1 + Len + 1.
  :- colrun(N,I,Start1), colrun(N,J,Start2), constraint(col,N,I,Len), I < J, Start2 < Start1 + Len + 1.
  
  % Infer the color of the cells in each run
  color(X,Start..Start+Len-1) :- colrun(X,I,Start), constraint(col,X,I,Len), row(X).
  rowcolor(Start..Start+Len-1,Y) :- rowrun(Y,I,Start), constraint(row,Y,I,Len), col(Y).
  
  % The inferred color from the row runs must be the same as those from the column runs.
  :- color(X,Y), not rowcolor(X,Y), row(X), col(Y).
  :- not color(X,Y), rowcolor(X,Y), row(X), col(Y).
  
  #hide.
  #show color/2.
  #show xmax/1.
  #show ymax/1.
  #show constraint/4.
  

• 10x10.lp (lists the constraints in the above 10x10 puzzle)
  

  #const ymax=10. #const xmax=10. #const maxruns=4.
  % constraints(col/row,I,A,B,C,...) - The lengths of blocks of filled-in
  % cells in column/row I are A,B,C,...
  
  constraints(col,1,1,2,3).
  constraints(col,2,1,2).
  constraints(col,3,2,5).
  constraints(col,4,4).
  constraints(col,5,6).
  constraints(col,6,6).
  constraints(col,7,1,3).
  constraints(col,8,8).
  constraints(col,9,1).
  constraints(col,10,2,3).
  constraints(row,1,3).
  constraints(row,2,1).
  constraints(row,3,3).
  constraints(row,4,1,1).
  constraints(row,5,1,1,2,1).
  constraints(row,6,1,6,1).
  constraints(row,7,4,1,1).
  constraints(row,8,1,6,1).
  constraints(row,9,8).
  constraints(row,10,2,4).
  

• display (Perl program to display the solution in human-readable form and check its validity against the original constraints)
  

  #!/usr/bin/perl
  
  use strict;
  use warnings;
  while (<>) {
    if (/color/) {
      my $xmax = 0;
      my $ymax = 0;
      my @color;
      my %constraint;
      while(/constraint[(](row|col),(\d+),(\d+),(\d+)/g) {
        $constraint{$1}[$2][$3-1] = $4;
      }
  
      while(/color[(](\d+),(\d+)/g) {
        $color[$1][$2] = 'b';
      }
      while(/ymax[(](\d+)/g) {
        $ymax = $1;
      }
      while(/xmax[(](\d+)/g) {
        $xmax = $1;
      }
      my $check = checksol(\@color, \%constraint, $xmax, $ymax);
      print if $check ne "OK"; # when debugging, show the raw data
      foreach my $y (1..$ymax) {
        foreach my $x (1..$xmax) {
          print $color[$x][$y] && $color[$x][$y] eq 'b' ? 'X' : '.', " ";
          print "  " if $x % 5 == 0 && $x > 0 && $x < $xmax;
        }
        print "\n";
        print "\n" if $y % 5 == 0 && $y > 0 && $y < $ymax;
      }
      print "$check\n";
    }
    else {
      print;
    }
  }
  
  
  
  sub checksol {
    my ($color, $constraint, $xmax, $ymax) = @_;
  
    foreach my $y (1..$ymax) {
      next unless $constraint->{'row'}[$y];
      my $row;
      foreach my $x (1..$xmax) {
        $row .= $color->[$x][$y] || " ";
      }
      my @counts = map length, $row =~ /(b+)/g;
      return "ERROR: row $y: @counts should be @{ $constraint->{'row'}[$y] }"
        if "@counts" ne "@{ $constraint->{'row'}[$y] }";
    }
    foreach my $x (1..$xmax) {
      next unless $constraint->{'col'}[$x];
      my $col;
      foreach my $y (1..$ymax) {
        $col .= $color->[$x][$y] || " ";
      }
      my @counts = map length, $col =~ /(b+)/g;
      return "ERROR: column $x: @counts should be @{ $constraint->{'col'}[$x] }"
        if "@counts" ne "@{ $constraint->{'col'}[$x] }";
    }
    return "OK";
  }
  

In this model of the puzzle, the objective is to find the cell in which each unbroken line of filled-in squares ("run") starts, subject to the following constraints:

• Two runs in the same row or column must be separated by at least one cell of whitespace
  
• From the starting cells and lengths of the runs in a row or column, we can infer which cells in that row or column must be filled in. The set of cells filled in by the row runs must be the same as the set of cells filled in by the column runs.
  

Here's the output of solving the above 10x10 puzzle:

$ clingo nonogram.lp 10x10.lp | perl display
Answer: 1
X X X . .   . . . . . 
. . X . .   . . . . . 
. . . . .   . . X X X 
. . . . .   . . X . X 
X . X . X   X . X . . 

X . X X X   X X X . X 
. . X X X   X . X . X 
X . X X X   X X X . X 
X X X X X   X X X . . 
X X . . X   X X X . . 
OK
SATISFIABLE

Models      : 1+    
Time        : 0.020
  Prepare   : 0.010
  Prepro.   : 0.010
  Solving   : 0.000

Here's the output from solving a 30x30 puzzle, along with an image of the initial puzzle state and the corresponding Simon Tatham's Portable Puzzle Collection save file.

[1] Wikipedia, Nonogram, (as of Apr. 14, 2010, 08:56 GMT).