Prolog "sudoku_shuffle"

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.
*/
:- ensure_loaded(library(compat)).
:- ensure_loaded(library(util/random)).
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).
% random_indomain(-Integer)
random_indomain(X) :-
random_permutation([1,2,3,4,5,6,7,8,9], L),
member(X, L).
% random_label(+Frame)
random_label(L) :-
random_permutation(L, R),
search(R).
% search(+Frame)
search([]) :- !.
search(L) :- best(L, K-S, _, R),
random_indomain(K), \+ (member(J,S), J==K),
search(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).
/***********************************************************/
/* Random Utility */
/***********************************************************/
% random_permutation(+List, -List)
random_permutation(L, R) :-
add_random_keys(L, H),
keysort(H, J),
remove_keys(J, R).
% add_random_keys(+List, -Pairs)
add_random_keys([X|L], [K-X|R]) :- random(K), add_random_keys(L, R).
add_random_keys([], []).
% remove_keys(+Pairs, -List)
remove_keys([_-X|L], [X|R]) :- remove_keys(L, R).
remove_keys([], []).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Dogelog Player for Java, 1.2.0
% ?- problem(0, M), sudoku(M, [], L), between(1,10,_), time(once(random_label(L))), fail.
% Zeit 23 ms, GC 0 ms, Lips 13227304, Uhr 18.03.2024 01:51
% Zeit 23 ms, GC 0 ms, Lips 13171260, Uhr 18.03.2024 01:51
% Zeit 33 ms, GC 0 ms, Lips 9836242, Uhr 18.03.2024 01:51
% Zeit 22 ms, GC 0 ms, Lips 13777454, Uhr 18.03.2024 01:51
% Zeit 22 ms, GC 0 ms, Lips 13761636, Uhr 18.03.2024 01:51
% Zeit 25 ms, GC 0 ms, Lips 12535760, Uhr 18.03.2024 01:51
% Zeit 31 ms, GC 0 ms, Lips 9792225, Uhr 18.03.2024 01:51
% Zeit 23 ms, GC 0 ms, Lips 14135869, Uhr 18.03.2024 01:51
% Zeit 24 ms, GC 0 ms, Lips 12741541, Uhr 18.03.2024 01:51
% Zeit 23 ms, GC 0 ms, Lips 13171130, Uhr 18.03.2024 01:51
% fail.
% ?- problem(0, M), sudoku(M, [], L),
% time((between(1,50,_), once(random_label(L)), fail; true)).
% % Zeit 1279 ms, GC 0 ms, Lips 11919718, Uhr 01.04.2024 16:59
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% SWI-Prolog, 9.3.2
% ?- problem(0, M), sudoku(M, [], L), between(1,10,_), time(once(random_label(L))), fail.
% % 142,440 inferences, 0.016 CPU in 0.009 seconds (178% CPU, 9116160 Lips)
% % 150,844 inferences, 0.000 CPU in 0.009 seconds (0% CPU, Infinite Lips)
% % 143,750 inferences, 0.016 CPU in 0.008 seconds (185% CPU, 9200000 Lips)
% % 156,572 inferences, 0.016 CPU in 0.009 seconds (173% CPU, 10020608 Lips)
% % 152,443 inferences, 0.000 CPU in 0.009 seconds (0% CPU, Infinite Lips)
% % 142,772 inferences, 0.016 CPU in 0.008 seconds (188% CPU, 9137408 Lips)
% % 140,382 inferences, 0.000 CPU in 0.008 seconds (0% CPU, Infinite Lips)
% % 153,927 inferences, 0.016 CPU in 0.009 seconds (176% CPU, 9851328 Lips)
% % 153,939 inferences, 0.000 CPU in 0.009 seconds (0% CPU, Infinite Lips)
% % 149,784 inferences, 0.016 CPU in 0.009 seconds (177% CPU, 9586176 Lips)
% false.
% ?- problem(0, M), sudoku(M, [], L),
% time((between(1,50,_), once(random_label(L)), fail; true)).
% % 7,376,432 inferences, 0.422 CPU in 0.414 seconds (102% CPU, 17484876 Lips)