/***
Problem statement: Solution:
1 2 3 4 5 6 7 8
|_|_|_|_|_|_|_|_| 3 1 |_|X|X|X|_|_|_|_| 3
|_|_|_|_|_|_|_|_| 2 1 2 |X|X|_|X|_|_|_|_| 2 1
|_|_|_|_|_|_|_|_| 3 2 3 |_|X|X|X|_|_|X|X| 3 2
|_|_|_|_|_|_|_|_| 2 2 4 |_|_|X|X|_|_|X|X| 2 2
|_|_|_|_|_|_|_|_| 6 5 |_|_|X|X|X|X|X|X| 6
|_|_|_|_|_|_|_|_| 1 5 6 |X|_|X|X|X|X|X|_| 1 5
|_|_|_|_|_|_|_|_| 6 7 |X|X|X|X|X|X|_|_| 6
|_|_|_|_|_|_|_|_| 1 8 |_|_|_|_|X|_|_|_| 1
|_|_|_|_|_|_|_|_| 2 9 |_|_|_|X|X|_|_|_| 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
This problem can be stated as the two lists:
[[3],[2,1],[3,2],[2,2],[6],[1,5],[6],[1],[2]] and
[[1,2],[3,1],[1,5],[7,1],[5],[3],[4],[3]] which give the
"solid" lengths of the rows and columns, top-to-bottom and
left-to-right, respectively.
***/
/* On backtracking, finds and displays all solutions to problem N */
nonogram(N):-
problem(N, Rows, Cols),
length(Rows, Height),
length(Cols, Width),
initialize_domains(Rows, Width, RowVDs),
initialize_domains(Cols, Height, ColVDs),
forward_checking(RowVDs, ColVDs, RowVVs, _),
sort(RowVVs, SortedRowVVs),
show_solution(SortedRowVVs, Width),
fail.
nonogram(_).
/* Initializes the domain for each variable */
/* e.g. initialize_domains([[3],[2,1]], 5, VDs),
VDs=[vd(1, [[1,2,3],[2,3,4],[3,4,5]]),
vd(2, [[1,2,4],[1,2,5],[2,3,5]])]. */
initialize_domains(Rules, Size, VDs):-
initialize_domains_1(Rules, Size, 1, VDs).
initialize_domains_1([], _, _, []).
initialize_domains_1([Rule|Rules], Size, Var, [vd(Var,Domain)|VDs]):-
findall(Pattern, pattern_nd(Rule, Size, Pattern), Domain),
Var1 is Var + 1,
initialize_domains_1(Rules, Size, Var1, VDs).
/* Generates a Pattern corresponding to the Rule */
/* e.g. pattern_nd([2,3,4], 12, Pattern). */
pattern_nd(Rule, Size, Pattern):-
sum(Rule, Sum),
length(Rule, Length),
Sum1 is Sum + Length - 1,
pattern_nd_1(Rule, Sum1, 1, Size, [], Pattern).
pattern_nd_1([0], _, _, _, _, [0]):-!.
pattern_nd_1([N], _, LowerBound, Size, Pattern0, Pattern):-!,
UpperBound is Size - N + 1,
for(LowerBound, UpperBound, First),
Last is First + N - 1,
integers(First, Last, Pattern1),
append(Pattern0, Pattern1, Pattern).
pattern_nd_1([N|Rule], Sum, LowerBound, Size, Pattern0, Pattern):-
UpperBound is Size - Sum + 1,
for(LowerBound, UpperBound, First),
Last is First + N - 1,
integers(First, Last, Pattern1),
Sum1 is Sum - N - 1,
LowerBound1 is Last + 2,
append(Pattern0, Pattern1, Pattern2),
pattern_nd_1(Rule, Sum1, LowerBound1, Size, Pattern2, Pattern).
/* forward_checking(RowVDs, ColVDs, RowVVs, ColVVs) is true if for each */
/* element vd(Xi,Di) of the list RowVDs the corresponding element of the */
/* list RowVVs is vv(Xi,Vi) where Vi is an element of Di, such that the */
/* elements of RowVVs satisfy the constraints (and similarly for the */
/* lists ColVDs and ColVVs). On backtracking, all solutions will be */
/* found. */
forward_checking([], [], [], []):-!.
forward_checking([], ColVDs, RowVVs, ColVVs):-
forward_checking(ColVDs, [], ColVVs, RowVVs).
forward_checking([RowVD|RowVDs], ColVDs, [vv(Xi,Vi)|RowVVs], ColVVs):-
shortest_and_rest(RowVDs, RowVD, vd(Xi,Di), RowVDs1),
member(Vi, Di),
update_domains(ColVDs, vv(Xi,Vi), ColVDs1),
forward_checking(ColVDs1, RowVDs1, ColVVs, RowVVs).
/* shortest_and_rest(VDs, VD, Shortest, Rest) is true if Shortest is the */
/* shortest element of [VD|VDs] and Rest contains the other elements of */
/* [VD|VDs] (not necessarily in the same order). */
shortest_and_rest([], Shortest, Shortest, []).
shortest_and_rest([vd(Xh,Dh)|VDs], vd(Xi,Di), Shortest, [vd(Xi,Di)|Rest]):-
is_shorter(Dh, Di), !,
shortest_and_rest(VDs, vd(Xh,Dh), Shortest, Rest).
shortest_and_rest([VD|VDs], BestSoFar, Shortest, [VD|Rest]):-
shortest_and_rest(VDs, BestSoFar, Shortest, Rest).
/* update_domains(VDs0, vv(Xi,Vi), VDs) is true if: each element vd(Xh,Dk) */
/* of VDs is the same as the corresponding element vd(Xh,Dh) of VDs0 */
/* except that each value Vh is removed if vv(Xi,Vi) and vv(Xh,Vh) are */
/* not consistent; and no domain Dk is empty. */
/* e.g. update_domains([vd(2,[1,2,3,4]),vd(3,[1,2,3,4]),vd(4,[1,2,3,4])], */
/* vv(1,1), */
/* [vd(2,[3,4]),vd(3,[2,4]),vd(4,[2,3])]). */
update_domains([], _, []).
update_domains([vd(Xh,Dh)|VDs0], VV, [vd(Xh,Dk)|VDs]):-
update_domain(Dh, Xh, VV, Dk),
Dk=[_|_],
update_domains(VDs0, VV, VDs).
/* update_domain(Dh, Xh, vv(Xi,Vi), Dk) is true if the domain Dk is the */
/* same as the domain Dh except that each value Vh is removed if */
/* vv(Xi,Vi) and vv(Xh,Vh) are not consistent. */
update_domain([], _, _, []).
update_domain([Vh|Dh], Xh, VVi, Dk):-
/* \+... helps to avoid heap overflow but is slightly slower */
/* than putting the test in the next clause */
\+ consistent(vv(Xh,Vh), VVi), !,
update_domain(Dh, Xh, VVi, Dk).
update_domain([Vh|Dh], Xh, VVi, [Vh|Dk]):-
update_domain(Dh, Xh, VVi, Dk).
/* consistent(vv(RowNo,Row), vv(ColumnNo,Column)) is true if the Row */
/* placed at RowNo is consistent with the Column placed at ColumnNo. */
/* e.g. consistent(vv(2,[1,2,3]), vv(1,[2])). */
consistent(vv(RowNo,Row), vv(ColumnNo,Column)):-
ord_member(ColumnNo, Row), !,
ord_member(RowNo, Column).
consistent(vv(RowNo,_), vv(_,Column)):-
\+ ord_member(RowNo, Column).
/* Used by insertion_sort/2 */
lt(vv(X,_), vv(Y,_)):-X < Y.
/* Displays a solution */
show_solution([], _):-nl.
show_solution([vv(_,Vals)|VVs], Width):-
show_row(1, Width, Vals), nl,
show_solution(VVs, Width).
/* Displays a row of the solution */
show_row(N, Width, _):-
N > Width, !.
show_row(N, Width, [N|Vals]):-!,
write('#'),
N1 is N + 1,
show_row(N1, Width, Vals).
show_row(N, Width, Vals):-
write('-'),
N1 is N + 1,
show_row(N1, Width, Vals).
/*
* Data
*/
/* 9x8 1 solution: */
problem(1, [[3],[2,1],[3,2],[2,2],[6],[1,5],[6],[1],[2]],
[[1,2],[3,1],[1,5],[7,1],[5],[3],[4],[3]]).
/* 8x8 2 solutions: */
problem(2, [[2],[1,1],[1,1],[2],[2,1],[1,2,2],[4,1],[3]],
[[2],[1,1],[2],[2,4],[1,1,2],[1,1,1,1],[2,2],[0]]).
/* 4x4 1 solution: */
problem(3, [[4],[1,1],[2],[1]], [[3],[1,1],[1,1],[2]]).
/* 10x7 1 solution: */
problem(4, [[5],[1,1,1],[5],[1],[5],[1,1,2],[1],[5],[1,1],[2,2]],
[[1],[3,2,3],[1,1,1,1],[8],[1,1,1,1],[3,2,3],[1,1]]).
/* 10x10 1 solution: */
problem(5,
[[3],[2,1],[1,1],[1,4],[1,1,1,1],[2,1,1,1],[2,1,1],[1,2],[2,3],[3]],
[[3],[2,1],[2,2],[2,1],[1,2,1],[1,1],[1,4,1],[1,1,2],[3,1],[4]]).
/*
* Library procedures
*/
/* for(I, J, K) is true if K is an integer between I and J inclusive. */
for(I, J, I):-I =< J.
for(I, J, K):-I < J, I1 is I + 1, for(I1, J, K).
/* integers(M, N, Is) is true if Is is the list of integers from M to N */
/* inclusive. */
integers(N, N, [N]):-!.
integers(I, N, [I|Is]):-I < N, I1 is I + 1, integers(I1, N, Is).
/* is_shorter(Xs, Ys) is true if the list Xs contains fewer elements than */
/* the list Ys. */
is_shorter([], [_|_]).
is_shorter([_|Xs], [_|Ys]):-is_shorter(Xs, Ys).
/* ord_member(+X, +Set) is true if X is a member of the ordered set Set. */
/* e.g. ord_member(3, [2,3,4]). */
ord_member(X, [Y|_]):-X=Y, !.
ord_member(X, [Y|Xs]):-Y < X, ord_member(X, Xs).
/* sum(Xs, Y) is true if Y is the sum of the elements in the list Xs. */
sum(Xs, Y):-sum_1(Xs, 0, Y).
sum_1([], A, B):-A=B.
sum_1([X|Xs], A, Y):-B is X + A, sum_1(Xs, B, Y).