I have been trying to modify the sudoku solver available in the clpfd docs in order to solve greater-than sudoku puzzles, such as this one:
Example of greater-than sudoku puzzle
In these puzzles, each block contains twelve inequalities between cells (six horizontal and six vertical inequalities) which must be satisfied as part of the solution.
I modeled the inequalities as lists of nine lists, each list containing six integers from 0 to 1, representing "less than" and "greater than", respectively. I also declared a "comp" predicate to compare values of cells and made the appropriate changes to the constraints, as shown below:
:- use_module(library(clpfd)).
greatersudoku(Rows, Horizontals, Verticals) :-
length(Rows, 9), maplist(same_length(Rows), Rows),
append(Rows, Vs),
Vs ins 1..9,
length(Horizontals, 9), maplist(same_length([0,1,2,3,4,5]), Horizontals),
append(Horizontals, Ws),
Ws ins 0..1,
length(Verticals, 9), maplist(same_length([0,1,2,3,4,5]), Verticals),
append(Verticals, Ws),
maplist(all_distinct, Rows),
transpose(Rows, Columns),
maplist(all_distinct, Columns),
Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
Horizontals = [H1,H2,H3,H4,H5,H6,H7,H8,H9],
Verticals = [V1,V2,V3,V4,V5,V6,V7,V8,V9],
blocks(As, Bs, Cs, [H1,H2,H3], [V1,V2,V3]),
blocks(Ds, Es, Fs, [H4,H5,H6], [V4,V5,V6]),
blocks(Gs, Hs, Is, [H7,H8,H9], [V7,V8,V9]).
blocks([], [], [], _, _).
blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3], [Ha|HOR], [Va|VER]) :-
all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
Ha = [C1,C2,C3,C4,C5,C6],
Va = [D1,D2,D3,D4,D5,D6],
comp(N1,C1,N2), comp(N2,C2,N3), comp(N4,C3,N5), comp(N5,C4,N6), comp(N7,C5,N8), comp(N8,C6,N9),
comp(N1,D1,N4), comp(N4,D2,N7), comp(N2,D3,N5), comp(N5,D4,N8), comp(N3,D5,N6), comp(N6,D6,N9),
blocks(Ns1, Ns2, Ns3, HOR, VER).
comp(X,0,Y) :- X #> Y.
comp(X,1,Y) :- comp(Y,0,X).
problem(1, [[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_],[_,_,_,_,_,_,_,_,_]],
[[0,1,0,0,0,0],[0,0,0,1,0,1],[1,1,1,0,1,0],[1,1,1,0,0,1],[1,0,1,0,0,1],[0,1,1,1,1,0],[0,1,1,0,0,1],[1,1,1,0,0,0],[0,1,0,0,0,1]],
[[1,0,0,0,0,0],[1,1,1,0,1,1],[0,1,0,1,1,1],[1,0,0,1,0,0],[1,1,1,0,0,1],[0,1,0,1,1,1],[1,1,1,0,0,1],[0,1,1,1,1,0],[0,0,0,1,0,1]]).
However, instead of providing a solution, the program returns a "false" value. I am not sure where I made a mistake, and therefore I ask for your help.
Alternative way to solve this:
:- use_module(library(clpfd)).
% :- use_module(library(lists), [append/2,length/2,maplist/2,maplist/3,same_length/2]).
transpose([Ls|Lss], Tss) :-
Ls = [_|_],
transpose_(Ls, [Ls|Lss], Tss).
transpose_([], Lss0, []) :-
column_(Lss0).
transpose_([_|Ls], Lss0, [Ts|Tss]) :-
column_(Lss0, Ts, Lss),
transpose_(Ls, Lss, Tss).
column_([]).
column_([[]|Es]) :-
column_(Es).
column_([], [], []).
column_([[L|Ls]|Lss0], [L|Ts], [Ls|Lss]) :-
column_(Lss0, Ts, Lss).
box([], _).
box([Es|Ess], Fs) :-
same_length(Es, Fs),
maplist(box(Ess), Fs).
square(N, Rows, Cols, SqrsR, SqrsC) :-
length(Lssss, N),
Lssss = [_|_],
box([Lssss,Lssss,Lssss,Lssss], Lssss),
append(Lssss, Lsss),
maplist(append, Lsss, Rows),
transpose(Rows, Cols),
maplist(transpose, Lssss, Mssss),
append(Mssss, Msss),
maplist(append, Msss, SqrsR),
maplist(transpose, Msss, Nsss),
maplist(append, Nsss, SqrsC).
sudoku(N, Rows) :-
N2 #= N*N,
square(N, Rows, Cols, Sqrs, _),
append(Rows, Vs),
Vs ins 1..N2,
maplist(all_distinct, Rows),
maplist(all_distinct, Cols),
maplist(all_distinct, Sqrs).
inequalities_sudoku(Rss, Css, Rows) :-
N #= 3,
N2 #= N*N,
square(N, Rows, Cols, SqrsR, SqrsC),
append(Rows, Vs),
Vs ins 1..N2,
maplist(all_distinct, Rows),
maplist(all_distinct, Cols),
maplist(all_distinct, SqrsR),
maplist(relate, Rss, SqrsR),
maplist(relate, Css, SqrsC).
relation(#<).
relation(#>).
relate([], []).
relate([R0,R1|Rs], [N0,N1,N2|Ns]) :-
relation(R0),
call(R0, N0, N1),
relation(R1),
call(R1, N1, N2),
relate(Rs, Ns).
% Source: https://www.metalevel.at/sudoku/sudoku.pl
problem(1, P) :- % shokyuu
P = [[1,_,_,8,_,4,_,_,_],
[_,2,_,_,_,_,4,5,6],
[_,_,3,2,_,5,_,_,_],
[_,_,_,4,_,_,8,_,5],
[7,8,9,_,5,_,_,_,_],
[_,_,_,_,_,6,2,_,3],
[8,_,1,_,_,_,7,_,_],
[_,_,_,1,2,3,_,8,_],
[2,_,5,_,_,_,_,_,9]].
problem(2, P) :- % shokyuu
P = [[_,_,2,_,3,_,1,_,_],
[_,4,_,_,_,_,_,3,_],
[1,_,5,_,_,_,_,8,2],
[_,_,_,2,_,_,6,5,_],
[9,_,_,_,8,7,_,_,3],
[_,_,_,_,4,_,_,_,_],
[8,_,_,_,7,_,_,_,4],
[_,9,3,1,_,_,_,6,_],
[_,_,7,_,6,_,5,_,_]].
problem(3, P) :-
P = [[1,_,_,_,_,_,_,_,_],
[_,_,2,7,4,_,_,_,_],
[_,_,_,5,_,_,_,_,4],
[_,3,_,_,_,_,_,_,_],
[7,5,_,_,_,_,_,_,_],
[_,_,_,_,_,9,6,_,_],
[_,4,_,_,_,6,_,_,_],
[_,_,_,_,_,_,_,7,1],
[_,_,_,_,_,1,_,3,_]].
% :- use_module(library(format)).
:- use_module(library(time)).
test :-
problem(N, Rows0),
writeq(N), nl,
inequalities_sudoku(Rss, Css, Rows0),
inequalities_sudoku(Rss, Css, Rows),
append(Rows, Vs),
labeling([], Vs),
maplist(portray_clause, [Rss,Css]),
maplist(portray_clause, Rows), nl,
false.
test :-
false,
problem(N, Rows),
writeq(N), nl,
time(sudoku(3, Rows)),
maplist(portray_clause, Rows),
false.
Test with test/0
for an example.