Trouble implementing greater-than/inequality sudoku solver in SWI-Prolog

125 views Asked by At

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.

2

There are 2 answers

0
notoria On BEST ANSWER

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.

4
notoria On

Since it's pure, it's possible to debug this without a debugger by using (*)/1:

:- use_module(library(clpfd)).

:- op(950, fx, *).
*(_).

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],
        * portray_clause([As, Bs, Cs, [H1,H2,H3], [V1,V2,V3]]),
        * 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]]).

test :-
    problem(1, Rows, Horizontals, Verticals),
    greatersudoku(Rows, Horizontals, Verticals),
    append(Rows, Vs),
    labeling([], Vs),
    maplist(portray_clause, Rows), nl.

Then test with test/0. What remains explains why it fails.