Prolog nonogram solver

gistfile1.prolog

% Succeeds if `Lines` represents the nonogram specified by `ColumnSpecs` and 
% `LineSpecs`. For example:
%nonogram
%         1
%       2 1 2
%     +------
%   1 | . # .   ColumnSpecs = [[2], [1,1], [2]]
% 1 1 | # . #   LineSpecs   = [[1], [1,1], [3]]
%   3 | # # #   Lines       = [[0,1,0], [1,0,1], [1,1,1]]
nonogram(ColumnSpecs, LineSpecs, Lines) :-
    length(ColumnSpecs, Width),
    nonogram1(Width, LineSpecs, Lines),
    valid_columns(ColumnSpecs, Lines, 1),
    print_nonogram(Lines).

nonogram1(_, [], []).
nonogram1(Width, [LineSpec | LineSpecs], [Line | Lines]) :-
    length(Line, Width),
    fd_domain_bool(Line),
    valid_seq(LineSpec, Line),
    nonogram1(Width, LineSpecs, Lines).

valid_columns([], _, _).
valid_columns([ColumnSpec | ColumnSpecs], Lines, FirstColumn) :-
    valid_column(FirstColumn, ColumnSpec, Lines),
    FirstColumnPlusOne is FirstColumn + 1,
    valid_columns(ColumnSpecs, Lines, FirstColumnPlusOne).
    
valid_column(Index, ColumnSpec, Lines) :-
    extract(Index, Lines, Column),
    valid_seq(ColumnSpec, Column),
    debug(['Possible column', Index, '(', ColumnSpec, '):', Column]).


valid_seq(BlockLengths, [0 | Seq]) :-
    valid_seq(BlockLengths, Seq).
valid_seq([BlockLength | BlockLengths], [1 | SeqRest]) :-
    BlockLength > 0,
    BlockLengthMinusOne is BlockLength - 1,
    valid_seq_rest([BlockLengthMinusOne | BlockLengths], SeqRest).
valid_seq([], Seq) :-
    valid_seq([0], Seq).
valid_seq([0], []).

valid_seq_rest([0], Seq) :-
    valid_seq([0], Seq).
valid_seq_rest([0 | BlockLengths], [0 | SeqRest]) :-
    valid_seq(BlockLengths, SeqRest).
valid_seq_rest([BlockLength | BlockLengths], [1 | SeqRest]) :-
    BlockLength > 0,
    BlockLengthMinusOne is BlockLength - 1,
    valid_seq_rest([BlockLengthMinusOne | BlockLengths], SeqRest).
 
extract(_, [], []).
extract(Index, [List], [Result]) :-
    nth(Index, List, Result),!.
extract(Index, [List | Lists], [Result | Results]) :-
    extract(Index, [List], [Result]),
    extract(Index, Lists, Results).

print_nonogram(N) :-
    nl,write('Found nonogram:'),nl,
    print_nonogram1(N).
    
print_nonogram1([]).
print_nonogram1([Line | Lines]) :-
    print_line(Line),nl,
    print_nonogram1(Lines).
    
print_line([]).
print_line([Head | Tail]) :-
    Head = 1,
    write('# '),
    print_line(Tail).
print_line([Head | Tail]) :-
    Head = 0,
    write('. '),
    print_line(Tail).
    
debug(Terms) :-
    real_time(Time),
    write(Time), write(': '),
    debug1(Terms).

debug1([]) :- nl.
debug1([Term | Terms]) :- 
    write(Term), write(' '), 
    debug1(Terms).
      
% nonogram([[2,1],[2,1],[3],[1],[1]], [[2],[2,1],[1,1],[1],[3]]).
% nonogram([[1,2],[1,1,2],[1,8],[1,1,2],[1,2],[1,1],[1,1],[3,1],[1],[3]], [[1,2,1],[1,1,1,3],[1,2,1],[5],[1],[1,1],[1],[1,1,2],[5],[3]], N).