sudoku.pl

:- module(sudoku, [solve/1, print_puzzle/1]).

:- use_module(library(apply)).
:- use_module(library(apply_macros)).
:- use_module(library(clpfd)).
:- use_module(library(list_util), [split_at/4, iterate/3]).
:- use_module(library(lists), [append/2]).
:- use_module(library(yall)).

blocks(_, [], []) :- !.
blocks(N, Items, [NextBlock|Blocks]) :-
    split_at(N, Items, NextBlock, RestItems),
    blocks(N, RestItems, Blocks).

grid_blocks(Cells, Blocks) :-
    blocks(9, Cells, Rows),
    blocks(3, Rows, RowChunks),
    maplist([Chunks, Block]>>(
                transpose(Chunks, FlipChunks),
                blocks(3, FlipChunks, BBlock),
                maplist(append, BBlock, Block)
            ),
            RowChunks, BBlocks),
    append(BBlocks, Blocks).

constrain_cells(Cells) :-
    length(Cells, 81),
    Cells ins 1..9,
    blocks(9, Cells, Rows),
    maplist(all_different, Rows),
    transpose(Rows, Cols),
    maplist(all_different, Cols),
    grid_blocks(Cells, Blocks),
    maplist(all_different, Blocks).

solve(Puzzle) :-
    constrain_cells(Puzzle),
    % ff = fail-first = label the leftmost variable with the smallest
    % domain next
    labeling([ff], Puzzle).

print_top_line :-
    format("┌───┬───┬───┐~n", []).
print_line(Line) :-
    blocks(3, Line, [Block1, Block2, Block3]),
    format("│~w~w~w", Block1),
    format("│~w~w~w", Block2),
    format("│~w~w~w│~n", Block3).
print_joiner_line :-
    format("├───┼───┼───┤~n", []).
print_bottom_line :-
    format("└───┴───┴───┘", []).

print_puzzle(Puzzle) :-
    blocks(9, Puzzle, Lines),
    print_top_line,
    split_at(3, Lines, L13, Rest1),
    maplist(print_line, L13),
    print_joiner_line,
    split_at(3, Rest1, L46, L79),
    maplist(print_line, L46),
    print_joiner_line,
    maplist(print_line, L79),
    print_bottom_line.

% test puzzles

coordinates(
    [a1, a2, a3,  a4, a5, a6,  a7, a8, a9,
     b1, b2, b3,  b4, b5, b6,  b7, b8, b9,
     c1, c2, c3,  c4, c5, c6,  c7, c8, c9,

     d1, d2, d3,  d4, d5, d6,  d7, d8, d9,
     e1, e2, e3,  e4, e5, e6,  e7, e8, e9,
     f1, f2, f3,  f4, f5, f6,  f7, f8, f9,

     g1, g2, g3,  g4, g5, g6,  g7, g8, g9,
     h1, h2, h3,  h4, h5, h6,  h7, h8, h9,
     i1, i2, i3,  i4, i5, i6,  i7, i8, i9]).

test_puzzle1(
    [_, _, _,  7, 5, _,  1, _, _,
     _, _, 1,  4, _, _,  3, 5, _,
     _, _, _,  _, _, 9,  _, _, _,

     2, 3, 6,  _, _, _,  _, 9, _,
     _, 8, 4,  1, _, _,  7, _, _,
     _, _, _,  _, _, _,  _, 3, _,

     _, _, _,  _, _, _,  _, 7, 2,
     _, 2, _,  3, 7, _,  4, _, _,
     _, 6, _,  _, _, 1,  _, _, _
    ]
).

test_puzzle2(
    [5, _, 2,  _, 7, _,  _, _, _,
     _, _, _,  2, _, _,  _, 6, 9,
     _, 7, _,  _, 4, _,  _, _, _,

     _, _, _,  5, _, _,  _, 1, _,
     2, _, 1,  _, 6, _,  _, 4, _,
     3, _, _,  _, _, 2,  _, _, _,

     _, 2, _,  _, _, 7,  6, _, _,
     6, _, 8,  _, _, _,  3, _, 1,
     _, _, 5,  _, _, 8,  _, _, _
    ]
).

test_puzzle3(
    [_, _, _,  _, _, _,  _, 1, 2,
     _, _, _,  _, 3, 5,  _, _, _,
     _, _, _,  6, _, _,  _, 7, _,

     7, _, _,  _, _, _,  3, _, _,
     _, _, _,  4, _, _,  8, _, _,
     1, _, _,  _, _, _,  _, _, _,

     _, _, _,  1, 2, _,  _, _, _,
     _, 8, _,  _, _, _,  _, 4, _,
     _, 5, _,  _, _, _,  6, _, _
    ]
).

/* Solution:
┌───┬───┬───┐
│673│894│512│
│912│735│486│
│845│612│973│
├───┼───┼───┤
│798│261│354│
│526│473│891│
│134│589│267│
├───┼───┼───┤
│469│128│735│
│287│356│149│
│351│947│628│
└───┴───┴───┘
*/