Related
I am new to this language and am having trouble coming up with a solution to this problem. The program must implement the following cases.
Both variables are instantiated:
pivot( [1,2,3,4,5,6,7], [5,6,7,4,1,2,3] ).`
yields a true/yes result.
Only Before is instantiated:
pivot( [1,2,3,4,5,6], R ).
unifies R = [4,5,6,1,2,3] as its one result.
Only After is instantiated:
pivot(L, [1,2]).
unifies L = [2,1] as its one result.
Neither variable is instantiated:
pivot(L, R).
is undefined (since results are generated arbitrarily).
If by pivot, you mean to split the list in 2 and swap the halves, then something like this would work.
First, consider the normal case: If you have an instantiated list, pivoting it is trivial. You just need to
figure out half the length of the list
break it up into
a prefix, consisting of that many items, and
a suffix, consisting of whatever is left over
concatenate those two lists in reverse order
Once you have that, everything else is just a matter of deciding which variable is bound and using that as the source list.
It is a common Prolog idiom to have a single "public" predicate that invokes a "private" worker predicate that does the actual work.
Given that the problem statement requires that at least one of the two variable in your pivot/2 must be instantiated, we can define our public predicate along these lines:
pivot( Ls , Rs ) :- nonvar(Ls), !, pivot0(Ls,Rs) .
pivot( Ls , Rs ) :- nonvar(Rs), !, pivot0(Rs,Ls) .
If Ls is bound, we invoke the worker, pivot0/2 with the arguments as-is. But if Ls is unbound, and Rs is bound, we invoke it with the arguments reversed. The cuts (!) are there to prevent the predicate from succeeding twice if invoked with both arguments bound (pivot([a,b,c],[a,b,c]).).
Our private helper, pivot0/2 is simple, because it knows that the 1st argument will always be bound:
pivot0( Ls , Rs ) :- % to divide a list in half and exchange the halves...
length(Ls,N0) , % get the length of the source list
N is N0 // 2 , % divide it by 2 using integer division
length(Pfx,N) , % construct a unbound list of the desired length
append(Pfx,Sfx,Ls) , % break the source list up into its two halves
append(Sfx,Pfx,Rs) % put the two halves back together in the desired order
. % Easy!
In swi-prolog:
:- use_module(library(dcg/basics)).
pivot_using_dcg3(Lst, LstPivot) :-
list_first(Lst, LstPivot, L1, L2, IsList),
phrase(piv3_up(L1), L1, L2),
% Improve determinism
(IsList = true -> ! ; true).
piv3_up(L), string(Ri), string(M), string(Le) --> piv3(L, Le, M, Ri).
piv3([], [], [], Ri) --> [], remainder(Ri).
piv3([_], [], [H], Ri) --> [H], remainder(Ri).
piv3([_, _|Lst], [H|T], M, Ri) --> [H], piv3(Lst, T, M, Ri).
% From 2 potential lists, rearrange them in order of usefulness
list_first(V1, V2, L1, L2, IsList) :-
( is_list(V1) ->
L1 = V1, L2 = V2,
IsList = true
; L1 = V2, L2 = V1,
(is_list(L1) -> IsList = true ; IsList = false)
).
Is general and deterministic, with good performance:
?- time(pivot_using_dcg3(L, P)).
% 18 inferences, 0.000 CPU in 0.000 seconds (88% CPU, 402441 Lips)
L = P, P = [] ;
% 8 inferences, 0.000 CPU in 0.000 seconds (86% CPU, 238251 Lips)
L = P, P = [_] ;
% 10 inferences, 0.000 CPU in 0.000 seconds (87% CPU, 275073 Lips)
L = [_A,_B],
P = [_B,_A] ;
% 10 inferences, 0.000 CPU in 0.000 seconds (94% CPU, 313391 Lips)
L = [_A,_B,_C],
P = [_C,_B,_A] ;
% 12 inferences, 0.000 CPU in 0.000 seconds (87% CPU, 321940 Lips)
L = [_A,_B,_C,_D],
P = [_C,_D,_A,_B] ;
% 12 inferences, 0.000 CPU in 0.000 seconds (86% CPU, 345752 Lips)
L = [_A,_B,_C,_D,_E],
P = [_D,_E,_C,_A,_B] ;
% 14 inferences, 0.000 CPU in 0.000 seconds (88% CPU, 371589 Lips)
L = [_A,_B,_C,_D,_E,_F],
P = [_D,_E,_F,_A,_B,_C] ;
?- numlist(1, 5000000, P), time(pivot_using_dcg3(L, P)).
% 7,500,018 inferences, 1.109 CPU in 1.098 seconds (101% CPU, 6759831 Lips)
The performance could be improved further, using difference lists for the final left-middle-right append, and cuts (sacrificing generality).
We want to count the correspondences between two (possibly long) strings which happen to represent DNA sequences. The sequences are lists-of-chars where the char is taken from a,c,t,g,'_', with the '_' a "don't know" placeholder which never corresponds to anything, even itself. In this case, we employ library(aggregate) (thanks to CapelliC for the idea):
match(Seq1,Seq2,Count) :-
aggregate_all(count,
(
nth1(Pos,Seq1,X),
nth1(Pos,Seq2,X),
memberchk(X,[a,c,g,t])
),
N).
This approach can be compared to a "straightforward" approach where one would set up a (tail-recursive) recursion that just walks down both sequences in tandem and compares elements pairwise, counting as it goes.
As the sequences can be very large, algorithmic complexity becomes of some interest.
One would expect, with n = length(sequence) and both sequences the same length:
Straightforward approach: complexity is O(n)
aggregation approach: complexity is O(n²)
What is the (time and maybe space) complexity of the above algorithm and why?
Test code
To complement the above, an SWI-Prolog based plunit test code block:
:- begin_tests(atcg).
wrap_match(String1,String2,Count) :-
atom_chars(String1,Seq1),
atom_chars(String2,Seq2),
fit(Seq1,Seq1,0,Count).
test("string 1 empty",nondet) :-
wrap_match("atcg","",Count),
assertion(Count == 0).
test("string 2 empty") :-
wrap_match("","atcg",Count),
assertion(Count == 0).
test("both strings empty") :-
wrap_match("","",Count),
assertion(Count == 0).
test("both strings match, 1 char only") :-
wrap_match("a","a",Count),
assertion(Count == 1).
test("both strings match") :-
wrap_match("atcgatcgatcg","atcgatcgatcg",Count),
assertion(MatchCount == 12).
test("both strings match with underscores") :-
wrap_match("_TC_ATCG_TCG","_TC_ATCG_TCG",Count),
assertion(MatchCount == 9).
test("various mismatches 1") :-
wrap_match("atcgatcgatcg","atcgatcgatcg",Count),
assertion(MatchCount == 8).
test("various mismatches with underscores") :-
wrap_match("at_ga_cg__cg","atcgatcgatcg",Count),
assertion(Count == 8).
:- end_tests(atcg).
And so:
?- run_tests.
% PL-Unit: atcg ........ done
% All 8 tests passed
true.
Empirical info
After some manual data collection (something that cries out for automatization) using the code below, which outputs time elapsed and number of inferences made to the console:
gimme_random_sequence(Length,Seq) :-
length(Seq,Length),
maplist(
[E]>>(random_between(0,3,Ix),nth0(Ix,[a,t,c,g],E)),
Seq).
how_fast(Length) :-
gimme_random_sequence(Length,Seq1),
gimme_random_sequence(Length,Seq2),
time(match(Seq1,Seq2,_)).
... and a bit of graph fumbling in LibreOffice Calc (my ggplot skills are rusty), we have empirical data that this algorithm's cost is
O((length(sequence))²).
Count,Inferences,Seconds,milliseconds,megainferences
1000,171179,0.039,39,0.171179
2000,675661,0.097,97,0.675661
3000,1513436,0.186,186,1.513436
4000,2684639,0.327,327,2.684639
5000,4189172,0.502,502,4.189172
6000,6027056,0.722,722,6.027056
7000,8198103,1.002,1002,8.198103
8000,10702603,1.304,1304,10.702603
9000,13540531,1.677,1677,13.540531
10000,16711607,2.062,2062,16.711607
11000,20216119,2.449,2449,20.216119
20000,66756619,8.091,8091,66.756619
30000,150134731,17.907,17907,150.134731
40000,266846773,32.012,32012,266.846773
50000,416891749,52.942,52942,416.891749
60000,600269907,74.103,74103,600.269907
Never ever use functional programming idioms in Prolog that avoid backtracking, like maplist/4. This here, pair_member/4 and match3/3, should be a tick faster.
match2(Seq1, Seq2, Count) :-
( maplist([X,Y,X-Y]>>true, Seq1, Seq2, Seq3)
-> aggregate_all(count, (member(X-X, Seq3), X\='_'), Count)
; Count = 0 ).
pair_member(X, Y, [X|_], [Y|_]).
pair_member(X, Y, [_|L], [_|R]) :-
pair_member(X, Y, L, R).
match3(Seq1, Seq2, Count) :-
aggregate_all(count,
(pair_member(X, X, Seq1, Seq2), X \= '_'), Count).
gimme_random_sequence(Length, Seq) :-
length(Seq, Length),
maplist([E]>>(random_between(0,3,Ix), nth0(Ix, [a,t,c,g], E)), Seq).
test(N) :-
gimme_random_sequence(N, S1),
gimme_random_sequence(N, S2),
time(match2(S1, S2, Count)),
time(match3(S1, S2, Count)).
Woa! Its 10x times faster! Thanks to genius of SWI-Prolog how it
compiles the tail recursion in pair_member/4:
/* SWI-Prolog 8.3.21, MacBook Air 2019 */
?- set_prolog_flag(double_quotes, chars).
true.
?- X = "abc".
X = [a, b, c].
?- match2("_TC_ATCG_TCG","_TC_ATCG_TCG",Count).
Count = 9.
?- match3("_TC_ATCG_TCG","_TC_ATCG_TCG",Count).
Count = 9.
?- test(100000).
% 1,575,520 inferences, 0.186 CPU in 0.190 seconds (98% CPU, 8465031 Lips)
% 175,519 inferences, 0.018 CPU in 0.019 seconds (98% CPU, 9577595 Lips)
true.
Edit 29.04.2021:
Oh the irony, bifurcation backtracking is nevertheless challenging.
After fixing a misuse of library(apply_macros), I get:
?- test(100000).
% 374,146 inferences, 0.019 CPU in 0.019 seconds (99% CPU, 19379778 Lips)
% 174,145 inferences, 0.014 CPU in 0.014 seconds (99% CPU, 12400840 Lips)
true.
Does native member/2 contribute to the good maplist solution performance?
But I should do a better measure, with larger times durations.
Open Source:
Sequence Match Problem
https://gist.github.com/jburse/9fd22e8c3e8de6148fbd341817538ef6#file-sequence-pl
I think that it is interresting to observe that complexity O(n²) is not due to the aggregation approach itself, but to the fact that subgoal nth1(Pos,Seq1,X), nth1(Pos,Seq2,X) behaves as a "nested loop" (in the size n of the sequences).
Thus, it should be possible to create another algorithm that, even using aggregation, can have complexity O(n), as long as the "nested loop" is eliminated.
Algorithms to compare
% Original algorithm: Complexity O(n²)
match1(Seq1, Seq2, Count) :-
aggregate_all(count,
( nth1(Pos, Seq1, X),
nth1(Pos, Seq2, X),
memberchk(X, [a,c,g,t]) ),
Count).
% Proposed algorithm: Complexity O(n)
match2(Seq1, Seq2, Count) :-
( maplist([X,Y,X-Y]>>true, Seq1, Seq2, Seq3)
-> aggregate_all(count, (member(X-X, Seq3), X\='_'), Count)
; Count = 0 ).
gimme_random_sequence(Length, Seq) :-
length(Seq, Length),
maplist([E]>>(random_between(0,3,Ix), nth0(Ix, [a,t,c,g], E)), Seq).
test(N) :-
gimme_random_sequence(N, S1),
gimme_random_sequence(N, S2),
time(match1(S1, S2, Count)),
time(match2(S1, S2, Count)).
Simple empirical results
?- test(10000).
% 16,714,057 inferences, 1.156 CPU in 1.156 seconds (100% CPU, 14455401 Lips)
% 39,858 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.
?- test(20000).
% 66,761,535 inferences, 4.594 CPU in 4.593 seconds (100% CPU, 14533123 Lips)
% 79,826 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 5108864 Lips)
true.
?- test(40000).
% 266,856,213 inferences, 19.734 CPU in 19.841 seconds (99% CPU, 13522405 Lips)
% 159,398 inferences, 0.016 CPU in 0.015 seconds (104% CPU, 10201472 Lips)
true.
?- test(80000).
% 1,067,046,835 inferences, 77.203 CPU in 77.493 seconds (100% CPU, 13821291 Lips)
% 320,226 inferences, 0.047 CPU in 0.047 seconds (100% CPU, 6831488 Lips)
true.
Edit 30/04/2021:
Does nth1(I,S,X), nth1(I,S,X) really work as nested loop?
To see that the answer to this question is yes, consider the following simple implementation of nth/3, that counts the number of rounds needed to find each solution, using a global flag:
nth(Index, List, Item) :-
( var(Index)
-> nth_nondet(1, Index, List, Item)
; integer(Index)
-> nth_det(Index, List, Item)
).
nth_det(1, [Item|_], Item) :- !.
nth_det(Index, [_|Rest], Item) :-
flag(rounds, Rounds, Rounds+1),
Index1 is Index - 1,
nth_det(Index1, Rest, Item).
nth_nondet(Index, Index, [Item|_], Item).
nth_nondet(Acc, Index, [_|Rest], Item) :-
flag(rounds, Rounds, Rounds+1),
Acc1 is Acc + 1,
nth_nondet(Acc1, Index, Rest, Item).
To get the number of rounds, you can ask:
?- flag(rounds,_,0), nth(5,[a,b,c,d,e],X), flag(rounds,Rounds,Rounds).
X = e,
Rounds = 4.
Now, using this predicate, we can create a predicate to count the number of rounds of the goal nth(I,L,X), nth(I,L,X), for lists of different lengths:
count_rounds :-
forall(between(1, 10, N),
( Length is 10*N,
count_rounds(Length, Rounds),
writeln(rounds(Length) = Rounds)
)).
count_rounds(Length, _) :-
numlist(1, Length, List),
flag(rounds, _, 0),
nth(Index, List, Item),
nth(Index, List, Item),
fail.
count_rounds(_, Rounds) :-
flag(rounds, Rounds, Rounds).
Empirical results:
?- count_rounds.
rounds(10) = 55
rounds(20) = 210
rounds(30) = 465
rounds(40) = 820
rounds(50) = 1275
rounds(60) = 1830
rounds(70) = 2485
rounds(80) = 3240
rounds(90) = 4095
rounds(100) = 5050
As we can see, the goal nth(I,L,X), nth(I,L,X) computes half of a square matrix of order n (including its diagonal). Thus, the number of rounds for a list of length n is rounds(n) = (n² + n)/2. Hence, the time complexity of this goal is O(n²).
Remark The implementation of the library predicate nth1/3 is a little more efficient than that of predicate nth/3considered for this experiment. Nevertheless, the time complexity of goal nth1(I,S,X), nth1(I,S,X)still is O(n²).
This is a followup of #MostowskiCollapse answer, where I have applied the same optimization that Gertjan van Noord provided for member/2 to pair_member/4, but I have renamed it to member/4.
member(X, Y, [XH|XT], [YH|YT]) :-
member_(XT, YT, X, Y, XH, YH).
member_(_, _, X,Y, X,Y).
member_([XH|XT],[YH|YT], X,Y, _,_) :-
member_(XT,YT, X,Y, XH,YH).
match4(Seq1, Seq2, Count) :-
aggregate_all(count,
(member(X, X, Seq1, Seq2), X \= '_'), Count).
test(N) :-
gimme_random_sequence(N, S1),
gimme_random_sequence(N, S2),
%time(match2(S1, S2, Count)),
time(match3(S1, S2, Count)),
time(match4(S1, S2, Count)).
...
with lists of length 1.000.000 I get
% 1,751,758 inferences, 0.835 CPU in 0.835 seconds (100% CPU, 2098841 Lips)
% 1,751,757 inferences, 0.637 CPU in 0.637 seconds (100% CPU, 2751198 Lips)
that is, a gain of about 25%...
I am trying to find a sequence of steps from the starting board below to a solved state.
[[x,x,x,x,x],
[x,x,x,x,x],
[x,x,o,x,x],
[x,x,x,x,x],
[x,x,x,x,x]]
However, it takes a very long time. I have left my program running for 5 hours and have still not found a solution. Is there any way I can optimize this?
:- use_module(library(clpfd)).
rotate_clock(Xss, Zss) :-
transpose(Xss, Yss),
maplist(reverse, Yss, Zss).
rotate_anti(Xss, Zss) :-
maplist(reverse, Xss, Yss),
transpose(Yss, Zss).
linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).
horizjmp([A|T],[B|T]) :- linjmp(A,B).
horizjmp([H|T1],[H|T2]) :- horizjmp(T1,T2).
jump(B,A) :- horizjmp(B,A).
jump(B,A) :- rotate_clock(B,BR), horizjmp(BR,BRJ), rotate_anti(BRJ, A).
num_x(A, C) :- count(A, x, C).
count([],X,0).
count([X|T],X,Y):- count(T,X,Z), Y is 1+Z.
count([H|T],X,Z):- dif(H, X), count(T,X,Z).
sum_list([], 0).
sum_list([H|T], Sum) :-
sum_list(T, Rest),
Sum is H + Rest.
solved(A) :-
maplist(num_x, A, B),
sum_list(B, C),
C == 1.
jumps([B1, B2 | []]) :-
jump(B1, B2),
solved(B2).
jumps([B1, B2 | Bs]) :-
jump(B1, B2),
jumps([B2 | Bs]).
?- jumps([[[x,x,x,x,x], [x,x,x,x,x], [x,x,o,x,x], [x,x,x,x,x], [x,x,x,x,x]]|X]), write(X), !.
Nice puzzle, 2 dimensional constraints are worth to try, even if I think, from what I read, there could be no solution...
Your code is a rather naive brute force solver. Calling transpose/2 (twice!) at every search tree node just to test a vertical pattern sounds overkill.
I'll show my attempt, starting from 'symbolic processing' (and brute force, like yours :) to model the problem.
solve_brute_force(S) :-
build(at(3,3,o),x,I),
/* uncomment to test...
I=[[x,x,x,x,x],
[x,x,x,x,x],
[x,x,o,x,x],
[x,x,x,x,x],
[x,x,x,x,x]],
*/
% try all...
% between(1,5,P),between(1,5,Q),build(at(P,Q,x),o,F),
% or just a specific pattern
build(at(2,4,x),o,F),
steps(I,F,S).
steps(F,F,[F]).
steps(A,F,[A|R]) :-
step(A,B), %show(B),
steps(B,F,R).
step(A,B) :-
append(L,[R|Rs],A),
hmove(R,U),
append(L,[U|Rs],B).
step(A,B) :-
append(L,[U0,V0,Z0|Rs],A),
vmove(U0,V0,Z0, U2,V2,Z2),
append(L,[U2,V2,Z2|Rs],B).
hmove(R,U) :-
append(Rl,[x,x,o|Rr],R),
append(Rl,[o,o,x|Rr],U).
hmove(R,U) :-
append(Rl,[o,x,x|Rr],R),
append(Rl,[x,o,o|Rr],U).
vmove(U0,V0,Z0, U2,V2,Z2) :-
nth0(C,U0,x,U1),nth0(C,V0,x,V1),nth0(C,Z0,o,Z1),!,
nth0(C,U2,o,U1),nth0(C,V2,o,V1),nth0(C,Z2,x,Z1).
vmove(U0,V0,Z0, U2,V2,Z2) :-
nth0(C,U0,o,U1),nth0(C,V0,x,V1),nth0(C,Z0,x,Z1),!,
nth0(C,U2,x,U1),nth0(C,V2,o,V1),nth0(C,Z2,o,Z1).
/*
at_least_2([R|Rs],C,S) :-
aggregate_all(count,member(S,R),T),
U is C+T,
( U >= 2 -> true ; at_least_2(Rs,U,S) ).
count(B,S,N) :-
aggregate_all(sum(Xs),
(member(R,B), aggregate_all(count, member(S,R), Xs)),
N).
*/
build(Cx,Cy,at(X,Y,A),B,P) :-
findall(Rs,(between(1,Cy,R),
findall(S,(between(1,Cx,C),
(R=Y,C=X -> S=A ; S=B)), Rs)), P).
build(A_at,B,P) :-
build(5,5,A_at,B,P).
Sorry, it doesn't terminate... but it gives us a small set of tools we can use to better understand the problem.
Did you noticed that every step there will be a peg less ?
Then, we can avoid counting pegs, and this is my better hint for optimization so far.
solve(S,R) :-
build(at(3,3,o),x,I),
steps_c(I,24,R,S).
steps_c(F,N,N,[F]).
steps_c(A,C,N,[A|R]) :-
step(A,B), % to debug... show(B),
succ(D,C), % or D is C-1,
steps_c(B,D,N,R).
Alas, it will not help too much: now we can choice the 'solution' level:
?- time(solve(S,3)),maplist([T]>>(maplist(writeln,T),nl),S).
% 155,322 inferences, 0.110 CPU in 0.111 seconds (99% CPU, 1411851 Lips)
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,o,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
[o,o,x,x,x]
[x,x,x,x,x]
[x,x,x,x,x]
...
Let's evaluate some solutions with 3 poles left:
?- time(call_nth(solve(S,3),1000)).
% 4,826,178 inferences, 2.913 CPU in 2.914 seconds (100% CPU, 1656701 Lips)
S = [[[x, x, x, x, x], ....
?- time(call_nth(solve(S,3),10000)).
% 53,375,354 inferences, 31.968 CPU in 31.980 seconds (100% CPU, 1669646 Lips)
S = [[[x, x, x, x, x],
We have about 5K inferences / solution at level 3. But it's clear there are a lot of them. So, it's hopeless to attempt ?- solve(S, 1). This brute force approach doesn't work...
Maybe I will try using better problem domain encoding, and modelling with library(clpfd).
I am doing this problem but I am completely new to Prolog and I have no idea how to do it.
Nine parts of an electronic board have square shape, the same size and each edge of every part is marked with a letter and a plus or minus sign. The parts are to be assembled into a complete board as shown in the figure below such that the common edges have the same letter and opposite signs. Write a planner in Prolog such that the program takes 'assemble' as the query and outputs how to assemble the parts, i.e. determine the locations and positions of the parts w.r.t. the current positions so that they fit together to make the complete board.
I have tried solving it and I have written the following clauses:
complement(a,aNeg).
complement(b,bNeg).
complement(c,cNeg).
complement(d,dNeg).
complement(aNeg,a).
complement(bNeg,b).
complement(cNeg,c).
complement(dNeg,d).
% Configuration of boards, (board,left,top,right,bottom)
conf(b1,aNeg,bNeg,c,d).
conf(b2,bNeg,a,d,cNeg).
conf(b3,dNeg,cNeg,b,d).
conf(b4,b,dNeg,cNeg,d).
conf(b5,d,b,cNeg,aNeg).
conf(b6,b,aNeg,dNeg,c).
conf(b7,aNeg,bNeg,c,b).
conf(b8,b,aNeg,cNeg,a).
conf(b9,cNeg,bNeg,a,d).
position(b1,J,A).
position(b2,K,B).
position(b3,L,C).
position(b4,M,D).
position(b5,N,E).
position(b6,O,F).
position(b7,P,G).
position(b8,Q,H).
position(b9,R,I).
assemble([A,B,C,E,D,F,G,H,I,J,K,L,M,N,O,P,Q,R]) :-
Variables=[(A,J),(B,K),(C,L),(D,M),(E,N),(F,O),(G,P),(H,Q),(I,R)],
all_different(Variables),
A in 1..3, B in 1..3, C in 1..3, D in 1..3, E in 1..3,
F in 1..3, G in 1..3, H in 1..3, I in 1..3, J in 1..3,
K in 1..3, L in 1..3, M in 1..3, N in 1..3, O in 1..3,
P in 1..3, Q in 1..3, R in 1..3,
% this is where I am stuck, what to write next
I don't know even if they are correct and I am not sure how to proceed further to solve this problem.
Trivial with CLP(FD):
:- use_module(library(clpfd)).
board(Board) :-
Board = [[A1,A2,A3],
[B1,B2,B3],
[C1,C2,C3]],
maplist(top_bottom, [A1,A2,A3], [B1,B2,B3]),
maplist(top_bottom, [B1,B2,B3], [C1,C2,C3]),
maplist(left_right, [A1,B1,C1], [A2,B2,C2]),
maplist(left_right, [A2,B2,C2], [A3,B3,C3]),
pieces(Ps),
maplist(board_piece(Board), Ps).
top_bottom([_,_,X,_], [Y,_,_,_]) :- X #= -Y.
left_right([_,X,_,_], [_,_,_,Y]) :- X #= -Y.
pieces(Ps) :-
Ps = [[-2,3,4,-1], [1,4,-3,-4], [-3,2,4,-4],
[-4,-3,4,2], [2,-3,-1,4], [-1,-4,3,2],
[-2,3,2,-1], [-1,-3,1,2], [-2,1,4,-3]].
board_piece(Board, Piece) :-
member(Row, Board),
member(Piece0, Row),
rotation(Piece0, Piece).
rotation([A,B,C,D], [A,B,C,D]).
rotation([A,B,C,D], [B,C,D,A]).
rotation([A,B,C,D], [C,D,A,B]).
rotation([A,B,C,D], [D,A,B,C]).
Example query and its result:
?- time(board(Bs)), maplist(writeln, Bs).
11,728,757 inferences, 0.817 CPU in 0.817 seconds
[[-3, -4, 1, 4], [-1, -2, 3, 4], [4, -4, -3, 2]]
[[-1, 4, 2, -3], [-3, 4, 2, -4], [3, 2, -1, -4]]
[[-2, 1, 4, -3], [-2, 3, 2, -1], [1, 2, -1, -3]]
This representation uses 1,2,3,4 to denote positive a,b,c,d, and -1,-2,-3,-4 for the negative ones.
This is only a tiny improvement to #mat's beautiful solution. The idea is to reconsider the labeling process. That is maplist(board_piece,Board,Ps) which reads (semi-procedurally):
For all elements in Ps, thus for all pieces in that order: Take one piece and place it anywhere on the board rotated or not.
This means that each placement can be done in full liberty. To show you a weak order, one might take: A1,A3,C1,C3,B2 and then the rest. In this manner, the actual constraints are not much exploited.
However, there seems to be no good reason that the second tile is not placed in direct proximity to the first. Here is such an improved order:
...,
pieces(Ps),
TilesOrdered = [B2,A2,A3,B3,C3,C2,C1,B1,A1],
tiles_withpieces(TilesOrdered, Ps).
tiles_withpieces([], []).
tiles_withpieces([T|Ts], Ps0) :-
select(P,Ps0,Ps1),
rotation(P, T),
tiles_withpieces(Ts, Ps1).
Now, I get
?- time(board(Bs)), maplist(writeln, Bs).
% 17,179 inferences, 0.005 CPU in 0.005 seconds (99% CPU, 3363895 Lips)
[[-3,1,2,-1],[-2,3,2,-1],[2,4,-4,-3]]
[[-2,1,4,-3],[-2,3,4,-1],[4,2,-4,-3]]
[[-4,3,2,-1],[-4,1,4,-3],[4,2,-3,-1]]
and without the goal maplist(maplist(tile), Board),
% 11,010 inferences, 0.003 CPU in 0.003 seconds (100% CPU, 3225961 Lips)
and to enumerate all solutions
?- time((setof(Bs,board(Bs),BBs),length(BBs,N))).
% 236,573 inferences, 0.076 CPU in 0.154 seconds (49% CPU, 3110022 Lips)
BBs = [...]
N = 8.
previously (#mat's original version) the first solution took:
% 28,874,632 inferences, 8.208 CPU in 8.217 seconds (100% CPU, 3518020 Lips)
and all solutions:
% 91,664,740 inferences, 25.808 CPU in 37.860 seconds (68% CPU, 3551809 Lips)
In terms of performance, the following is no contender to #false's very fast solution.
However, I would like to show you a different way to formulate this, so that you can use the constraint solver to approximate the faster allocation strategy that #false found manually:
:- use_module(library(clpfd)).
board(Board) :-
Board = [[A1,A2,A3],
[B1,B2,B3],
[C1,C2,C3]],
maplist(top_bottom, [A1,A2,A3], [B1,B2,B3]),
maplist(top_bottom, [B1,B2,B3], [C1,C2,C3]),
maplist(left_right, [A1,B1,C1], [A2,B2,C2]),
maplist(left_right, [A2,B2,C2], [A3,B3,C3]),
pieces(Ps0),
foldl(piece_with_id, Ps0, Pss, 0, _),
append(Pss, Ps),
append(Board, Bs0),
maplist(tile_with_var, Bs0, Bs, Vs),
all_distinct(Vs),
tuples_in(Bs, Ps).
tile_with_var(Tile, [V|Tile], V).
top_bottom([_,_,X,_], [Y,_,_,_]) :- X #= -Y.
left_right([_,X,_,_], [_,_,_,Y]) :- X #= -Y.
pieces(Ps) :-
Ps = [[-2,3,4,-1], [1,4,-3,-4], [-3,2,4,-4],
[-4,-3,4,2], [2,-3,-1,4], [-1,-4,3,2],
[-2,3,2,-1], [-1,-3,1,2], [-2,1,4,-3]].
piece_with_id(P0, Ps, N0, N) :-
findall(P, (rotation(P0,P1),P=[N0|P1]), Ps),
N #= N0 + 1.
rotation([A,B,C,D], [A,B,C,D]).
rotation([A,B,C,D], [B,C,D,A]).
rotation([A,B,C,D], [C,D,A,B]).
rotation([A,B,C,D], [D,A,B,C]).
You can now use the "first fail" strategy of CLP(FD) and try the most constrained elements first. With this formulation, the time needed to find all 8 solutions is:
?- time(findall(t, (board(B), term_variables(B, Vs), labeling([ff],Vs)), Ts)).
2,613,325 inferences, 0.208 CPU in 0.208 seconds
Ts = [t, t, t, t, t, t, t, t].
In addition, I would like to offer the following contender for the speed contest, which I obtained with an extensive partial evaluation of the original program:
solution([[[-4,-3,2,4],[2,-1,-4,3],[2,-1,-3,1]],[[-2,3,4,-1],[4,2,-4,-3],[3,2,-1,-2]],[[-4,1,4,-3],[4,2,-3,-1],[1,4,-3,-2]]]).
solution([[[-3,-4,1,4],[-1,-2,3,4],[4,-4,-3,2]],[[-1,4,2,-3],[-3,4,2,-4],[3,2,-1,-4]],[[-2,1,4,-3],[-2,3,2,-1],[1,2,-1,-3]]]).
solution([[[-3,-2,1,4],[-3,-1,4,2],[4,-3,-4,1]],[[-1,-2,3,2],[-4,-3,4,2],[4,-1,-2,3]],[[-3,1,2,-1],[-4,3,2,-1],[2,4,-4,-3]]]).
solution([[[-3,1,2,-1],[-2,3,2,-1],[2,4,-4,-3]],[[-2,1,4,-3],[-2,3,4,-1],[4,2,-4,-3]],[[-4,3,2,-1],[-4,1,4,-3],[4,2,-3,-1]]]).
solution([[[-3,-1,4,2],[4,-3,-4,1],[2,-1,-4,3]],[[-4,-3,4,2],[4,-1,-2,3],[4,-3,-2,1]],[[-4,-3,2,4],[2,-1,-2,3],[2,-1,-3,1]]]).
solution([[[-1,-3,1,2],[2,-1,-2,3],[4,-3,-2,1]],[[-1,-4,3,2],[2,-4,-3,4],[2,-3,-1,4]],[[-3,2,4,-4],[3,4,-1,-2],[1,4,-3,-4]]]).
solution([[[-1,-4,3,2],[-3,-2,1,4],[-1,-3,1,2]],[[-3,-4,1,4],[-1,-2,3,4],[-1,-2,3,2]],[[-1,4,2,-3],[-3,4,2,-4],[-3,2,4,-4]]]).
solution([[[4,-4,-3,2],[2,-4,-3,4],[2,-3,-1,4]],[[3,2,-1,-2],[3,4,-1,-2],[1,4,-3,-4]],[[1,2,-1,-3],[1,4,-3,-2],[3,2,-1,-4]]]).
The 8 solutions are found very rapidly with this formulation:
?- time(findall(t, solution(B), Ts)).
19 inferences, 0.000 CPU in 0.000 seconds
Ts = [t, t, t, t, t, t, t, t].
While reading SICP I came across logic programming chapter 4.4. Then I started looking into the Prolog programming language and tried to understand some simple assignments in Prolog. I found that Prolog seems to have troubles with numerical calculations.
Here is the computation of a factorial in standard Prolog:
f(0, 1).
f(A, B) :- A > 0, C is A-1, f(C, D), B is A*D.
The issues I find is that I need to introduce two auxiliary variables (C and D), a new syntax (is) and that the problem is non-reversible (i.e., f(5,X) works as expected, but f(X,120) does not).
Naively, I expect that at the very least C is A-1, f(C, D) above may be replaced by f(A-1,D), but even that does not work.
My question is: Why do I need to do this extra "stuff" in numerical calculations but not in other queries?
I do understand (and SICP is quite clear about it) that in general information on "what to do" is insufficient to answer the question of "how to do it". So the declarative knowledge in (at least some) math problems is insufficient to actually solve these problems. But that begs the next question: How does this extra "stuff" in Prolog help me to restrict the formulation to just those problems where "what to do" is sufficient to answer "how to do it"?
is/2 is very low-level and limited. As you correctly observe, it cannot be used in all directions and is therefore not a true relation.
For reversible arithmetic, use your Prolog system's constraint solvers.
For example, SWI-Prolog's CLP(FD) manual contains the following definition of n_factorial/2:
:- use_module(library(clpfd)).
n_factorial(0, 1).
n_factorial(N, F) :- N #> 0, N1 #= N - 1, F #= N * F1, n_factorial(N1, F1).
The following example queries show that it can be used in all directions:
?- n_factorial(47, F).
F = 258623241511168180642964355153611979969197632389120000000000 ;
false.
?- n_factorial(N, 1).
N = 0 ;
N = 1 ;
false.
?- n_factorial(N, 3).
false.
Of course, this definition still relies on unification, and you can therefore not plug in arbitrary integer expressions. A term like 2-2 (which is -(2,2) in prefix notation) does not unfiy with 0. But you can easily allow this if you rewrite this to:
:- use_module(library(clpfd)).
n_factorial(N, F) :- N #= 0, F #= 1.
n_factorial(N, F) :- N #> 0, N1 #= N - 1, F #= N * F1, n_factorial(N1, F1).
Example query and its result:
?- n_factorial(2-2, -4+5).
true .
Forget about variables and think that A and B - is just a name for value which can be placed into that clause (X :- Y). to make it reachable. Think about X = (2 + (3 * 4)) in the way of data structures which represent mathematical expression. If you will ask prolog to reach goal f(A-1, B) it will try to find such atom f(A-1,B). or a rule (f(A-1,B) :- Z), Z. which will be unified to "success".
is/2 tries to unify first argument with result of interpreting second argument as an expression. Consider eval/2 as variant of is/2:
eval(0, 1-1). eval(0, 2-2). eval(1,2-1).
eval(Y, X-0):- eval(Y, X).
eval(Y, A+B):- eval(ValA, A), eval(ValB, B), eval(Y, ValA + ValB).
eval(4, 2*2).
eval(0, 0*_). eval(0, _*0).
eval(Y, X*1):- eval(Y, X).
eval(Y, 1*X):- eval(Y, X).
eval(Y, A*B):- eval(ValA, A), eval(ValB, B), eval(Y, ValA * ValB).
The reason why f(X,120) doesn't work is simple >/2 works only when its arguments is bound (i.e. you can't compare something not yet defined like X with anything else). To fix that you have to split that rule into:
f(A,B) :- nonvar(A), A > 0, C is A-1, f(C, D), B is A*D.
f(A,B) :- nonvar(B), f_rev(A, B, 1, 1).
% f_rev/4 - only first argument is unbound.
f_rev(A, B, A, B). % solution
f_rev(A, B, N, C):- C < B, NextN is (N+1), NextC is (C*NextN), f_rev(A, B, NextN, NextC).
Update: (fixed f_rev/4)
You may be interested in finite-domain solver. There was a question about using such things. By using #>/2 and #=/2 you can describe some formula and restrictions and then resolve them. But these predicates uses special abilities of some prolog systems which allows to associate name with some attributes which may help to narrow set of possible values by intersection of restriction. Some other systems (usually the same) allows you to reorder sequence of processing goals ("suspend").
Also member(X,[1,2,3,4,5,6,7]), f(X, 120) is probably doing the same thing what your "other queries" do.
If you are interested in logical languages in general you may also look at Curry language (there all non-pure functions is "suspended" until not-yed-defined value is unified).
In this answer we use clpfd, just like this previous answer did.
:- use_module(library(clpfd)).
For easy head-to-head comparison (later on), we call the predicate presented here n_fac/2:
n_fac(N_expr,F_expr) :-
N #= N_expr, % eval arith expr
F #= F_expr, % eval arith expr
n_facAux(N,F).
Like in this previous answer, n_fac/2 admits the use of arithmetic expressions.
n_facAux(0,1). % 0! = 1
n_facAux(1,1). % 1! = 1
n_facAux(2,2). % 2! = 2
n_facAux(N,F) :-
N #> 2,
F #> N, % redundant constraint
% to help `n_fac(N,N)` terminate
n0_n_fac0_fac(3,N,6,F). % general case starts with "3! = 6"
The helper predicate n_facAux/2 delegates any "real" work to n0_n_fac0_fac/4:
n0_n_fac0_fac(N ,N,F ,F).
n0_n_fac0_fac(N0,N,F0,F) :-
N0 #< N,
N1 #= N0+1, % count "up", not "down"
F1 #= F0*N1, % calc `1*2*...*N`, not `N*(N-1)*...*2*1`
F1 #=< F, % enforce redundant constraint
n0_n_fac0_fac(N1,N,F1,F).
Let's compare n_fac/2 and n_factorial/2!
?- n_factorial(47,F).
F = 258623241511168180642964355153611979969197632389120000000000
; false.
?- n_fac(47,F).
F = 258623241511168180642964355153611979969197632389120000000000
; false.
?- n_factorial(N,1).
N = 0
; N = 1
; false.
?- n_fac(N,1).
N = 0
; N = 1
; false.
?- member(F,[3,1_000_000]), ( n_factorial(N,F) ; n_fac(N,F) ).
false. % both predicates agree
OK! Identical, so far... Why not do a little brute-force testing?
?- time((F1 #\= F2,n_factorial(N,F1),n_fac(N,F2))).
% 57,739,784 inferences, 6.415 CPU in 7.112 seconds (90% CPU, 9001245 Lips)
% Execution Aborted
?- time((F1 #\= F2,n_fac(N,F2),n_factorial(N,F1))).
% 52,815,182 inferences, 5.942 CPU in 6.631 seconds (90% CPU, 8888423 Lips)
% Execution Aborted
?- time((N1 #> 1,N2 #> 1,N1 #\= N2,n_fac(N1,F),n_factorial(N2,F))).
% 99,463,654 inferences, 15.767 CPU in 16.575 seconds (95% CPU, 6308401 Lips)
% Execution Aborted
?- time((N1 #> 1,N2 #> 1,N1 #\= N2,n_factorial(N2,F),n_fac(N1,F))).
% 187,621,733 inferences, 17.192 CPU in 18.232 seconds (94% CPU, 10913552 Lips)
% Execution Aborted
No differences for the first few hundred values of N in 2..sup... Good!
Moving on: How about the following (suggested in a comment to this answer)?
?- n_factorial(N,N), false.
false.
?- n_fac(N,N), false.
false.
Doing fine! Identical termination behaviour... More?
?- N #< 5, n_factorial(N,_), false.
false.
?- N #< 5, n_fac(N,_), false.
false.
?- F in 10..100, n_factorial(_,F), false.
false.
?- F in 10..100, n_fac(_,F), false.
false.
Alright! Still identical termination properties! Let's dig a little deeper! How about the following?
?- F in inf..10, n_factorial(_,F), false.
... % Execution Aborted % does not terminate universally
?- F in inf..10, n_fac(_,F), false.
false. % terminates universally
D'oh! The first query does not terminate, the second does.
What a speedup! :)
Let's do some empirical runtime measurements!
?- member(Exp,[6,7,8,9]), F #= 10^Exp, time(n_factorial(N,F)) ; true.
% 328,700 inferences, 0.043 CPU in 0.043 seconds (100% CPU, 7660054 Lips)
% 1,027,296 inferences, 0.153 CPU in 0.153 seconds (100% CPU, 6735634 Lips)
% 5,759,864 inferences, 1.967 CPU in 1.967 seconds (100% CPU, 2927658 Lips)
% 22,795,694 inferences, 23.911 CPU in 23.908 seconds (100% CPU, 953351 Lips)
true.
?- member(Exp,[6,7,8,9]), F #= 10^Exp, time(n_fac(N,F)) ; true.
% 1,340 inferences, 0.000 CPU in 0.000 seconds ( 99% CPU, 3793262 Lips)
% 1,479 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 6253673 Lips)
% 1,618 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 5129994 Lips)
% 1,757 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 5044792 Lips)
true.
Wow! Some more?
?- member(U,[10,100,1000]), time((N in 1..U,n_factorial(N,_),false)) ; true.
% 34,511 inferences, 0.004 CPU in 0.004 seconds (100% CPU, 9591041 Lips)
% 3,091,271 inferences, 0.322 CPU in 0.322 seconds (100% CPU, 9589264 Lips)
% 305,413,871 inferences, 90.732 CPU in 90.721 seconds (100% CPU, 3366116 Lips)
true.
?- member(U,[10,100,1000]), time((N in 1..U,n_fac(N,_),false)) ; true.
% 3,729 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 2973653 Lips)
% 36,369 inferences, 0.004 CPU in 0.004 seconds (100% CPU, 10309784 Lips)
% 362,471 inferences, 0.036 CPU in 0.036 seconds (100% CPU, 9979610 Lips)
true.
The bottom line?
The code presented in this answer is as low-level as you should go: Forget is/2!
Redundant constraints can and do pay off.
The order of arithmetic operations (counting "up" vs "down") can make quite a difference, too.
If you want to calculate the factorial of some "large" N, consider using a different approach.
Use clpfd!
There are some things which you must remember when looking at Prolog:
There is no implicit return value when you call a predicate. If you want to get a value out of a call you need to add extra arguments which can be used to "return" values, the second argument in your f/2 predicate. While being more verbose it does have the benefit of being easy to return many values.
This means that automatically "evaluating" arguments in a call is really quite meaningless as there is no value to return and it is not done. So there are no nested calls, in this respect Prolog is flat. So when you call f(A-1, D) the first argument to f/2 is the structure A-1, or really -(A, 1) as - is an infix operator. So if you want to get the value from a call to foo into a call to bar you have to explicitly use a variable to do it like:
foo(..., X), bar(X, ...),
So you need a special predicate which forces arithmetic evaluation, is/2. It's second argument is a structure representing an arithmetic expression which it interprets, evaluates and unifies the result with its first argument, which can be either a variable or numerical value.
While in principle you can run things backwards with most things you can't. Usually it is only simple predicates working on structures for which it is possible, though there are some very useful cases where it is possible. is/2 doesn't work backwards, it would be exceptional if it did.
This is why you need the extra variables C and D and can't replace C is A-1, f(C, D) by f(A-1,D).
(Yes I know you don't make calls in Prolog, but evaluate goals, but we were starting from a functional viewpoint here)