Download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
%
% ECLiPSe Nonogram Solver
%
% by Joachim Schimpf, IC-Parc, Imperial College, London, January 2001
%
% Problem:
%
% Nonograms are a popular puzzle, which goes by different names in
% different countries.  The player has to shade in squares in a grid so
% that blocks of consecutive shaded squares satisfy constraints given
% for each row and column.  Constraints typically indicate the sequence
% of shaded blocks (e.g. [3,1,2] means that there is a block of 3, then
% a gap of unspecified size, a block of length 1, another gap, and then
% a block of length 2). Data for sample problems is at the end of this file,
%  
% Solution:
%
% This code solves all the problems below, the hardest one so far
% being p200 (25x25):
%
%   ps,n2-n16   by propagation alone
%   p197,p199,p200  with search, takes a while
%
% The main idea here is to have a powerful constraint (line_lookahead/4)
% which solves a single-line subproblem and exports the generalised
% result (using ECLiPSe's propia library).
%
% No particularly clever search strategy is used, just first-fail.
%
 
 
:- lib(ic).
:- lib(propia).
 
 
go(Name, Board) :-
    data(Name, M, N, RowBlocks, ColBlocks),     % get the data
    check_data(M, N, RowBlocks, ColBlocks),
 
    dim(Board, [M,N]),
    (                       % row constraints
        for(I,1,M),
        foreach(Blocks,RowBlocks),
        foreach(Positions,RowPositions),
        param(Board,N)
    do
        matrix_row(Board, I, Line),
        line_setup(N, Line, Blocks, Positions),
        line_lookahead(N, Line, Blocks, Positions)
    ),
    (                       % column constraints
        for(J,1,N),
        foreach(Blocks,ColBlocks),
        foreach(Positions,ColPositions),
        param(Board,M)
    do
        matrix_column(Board, J, Line),
        line_setup(M, Line, Blocks, Positions),
        line_lookahead(M, Line, Blocks, Positions)
    ),
%   pretty_print(Board),
 
    flatten([RowPositions,ColPositions], AllPositions), % search
    search(AllPositions, 0, first_fail, indomain, complete, []),
    pretty_print(Board).
 
 
 
% setup constraints on one line (row or column)
%
% Line is an array of boolean variables
% Blocks is a list of block sizes (integers)
% Positions is a list of variables representing the block positions
% Gaps is a list of variables representing the gap sizes
 
line_setup(NFields, Line, Blocks, Positions) :-
    length(Blocks, NBlocks),
    dim(Line, [NFields]),           % field variables
    Line[1..NFields] :: 0..1,
    length(Positions, NBlocks),     % position variables
    Positions :: 1..NFields,
    NGaps is NBlocks+1,         % gap variables
    length(Gaps, NGaps),
    Gaps = [Gap1|Gaps2N],
    once append(InnerGaps, [GapN], Gaps2N),
    [Gap1,GapN] :: 0..NFields,      % outer gaps can be empty
    InnerGaps :: 1..NFields,        % inner gaps must exist
 
    sum(Line[1..NFields]) #= sum(Blocks),
    (
        foreach(Position,Positions),
        fromto(Blocks, RightBlocks, RightBlocks1, []),
        fromto([], LeftBlocks, [Block|LeftBlocks], _BlocksReverse),
        fromto(Gaps2N, RightGaps, RightGaps1, []),
        fromto([Gap1], LeftGaps, [RightGap|LeftGaps], _GapsReverse),
        param(NFields,Line)
    do
        RightBlocks = [Block|RightBlocks1],
        RightGaps = [RightGap|RightGaps1],
        LeftGaps = [LeftGap|_],
        Position #= 1 + sum(LeftBlocks) + sum(LeftGaps),
        Position #= 1 + NFields - (sum(RightBlocks) + sum(RightGaps)),
        place_block(Line, Position, LeftGap, Block, RightGap)
    ).
 
 
 
% constraint to update the Line-booleans that correspond
% to the block at Position and the adjacent gaps
 
place_block(Line, Position, LeftGap, BlockSize, RightGap) :-
    nonvar(Position),
    get_bounds(LeftGap, MinLeftGap, _),
    ( for(I,Position-MinLeftGap,Position-1), param(Line) do
        arg(I, Line, 0)
    ),
    ( for(I,Position,Position+BlockSize-1), param(Line) do
        arg(I, Line, 1)
    ),
    get_bounds(RightGap, MinRightGap, _),
    ( for(I,Position+BlockSize,Position+BlockSize+MinRightGap-1), param(Line) do
        arg(I, Line, 0)
    ).
place_block(Line, Position, LeftGap, BlockSize, RightGap) :-
    var(Position),
    suspend(place_block(Line, Position, LeftGap, BlockSize, RightGap), 2,
        [Position->inst]).
 
 
 
% Lookahead constraint for one line:
% This uses propia to compute the most general solution
% for the single line subproblem
 
line_lookahead(NFields, Line, Blocks, Positions) :-
    suspend(
        solve_line_problem(NFields, Line, Positions, Blocks),
        7,
        [Line->inst,Positions->ic:min,Positions->ic:max]
    ) infers most.
 
solve_line_problem(NFields, Line, Positions, Blocks) :-
    line_setup(NFields, Line, Blocks, Positions),
    labeling(Positions).
 
 
%----------------------------------------------------------------------
% Auxiliaries
%----------------------------------------------------------------------
 
matrix_row(Mat, I, Row) :-
    Row is Mat[I].
 
matrix_column(Mat, J, Col) :-
    dim(Mat, [M, _N]),
    ColList is Mat[1..M,J],
    Col =.. [[]|ColList].
 
pretty_print(Board) :-
    dim(Board, [M,N]),
    ( for(I,1,M), param(Board,N) do
        ( for(J,1,N), param(Board,I) do
        X is Board[I,J],
        ( X==0 -> write("  ")
        ; X==1 -> write(" *")
        ;         write(" ?")
        )
        ), nl
    ), nl.
 
 
%----------------------------------------------------------------------
% sample problems
%
% data(ProblemName, NRows, NColumns, RowBlocks, ColumnBlocks)
%----------------------------------------------------------------------
 
data(ps, 9, 8,
    [[3],[2,1],[3,2],[2,2],[6],[1,5],[6],[1],[2]],  % row blocks
    [[1,2],[3,1],[1,5],[7,1],[5],[3],[4],[3]]       % column blocks
).
 
% from http://www.pro.or.jp/~fuji/java/puzzle/nonogram/index-eng.html
data(n2, 10, 10,
    [[1],[3],[1,3],[2,4],[1,2],[2,1,1],[1,1,1,1],[2,1,1],[2,2],[5]],
    [[4],[1,3],[2,3],[1,2],[2,2],[1,1,1],[1,1,1,1],[1,1,1],[1,2],[5]]
).
data(n3, 10, 15,
    [[4],[1,1,6],[1,1,6],[1,1,6],[4,9],[1,1],[1,1],[2,7,2],[1,1,1,1],[2,2]],
    [[4],[1,2],[1,1],[5,1],[1,2],[1,1],[5,1],[1,1],[4,1],[4,1],[4,2],[4,1],[4,1],[4,2],[4]]
).
data(n4, 6, 6,
    [[2,1],[1],[2],[2],[1],[1,2]],
    [[1,2],[1],[2],[2],[1],[2,1]]
).
data(n5, 10, 10,
    [[3],[3],[1],[3],[6],[3],[3],[3,3],[2,2],[2,1]],
    [[1],[1,2],[1,2],[1,1],[2,5],[7],[2,5],[1],[2],[2]]
).
data(n6, 15, 15,
    [[5],[2,2],[1,1],[1,1],[4,4],[2,2,1,2],[1,3,1],[1,1,1,1],[2,7,2],[4,1,5],[2,1,1],[1,1,2],[1,1,1],[2,5,2],[3,4]],
    [[4],[2,2],[1,5],[1,2,2],[5,2,1],[2,1,1,2],[1,3,1],[1,1,6],[1,3,1],[2,1,2,2],[4,2,1],[1,1,1],[1,3,2],[2,2,3],[4]]
).
data(n16, 15, 15,
    [[4],[2,2],[2,2],[2,4,2],[2,1,1,2],[2,4,2],[1,2],[4,4,4],[1,1,1,1,1,1],[4,1,1,4],[1,1,1],[1,1,3],[10],[2,1],[4,1]],
    [[5,1],[2,1,1,1],[2,1,1,2],[2,3,3],[2,1],[2,3,6],[1,1,1,1,1],[1,1,1,1,1],[2,3,6],[2,1],[2,3,1],[2,1,1,1],[2,1,1,4],[7],[1,1]]
).
data(n19, R, C, RB, CB) :-
    data(p199, R, C, RB, CB).
 
data(p197, 20, 15,  % difficulty 7
    [[3],[1,2],[1,4],[1,1,2],[1,1,1,1],[1,3,2],[2,3,1],[1,1,1,2],[2,2,2],[1,1,2,2],[1,1,2,2],[1,1,1,1],[4,1,1],[2,2,2,1],[2,3,3],[2,2,3],[1,3,1,1],[2,1,1,1,2],[1,2,3],[1,6]],
    [[4,3],[6,1,2,3],[2,3],[6],[1,2,2],[1,1,2],[2,4,1,1],[1,1,2,2,2,1],[1,1,1,2,1,1],[1,3,2,3],[3,2,2],[4,3,4,2],[1,3,4,5],[2,2],[3]]
).
data(p199, 20, 20,  % difficulty 8
    [[1,1,4],[1,6],[1,1,1,1,2,3],[1,1,2,3],[3,1,2,3],[4,5,2,2],[7,3,2],[3,5,1,2],[2,2,4,1],[2,2,3,4],[2,5,2],[2,1,5,1],[2,2,3,1],[6,2,2],[1,7],[2,2,2],[1,4],[3,1,1],[1,1],[1,1]],
    [[6,1],[8,3],[3,2,1],[1,1,2,2,1],[1,2,2,1,1],[1,1,1,1],[2,3],[4,1,2,2],[5,2,1],[8,1,1],[7,2],[3,5,2],[2,5],[2,1,4],[2,2,2,2],[2,2,1,1,1],[3,1,1,1,1],[5,4,2,1],[7,4,1,1],[4]]
).
data(p200, 25, 25,  % difficulty 9
    [[1,1,2,2],[5,5,7],[5,2,2,9],[3,2,3,9],[1,1,3,2,7],[3,1,5],[7,1,1,1,3],[1,2,1,1,2,1],[4,2,4],[1,2,2,2],[4,6,2],[1,2,2,1],[3,3,2,1],[4,1,15],[1,1,1,3,1,1],[2,1,1,2,2,3],[1,4,4,1],[1,4,3,2],[1,1,2,2],[7,2,3,1,1],[2,1,1,1,5],[1,2,5],[1,1,1,3],[4,2,1],[3]],
    [[2,2,3],[4,1,1,1,4],[4,1,2,1,1],[4,1,1,1,1,1,1],[2,1,1,2,3,5],[1,1,1,1,2,1],[3,1,5,1,2],[3,2,2,1,2,2],[2,1,4,1,1,1,1],[2,2,1,2,1,2],[1,1,1,3,2,3],[1,1,2,7,3],[1,2,2,1,5],[3,2,2,1,2],[3,2,1,2],[5,1,2],[2,2,1,2],[4,2,1,2],[6,2,3,2],[7,4,3,2],[7,4,4],[7,1,4],[6,1,4],[4,2,2],[2,1]]
).
 
% the example quoted in Optima#65, Mathematical Programming Society Newsletter
data(optima, 20, 20,
    [[7,1],[1,1,2],[2,1,2],[1,2,2],[4,2,3],[3,1,4],[3,1,3],[2,1,4],[2,9],[2,1,5],[2,7],[14],[8,2],[6,2,2],[2,8,1,3],[1,5,5,2],[1,3,2,4,1],[3,1,2,4,1],[1,1,3,1,3],[2,1,1,2]],
    [[1,1,1,2],[3,1,2,1,1],[1,4,2,1,1],[1,3,2,4],[1,4,6,1],[1,11,1],[5,1,6,2],[14],[7,2],[7,2],[6,1,1],[9,2],[3,1,1,1],[3,1,3],[2,1,3],[2,1,5],[3,2,2],[3,3,2],[2,3,2],[2,6]]
).
 
 
% simple check for typos in the data
 
check_data(M, N, RowBlocks, ColBlocks) :-
    length(RowBlocks, M),
    length(ColBlocks, N),
    ( foreach(Blocks,RowBlocks), fromto(0,S0,S1,RowTotal) do
        S1 is S0+sum(Blocks)
    ),
    ( foreach(Blocks,ColBlocks), fromto(0,S0,S1,ColTotal) do
        S1 is S0+sum(Blocks)
    ),
    RowTotal = ColTotal,
    !.
check_data(_,_,_,_) :-
    writeln("Inconsistent input data!"),
    abort.