Prolog - jigoku solver - run time - prolog

I'm a total newbie to Prolog (as in: I've only done the Prolog chapter in 7 languages in 7 weeks), so general comments to any of the code below are very welcome.
First of all: What is a jigoku? It's like a sudoku, except that you get an empty grid, and within each 3x3 block, inequalities between adjacent slots are given. Example here: http://krazydad.com/jigoku/books/KD_Jigoku_CH_8_v18.pdf. You still need to fill up the grid such that each row, column and block contains the numbers 1-9.
I've tried to implement a solver based on this sudoku solver: http://programmablelife.blogspot.co.uk/2012/07/prolog-sudoku-solver-explained.html. For debugging reasons, I started with a 4x4 example that works really well:
:- use_module(library(clpfd)).
small_jidoku(Rows, RowIneqs, ColIneqs) :-
Rows = [A,B,C,D],
append(Rows, Vs), Vs ins 1..4,
maplist(all_distinct, Rows),
transpose(Rows, Columns),
maplist(all_distinct, Columns),
blocks(A, B), blocks(C,D),
maplist(label, Rows),
fake_check_ineqs(Rows, RowIneqs),
fake_check_ineqs(Columns, ColIneqs),
pretty_print([A,B,C,D]).
blocks([], []).
blocks([A,B|Bs1], [D,E|Bs2]) :-
all_distinct([A,B,D,E]),
blocks(Bs1, Bs2).
fake_check_ineqs([],[]).
fake_check_ineqs([Head|Tail], [Ineq1|TailIneqs]) :-
Head = [A,B,C,D],
atom_chars(Ineq1, [X1,X2]),
call(X1, A, B),
call(X2, C, D),
fake_check_ineqs(Tail, TailIneqs).
pretty_print([]).
pretty_print([Head | Tail]) :-
print(Head),
print('\n'),
pretty_print(Tail).
I then solve the following example:
time(small_jidoku([[A1,A2,A3,A4],[B1,B2,B3,B4],[C1,C2,C3,C4],[D1,D2,D3,D4]],[><,<>,<<,<<],[><,<<,<>,>>])).
This runs in about 0.5 seconds tops. However, I've also tried to solve it with
time(small_jidoku([A,B,C,D],[><,<>,<<,<<],[><,<<,<>,>>])).
and this seems to take ages.
Can anyone explain why it takes the solver much longer when I don't specify that each row has 4 elements? My naive answer to this is that Prolog, if not told the actual format of my rows, will also try to explore smaller/bigger rows, hence wasting time on e.g. rows of length 5, but is this actually true?
My second question is about the 9x9 version, that is very much like the 4x4 except that the blocks are of course bigger and that there is more testing to be done when checking inequalities. The code is below:
:- use_module(library(clpfd)).
jidoku(Rows, RowIneqs, ColIneqs) :-
Rows = [A,B,C,D,E,F,G,H,I],
append(Rows, Vs), Vs ins 1..9,
maplist(all_distinct, Rows),
transpose(Rows, Columns),
maplist(all_distinct, Columns),
blocks(A, B, C), blocks(D, E, F), blocks(G, H, I),
maplist(label, Rows),
check_ineqs(Rows, RowIneqs),
check_ineqs(Columns, ColIneqs),
pretty_print([A,B,C,D,E,F,G,H,I]).
blocks([], [], []).
blocks([A,B,C|Bs1], [D,E,F|Bs2], [G,H,I|Bs3]) :-
all_distinct([A,B,C,D,E,F,G,H,I]),
blocks(Bs1, Bs2, Bs3).
check_ineqs([],[]).
check_ineqs([Head|Tail], [Ineq1|TailIneqs]) :-
Head = [A,B,C,D,E,F,G,H,I],
atom_chars(Ineq1, [X1, X2, X3, X4, X5, X6]),
call(X1, A, B),
call(X2, B, C),
call(X3, D, E),
call(X4, E, F),
call(X5, G, H),
call(X6, H, I),
check_ineqs(Tail, TailIneqs).
The test example:
time(jidoku([[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]],
[<>>><>,<<<>><,<<<><>,<><<><,>>><><,><>><>,<>>><>,<>><><,><<>>>],
[<<<><>,><<>>>,<><<><,><<<>>,><><<<,<><><>,<>>>><,><><><,<>><>>])).
and this one has been running overnight without reaching any conclusion and at this point, I have no clue whatsoever what is going wrong. I expected some scaling issues, but not of this proportion!
It would be great if someone who actually knows what they're doing could shine a light on this! Thanks already!

Here is the version of your code I had in mind (other predicates kept unchanged):
ineqs(Cells, Ineq) :-
atom_chars(Ineq, Cs),
maplist(primitive_declarative, Cs, Ds),
ineqs_(Ds, Cells).
ineqs_([], _).
ineqs_([Op1,Op2|Ops], [A,B,C|Cells]) :-
call(Op1, A, B),
call(Op2, B, C),
ineqs_(Ops, Cells).
primitive_declarative(<, #<).
primitive_declarative(>, #>).
Notice that it does not do the generality of the code justice to call the predicate "check_...", because the predicate states what holds and can be used in several directions: Yes, it can be used to check if the constraints hold, but it can also be used to state that the constraints must hold for some variables. I therefore avoid imperatives and use more declarative names.
You use ineqs/2 in jidoku/3 with: maplist(ineqs, Rows, RowsIneqs) etc.
Your example and the result with the new version, using SWI 7.3.2:
?- length(Rows, 9), maplist(same_length(Rows), Rows),
time(jidoku(Rows,
[<>>><>,<<<>><,<<<><>,<><<><,>>><><,><>><>,<>>><>,<>><><,><<>>>],
[<<<><>,><<>>>,<><<><,><<<>>,><><<<,<><><>,<>>>><,><><><,<>><>>])),
maplist(writeln, Rows).
% 2,745,471 inferences, 0.426 CPU in 0.432 seconds (99% CPU, 6442046 Lips)
[1,5,4,8,7,2,6,9,3]
[2,3,9,1,6,5,7,4,8]
[6,7,8,3,9,4,2,5,1]
[3,4,1,2,5,6,8,7,9]
[9,6,5,7,1,8,3,2,4]
[8,2,7,9,4,3,1,6,5]
[4,9,3,6,2,1,5,8,7]
[7,8,2,5,3,9,4,1,6]
[5,1,6,4,8,7,9,3,2]
Rows = [[1, 5, 4, 8, 7, 2, 6, 9|...], ...].
In fact, note that no labeling at all is required to compute the unique solution in this particular case, because the constraint solver is strong enough to reduce all domains to singleton sets.
In your previous version, all the time was needlessly wasted naively generating permutations that were eventually seen to be inconsistent. With the new version, the constraint solver has a chance to apply this knowledge earlier.
It is therefore recommended to first state all constraints, and only then to invoke labeling/2 to search for concrete solutions, as explained in the CLP(FD) manual.

Related

Program decomposition and lazy_findall

I like the idea of lazy_findall as it helps me with keeping predicates separated and hence program decomposition.
What are the cons of using lazy_findall and are there alternatives?
Below is my "coroutine" version of the branch and bound problem.
It starts with the problem setup:
domain([[a1, a2, a3],
[b1, b2, b3, b4],
[c1, c2]]).
price(a1, 1900).
price(a2, 750).
price(a3, 900).
price(b1, 300).
price(b2, 500).
price(b3, 450).
price(b4, 600).
price(c1, 700).
price(c2, 850).
incompatible(a2, c1).
incompatible(b2, c2).
incompatible(b3, c2).
incompatible(a2, b4).
incompatible(a1, b3).
incompatible(a3, b3).
Derived predicates:
all_compatible(_, []).
all_compatible(X, [Y|_]) :- incompatible(X, Y), !, fail.
all_compatible(X, [_|T]) :- all_compatible(X, T).
list_price(A, Threshold, P) :- list_price(A, Threshold, 0, P).
list_price([], _, P, P).
list_price([H|T], Threshold, P0, P) :-
price(H, P1),
P2 is P0 + P1,
P2 =< Threshold,
list_price(T, Threshold, P2, P).
path([], []).
path([H|T], [I|Q]) :-
member(I, H),
path(T, Q),
all_compatible(I, Q).
The actual logic:
solution([], Paths, Paths, Value, Value).
solution([C|D], Paths0, Paths, Value0, Value) :-
( list_price(C, Value0, V)
-> ( V < Value0
-> solution(D, [C], Paths, V, Value)
; solution(D, [C|Paths0], Paths, Value0, Value)
)
; solution(D, Paths0, Paths, Value0, Value)
).
The glue
solution(Paths, Value) :-
domain(D),
lazy_findall(P, path(D, P), Paths0),
solution(Paths0, [], Paths, 5000, Value).
Here is an alternative no-lazy-findall solution by #gusbro: https://stackoverflow.com/a/68415760/1646086
I am not familiar with lazy_findall but I observe two "drawbacks" with the presented approach:
The code is not as decoupled as one might want, because there is still a mix of "declarative" and "procedural" code in the same predicate. I am putting quotes around the terms because they can mean a lot of things but here I see that path/2 is concerned with both generating paths AND ensuring that they are valid. Similarly solution/5 (or rather list_price/3-4) is concerned with both computing the cost of paths and eliminating too costly ones with respect to some operational bound.
The "bounding" test only happens on complete paths. This means that in practice all paths are generated and verified in order to find the shortest one. It does not matter for such a small problem but might be important for larger instances. Ideally, one might want to detect for instance that the partial path [a1,?,?] will never bring a solution less than 2900 without trying all values for b and c.
My suggestion is to instead use clpfd (or clpz, depending on your system) to solve both issues. With clpfd, one can first state the problem without concern for how to solve it, then call a predefined predicate (like labeling/2) to solve the problem in a (hopefully) clever way.
Here is an example of code that starts from the same "setup" predicates as in the question.
state(Xs,Total):-
domain(Ds),
init_vars(Ds,Xs,Total),
post_comp(Ds,Xs).
init_vars([],[],0).
init_vars([D|Ds],[X|Xs],Total):-
prices(D,P),
length(D,N),
X in 1..N,
element(X, P, C),
Total #= C + Total0,
init_vars(Ds,Xs,Total0).
prices([],[]).
prices([V|Vs],[P|Ps]):-
price(V,P),
prices(Vs,Ps).
post_comp([],[]).
post_comp([D|Ds],[X|Xs]):-
post_comp0(Ds,D,Xs,X),
post_comp(Ds,Xs).
post_comp0([],_,[],_).
post_comp0([D2|Ds],D1,[X2|Xs],X1):-
post_comp1(D1,1,D2,X1,X2),
post_comp0(Ds,D1,Xs,X1).
post_comp1([],_,_,_,_).
post_comp1([V1|Vs1],N,Vs2,X1,X2):-
post_comp2(Vs2,1,V1,N,X2,X1),
N1 is N+1,
post_comp1(Vs1,N1,Vs2,X1,X2).
post_comp2([],_,_,_,_,_).
post_comp2([V2|Vs2],N2,V1,N1,X2,X1):-
post_comp3(V2,N2,X2,V1,N1,X1),
N3 is N2 + 1,
post_comp2(Vs2,N3,V1,N1,X2,X1).
post_comp3(V2,N2,X2,V1,N1,X1) :-
( ( incompatible(V2,V1)
; incompatible(V1,V2)
)
-> X2 #\= N2 #\/ X1 #\= N1
; true
).
Note that the code is relatively straightforward, except for the (quadruple) loop to post the incompatibility constraints. This is due to the way I wanted to reuse the predicates in the question. In practice, one might want to change the way the data is presented.
The problem can then be solved with the following query (in SWI-prolog):
?- state(Xs, T), labeling([min(T)], Xs).
T = 1900, Xs = [2, 1, 2] ?
In SICStus prolog, one can write instead:
?- state(Xs, T), minimize(labeling([], Xs), T).
Xs = [2,1,2], T = 1900 ?
Another short predicate could then transform back the [2,1,2] list into [a2,b1,c2] if that format was expected.

How to check order in prolog?

I am trying to solve this puzzle in prolog
Five people were eating apples, A finished before B, but behind C. D finished before E, but behind B. What was the finishing order?
My current solution has singleton variable, I am not sure how to fix this.
finishbefore(A, B, Ls) :- append(_, [A,B|_], Ls).
order(Al):-
length(Al,5),
finishbefore(A,B,Al),
finishbefore(C,A,Al),
finishbefore(D,E,Al),
finishbefore(B,D,Al).
%%query
%%?- order(Al).
Here is a pure version using constraints of library(clpz) or library(clpfd). The idea is to ask for a slightly different problem.
How can an endpoint in time be associated to each person respecting the constraints given?
Since we have five persons, five different points in time are sufficient but not strictly necessary, like 1..5.
:- use_module(library(clpz)). % or clpfd
:- set_prolog_flag(double_quotes, chars). % for "abcde" below.
appleeating_(Ends, Zs) :-
Ends = [A,B,C,D,E],
Zs = Ends,
Ends ins 1..5,
% alldifferent(Ends),
A #< B,
C #< A,
D #< E,
B #< D.
?- appleeating_(Ends, Zs).
Ends = [2, 3, 1, 4, 5], Zs = [2, 3, 1, 4, 5].
There is exactly one solution! Note that alldifferent/1 is not directly needed since nowhere is it stated that two persons are not allowed to end at precisely the same time. In fact, above proves that there is no shorter solution. #CapelliC's solution imposes an order, even if two persons finish ex aequo. But for the sake of compatibility, lets now map the solution back to your representation.
list_nth1(Es, N, E) :-
nth1(N, Es, E).
appleeatingorder(OrderedPeople) :-
appleeating_(Ends, Zs),
same_length(OrderedPeople, Ends),
labeling([], Zs), % not strictly needed
maplist(list_nth1(OrderedPeople), Ends,"abcde"). % effectively enforces alldifferent/1
?- appleeatingorder(OrderedPeople).
OrderedPeople = [c,a,b,d,e].
?- appleeatingorder(OrderedPeople).
OrderedPeople = "cabde".
The last solution using double quotes produces Scryer directly. In SWI use library(double_quotes).
(The extra argument Zs of appleeating_/2 is not strictly needed in this case, but it is a very useful convention for CLP predicates in general. It separates the modelling part (appleeating_/2) from the search part (labeling([], Zs)) such that you can easily try various versions for search/labeling at the same time. In order to become actually solved, all variables in Zs have to have an actual value.)
Let's correct finishbefore/3:
finishbefore(X, Y, L) :-
append(_, [X|R], L),
memberchk(Y, R).
then let's encode the known constraints:
check_finish_time(Order) :-
forall(
member(X<Y, [a<b,c<a, d<e,d<b]),
finishbefore(X,Y,Order)).
and now let's test all possible orderings
?- permutation([a,b,c,d,e],P),check_finish_time(P).
I get 9 solutions, backtracking with ;... maybe there are implicit constraints that should be encoded.
edit
Sorry for the noise, have found the bug. Swap the last constraint order, that is b<d instead of d<b, and now only 1 solution is allowed...

Sudoku solver performance problems

I have a problem with my prolog solver for sudoku. It's working, but the performance is reeaaaaly bad. With small ones it's working just fine, but bigger ones like 9x9 or more take 10 minutes or more sadly. I want to leave it for an indefinite size like it is right now. Can anyone help?
solve_sudoku(Rows,Sol):-
length(Rows,Max),
maplist(same_length(Rows),Rows),
append(Rows, List), List ins 1..Max,
maplist(all_distinct, Rows),
transpose(Rows, Columns),
maplist(all_distinct,Columns),
maplist(label,Rows),
boxes(Boxes,Rows),
maplist(all_distinct,Boxes),
boxes_distinct(Boxes),
Sol = Rows.
boxes(Bs,M) :-
length(M,Len),
Sq is round(sqrt(Len)),
findall(B, (between(1, Sq, R),
between(1, Sq, C),
block(M, Sq, R, C, B)), Bs).
cell(M, R,C, V) :-
nth1(R,M,Row), nth1(C,Row,V).
block(M, Sq, R,C, B) :-
findall(V, (between(1, Sq, X),
between(1, Sq, Y),
I is (R-1) * Sq + X,
J is (C-1) * Sq + Y,
cell(M, I, J, V)), B).
boxes_distinct([]).
boxes_distinct([BH|BT]):-
all_distinct(BH),
boxes_distinct(BT).
The input is a list of lists with the sudoku to solve and the output is the solved sudoku as a list.
I think you shoud call
maplist(label,Rows)
after
boxes_distinct(Boxes)
usually you should call label or labelling after declaring all constraint.
and use "labeling predicate with ff or ffc option" instead of "label"
may increse efficiency.
boxes_distinct(Boxes) seems useless, being already covered by maplist(all_distinct,Boxes), and use label(List) (instead of maplist(label,Rows)) near the end of clause. Anyway, the main problem has been indicated by #gabrielte (+1)

How to compare elements in dynamic

I have two dynamics of /2.
One of the lists, lets call it D2 has set values inside of it. For example: 2 and 3, 4 and 5.
How can I check if my dynamic 1 aka. D1 has all the values inside of it that D2 has and then return true if it does?
I tried to use
member(E, D1(_,_)), member(E, D2(_, _)). So far but without much luck.
This is pretty icky as far as data models go and whatever it is you're trying to do with this is going to at least be inefficient, if it can even be made to work. You'd be far better off defining an arity 3 fact with the first arg being an atom that identifies the type.
That said, you can probably do enough introspection to handle it.
dif(Q, P),
predicate_property(QR, dynamic),
predicate_property(PR, dynamic),
QR =.. [Q, _, _],
PR =.. [P, _, _].
This says, find me two predicates with arity 2, whose heads are different. Ideally, you want just the user-defined predicates. SWI-Prolog cannot do this, but GNU Prolog can, you could add some extra constraints:
predicate_property(QR, user),
predicate_property(PR, user),
This is my solution:
matching(Q, P) :-
dif(Q, P), % different predicates, please
predicate_property(QR, dynamic), % both dynamic
predicate_property(PR, dynamic),
QR =.. [Q, Q1, Q2], % arity-2 predicates, please
PR =.. [P, P1, P2],
findall([Q1, Q2], clause(QR, true), Qs), % find all facts (:- true)
findall([P1, P2], clause(PR, true), Ps),
forall(member(PV, Ps), member(PV, Qs)), % ensure the fact sets are equal
forall(member(QV, Qs), member(QV, Ps)).
Please, please, please DO NOT DO THIS!

How can you add elements to a list or compute them from the knowledge base without using findall or assert/retract in Prolog?

I have a knowledge base that consists of students database in a file 'students.pl' like this:
% student(Name,Percent,List_of_Marks_in_3_subjects).
student('abc',83,[80,80,90]).
student('pqr',70,[70,60,80]).
student('xyz',76,[80,70,80]).
I want to access each student predicate from the knowledge base and calculate the average marks in each subject or average percentage, without using 'findall' or assert/retract.
I may want to use backtracking like this:
find_score_all(X) :- student(Name,Percent,L),
write(Percent),nl,
fail.
find_score_all(_).
With this approach I can access each element and write it, but if I want to add each 'Percent' value as an element to a list or just use a predicate like 'Percent1 is Total + Percent' to total the percent values and then find its average, how can I do so?
Note that I dont want to use findall or retract/assert and preferably find the average in one pass through the knowledge base since the knowledge base is very large.
Any help is appreciated.
%solution for sum of percents, you can replace with any other calculation sum_percent predicate.
listing(student/3, convert_to_list/2, sum_percent, sum_percent/2).
% student(Name,Percent,List_of_Marks_in_3_subjects).
student('abc',83,[80,80,90]).
student('pqr',70,[70,60,80]).
student('xyz',76,[80,70,80]).
convert_to_list(X, R):-
student(N, P, LM),
not(member(st(N, P, LM), X)),
convert_to_list([st(N, P, LM)|X], R).
convert_to_list(X, X).
sum_percent:-
convert_to_list([], X),
sum_percent(X, S),
write(S).
sum_percent([], 0).
sum_percent([st(_,E,_)|T], S):-
sum_percent(T, S2),
S is E+S2.
if you want to add to a list then you should use findall, or better, library(aggregate). But if you fear about efficiency, you could use something like this
integrate(ave, Goal, Ave) :-
State = state(0, 0, _),
repeat,
( call(Goal, V),
arg(1, State, C), U is C+1, nb_setarg(1, State, U),
arg(2, State, S), T is S+V, nb_setarg(2, State, T),
fail
; arg(1, State, C), arg(2, State, S), Ave is S/C
).
:- meta_predicate integrate(+, :, ?).
test:
members(X) :- member(X, [1,2,3,4]).
?- integrate(ave, members, R).
R = 2.5 .
Of course, you'll need to add error handling (at least, when counter C == 0).

Resources