prologsudokuclpfdprogram-slicing

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


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.


Solution

  • 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.