1:- module(sudoku_utils, [sudoku/1, sudoku_with_underscore_string/2, fill_underscore_string_array/2]). 2 3:- set_prolog_flag(double_quotes, chars). 4 5:- use_module(library(clpfd)). 6:- use_module(library(lists)). 7 8sudoku(Rows) :- 9 length(Rows, 9), maplist(same_length(Rows), Rows), 10 append(Rows, Vs), Vs ins 1..9, 11 maplist(all_distinct, Rows), 12 transpose(Rows, Columns), 13 maplist(all_distinct, Columns), 14 Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is], 15 blocks(As, Bs, Cs), 16 blocks(Ds, Es, Fs), 17 blocks(Gs, Hs, Is). 18 19fill_underscore_string(A, A) :- 20 number(A), 21 !. 22fill_underscore_string(_, '_'). 23 24fill_underscore_string_array(In, Out) :- 25 maplist(fill_underscore_string, In, Out). 26 27sudoku_with_underscore_string(In, Out) :- 28 maplist(fill_underscore_string_array, In, Out). 29 30blocks([], [], []). 31blocks([N1, N2, N3|Ns1], [N4, N5, N6|Ns2], [N7,N8,N9|Ns3]) :- 32 all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]), 33 blocks(Ns1, Ns2, Ns3)