Prolog "sudoku_exact"

Admin User, erstellt 01. Apr. 2024
         
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
sudoku(Rows) -->
rows(Rows),
{transpose(Rows, Columns)},
rows(Columns),
groups(Rows).
groups([]) --> [].
groups([As,Bs,Cs|L]) --> blocks(As, Bs, Cs), groups(L).
blocks([], [], []) --> [].
blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) -->
all_different([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
blocks(Ns1, Ns2, Ns3).
rows([]) --> [].
rows([H|T]) --> all_different(H), rows(T).
% indomain(-Integer)
indomain(X) :- between(1,9,X).
% label(+Frame)
label([]) :- !.
label(L) :- best(L, K-S, _, R),
indomain(K), \+ (member(J,S), J==K),
label(R).
/***********************************************************/
/* Inequality Graph */
/***********************************************************/
% all_different(+List)
all_different([]) --> [].
all_different([H|T]) --> all_different(T), all_different2(T, H).
% all_different(+List, +Var)
all_different2([], _) --> [].
all_different2([H|T], X) --> dif(H, X), all_different2(T, X).
% dif(+Term, +Term, +List, -List)
dif(A, B, I, I) :- integer(A), integer(B), !, A \== B.
dif(A, B, I, O) :- integer(A), !, put(I, B, A, O).
dif(A, B, I, O) :- integer(B), !, put(I, A, B, O).
dif(A, B, I, O) :- A \== B, put(I, A, B, H), put(H, B, A, O).
% put(+Frame, +Term, +Term, -Frame)
put([K-S|L], J, V, [J-[V],K-S|L]) :- J @< K, !.
put([K-S|L], J, V, [K-T|L]) :- K == J, !, add(V, S, T).
put([P|L], J, V, [P|R]) :- put(L, J, V, R).
put([], K, V, [K-[V]]).
% add(+Term, +List, -List)
add(V, S, [V|S]) :- \+ (member(J,S), J==V), !.
add(_, S, S).
/***********************************************************/
/* Scoring Dynamic */
/***********************************************************/
% best(+Frame, -Pair, -Integer, -Frame)
best([K-S], K-S, V, []) :- !, score(S, [], V).
best([K-S|L], P, Q, T) :- best(L, U, W, R), score(S, [], V),
(V > W -> P=K-S, Q=V, T=[U|R];
P=U, Q=W, T=[K-S|R]).
% score(+List, +List, -Integer)
score([], _, 0).
score([V|S], L, N) :- integer(V), notin(L, V), !, score(S, [V|L], M), N is M+1.
score([_|S], L, N) :- score(S, L, N).
% notin(+List, +Term)
notin([], _).
notin([X|L], Y) :- X\==Y, notin(L, Y).
/***********************************************************/
/* Matrice Utility */
/***********************************************************/
/**
* Stackoverflow, CapelliC, Dec 7, 2015
*/
% transpose(+Matrice, -Matrice)
transpose([], []).
transpose([U], B) :- !, gen(U, B).
transpose([H|T], R) :- transpose(T, TC), splash(H, TC, R).
% transpose(+List, -Matrice)
gen([], []).
gen([H|T], [[H]|RT]) :- gen(T,RT).
% splash(+List, +Matrice, -Matrice)
splash([], [], []).
splash([H|T], [R|K], [[H|R]|U]) :- splash(T,K,U).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Dogelog Player for Java, 1.2.0
% ?- problem(K, M), sudoku(M, [], L), write(K), write(': '),
% sys_trap(time_out(time(once(label(L))),60000), _, true), fail.
% 0: % Zeit 35 ms, GC 0 ms, Lips 8073314, Uhr 18.03.2024 01:47
% 1: % Zeit 17 ms, GC 0 ms, Lips 8536705, Uhr 18.03.2024 01:47
% 2: % Zeit 44 ms, GC 0 ms, Lips 11039295, Uhr 18.03.2024 01:47
% 3: % Zeit 4534 ms, GC 0 ms, Lips 10769521, Uhr 18.03.2024 01:47
% 4: % Zeit 14 ms, GC 0 ms, Lips 11446357, Uhr 18.03.2024 01:47
% 5: % Zeit 15 ms, GC 0 ms, Lips 11363000, Uhr 18.03.2024 01:47
% 6: % Zeit 329 ms, GC 0 ms, Lips 10856319, Uhr 18.03.2024 01:47
% 7: % Zeit 3456 ms, GC 0 ms, Lips 11405055, Uhr 18.03.2024 01:47
% 8: % Zeit 2955 ms, GC 0 ms, Lips 11104421, Uhr 18.03.2024 01:47
% fail.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% SWI-Prolog, 9.3.0
% ?- problem(K, M), sudoku(M, [], L), write(K), write(': '),
% catch(call_with_time_limit(60, time(once(label(L)))), _, true), fail.
% 0: % 135,039 inferences, 0.016 CPU in 0.009 seconds (181% CPU, 8642496 Lips)
% 1: % 87,960 inferences, 0.016 CPU in 0.005 seconds (345% CPU, 5629440 Lips)
% 2: % 291,762 inferences, 0.000 CPU in 0.014 seconds (0% CPU, Infinite Lips)
% 3: % 28,166,388 inferences, 1.391 CPU in 1.393 seconds (100% CPU, 20254481 Lips)
% 4: % 95,053 inferences, 0.016 CPU in 0.005 seconds (318% CPU, 6083392 Lips)
% 5: % 101,815 inferences, 0.016 CPU in 0.005 seconds (317% CPU, 6516160 Lips)
% 6: % 2,078,713 inferences, 0.109 CPU in 0.101 seconds (108% CPU, 19005376 Lips)
% 7: % 21,937,919 inferences, 1.125 CPU in 1.131 seconds (99% CPU, 19500372 Lips)
% 8: % 18,782,731 inferences, 0.922 CPU in 0.925 seconds (100% CPU, 20374488 Lips)
% false.