Related
I want to implement SKI combinators in Prolog.
There are just 3 simple rules:
(I x) = x
((K x) y) = x
(S x y z) = (x z (y z))
I came up with the following code by using epilog:
term(s)
term(k)
term(i)
term(app(X,Y)) :- term(X) & term(Y)
proc(s, s)
proc(k, k)
proc(i, i)
proc(app(i,Y), Y1) :- proc(Y,Y1)
proc(app(app(k,Y),Z), Y1) :- proc(Y,Y1)
proc(app(app(app(s,P1),P2),P3), Y1) :- proc(app( app(P1,P3), app(P2, P3) ), Y1)
proc(app(X, Y), app(X1, Y1)) :- proc(X, X1) & proc(Y, Y1)
proc(X,X)
It works for some cases but has 2 issues:
It takes too much time to execute simple queries:
term(X) & proc(app(app(k, X), s), app(s,k))
100004 unification(s)
It requires multiple queries to process some terms. For example:
((((S(K(SI)))K)S)K) -> (KS)
requires 2 runs:
proc(app(app(app(app(s,app(k,app(s,i))),k),s),k), X) ==>
proc(app(app(app(app(s,app(k,app(s,i))),k),s),k), app(app(app(s,i),app(k,s)),k))
proc(app(app(app(s,i),app(k,s)),k), X) ==>
proc(app(app(app(s,i),app(k,s)),k), app(k,s))
Can you please suggest how to optimize my implementation and make it work on complex combinators?
edit: The goal is to reduce combinators. I want to enumerate them (without duplicates) where the last one is in normal form (if it exists of course).
It can be implemented with iterative deepening like this:
term(s) --> "S".
term(k) --> "K".
term(i) --> "I".
term(a(E0,E)) --> "(", term(E0), term(E), ")".
reduce_(s, s).
reduce_(k, k).
reduce_(i, i).
% Level 1.
reduce_(a(s,A0), a(s,A)) :-
reduce_(A0, A).
reduce_(a(k,A0), a(k,A)) :-
reduce_(A0, A).
reduce_(a(i,A), A).
% level 2.
reduce_(a(a(s,E0),A0), a(a(s,E),A)) :-
reduce_(E0, E),
if_(E0 = E, reduce_(A0, A), A0 = A).
% reduce_(A0, A). % Without `reif`.
reduce_(a(a(k,E),_), E).
reduce_(a(a(i,E),A), a(E,A)).
% level 3.
reduce_(a(a(a(s,E),F),A), a(a(E,A),a(F,A))).
reduce_(a(a(a(k,E),_),A), a(E,A)).
reduce_(a(a(a(i,E),F),A), a(a(E,F),A)).
% Recursion.
reduce_(a(a(a(a(E0,E1),E2),E3),A0), a(E,A)) :-
reduce_(a(a(a(E0,E1),E2),E3), E),
if_(a(a(a(E0,E1),E2),E3) = E, reduce_(A0, A), A0 = A).
% reduce_(A0, A). % Without `reif`.
step(E, E0, E) :-
reduce_(E0, E).
reduce_(N, E0, E, [E0|Es]) :-
length(Es, N),
foldl(step, Es, E0, E).
reduce(N, E0, E) :-
reduce_(N, E0, E, _),
reduce_(E, E), % Fix point.
!. % Commit.
The term can be inputted and outputted as a list of characters with term//1. The grammar rule term//1 can also generate unique terms.
?- length(Cs, M), M mod 3 =:= 1, phrase(term(E0), Cs).
The goal is to be as lazy as possible when reducing a term thus dif/2 and the library reif is used in reduce_/2. The predicate reduce_/2 does a single reduction. If any of the argument of reduce_/2 is ground then termination is guarantee (checked with cTI).
To reduce a term, reduce_/4 can be used. The first argument specifies the depth, the last argument holds the list of terms. The predicate reduce_/4 is pure and does not terminate.
?- Cs = "(((SK)K)S)", phrase(term(E0), Cs), reduce_(N, E0, E, Es).
The predicate reduce/3 succeeds if there is a normal form. It is recommended to provide a maximum depth (e.g. Cs = "(((SI)I)((SI)(SI)))"):
?- length(Cs, M), M mod 3 =:= 1, phrase(term(E0), Cs), \+ reduce(16, E0, _).
Test with ((((S(K(SI)))K)S)K):
?- Cs0 = "((((S(K(SI)))K)S)K)", phrase(term(E0), Cs0),
reduce(N, E0, E), phrase(term(E), Cs).
Cs0="((((S(K(SI)))K)S)K)", E0=a(a(a(a(s,a(k,a(s,i))),k),s),k), N=5, E=a(k,s), Cs="(KS)"
Translating your code trivially to Prolog, using the built-in left-associating infix operator - for app, to improve readability,
term(s).
term(k).
term(i).
term( X-Y ) :- term(X) , term(Y).
/* proc(s, s). %%% not really needed.
proc(k, k).
proc(i, i). */
proc( i-Y, Y1) :- proc( Y,Y1).
proc( k-Y-Z, Y1) :- proc( Y,Y1).
proc( s-X-Y-Z, Y1) :- proc( X-Z-(Y-Z), Y1).
proc( X-Y, X1-Y1 ) :- proc( X, X1) , proc( Y, Y1).
proc( X, X).
executing in SWI Prolog,
26 ?- time( (term(X), proc( k-X-s, s-k)) ).
% 20 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
X = s-k ;
% 1 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = s-k ;
Action (h for help) ? abort
% 952,783 inferences, 88.359 CPU in 90.112 seconds (98% CPU, 10783 Lips)
% Execution Aborted
27 ?-
the first result is produced in 20 inferences.
Furthermore, indeed
32 ?- time( proc( s-(k-(s-i))-k-s-k, X) ).
% 10 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = s-i- (k-s)-k ;
% 2 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
X = s-i- (k-s)-k ;
% 5 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = s-i- (k-s)-k ;
% 2 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = s-i- (k-s)-k ;
% 11 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
X = k- (s-i)-s- (k-s)-k ;
% 2 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = k- (s-i)-s- (k-s)-k . % stopped manually
and then
33 ?- time( proc( s-i- (k-s)-k, X) ).
% 5 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = k-s ;
% 5 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = k- (k-s-k) ;
% 2 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = k- (k-s-k) ;
% 1 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = k- (k-s-k) ;
% 5 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = i-k-s ;
% 5 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = i-k- (k-s-k) ;
% 2 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = i-k- (k-s-k) ;
% 1 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = i-k- (k-s-k) ;
% 3 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = i-k-s ;
% 5 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = i-k- (k-s-k) . % stopped manually
but probably the result you wanted will still get generated directly, just after some more time.
Based on Will Ness answer here is my solution:
term(s).
term(k).
term(i).
term(app(X,Y)) :- term(X), term(Y).
eq(s,s).
eq(k,k).
eq(i,i).
eq(app(X,Y),app(X,Y)).
proc(s, s).
proc(k, k).
proc(i, i).
proc(app(i,Y), Y1) :- proc(Y,Y1).
proc(app(app(k,Y),Z), Y1) :- proc(Y,Y1).
proc(app(app(app(s,P1),P2),P3), Y1) :- proc(app( app(P1,P3), app(P2, P3) ), Y1).
proc(app(X, Y), Z) :- proc(X, X1), proc(Y, Y1), eq(X, X1), eq(X, X1), eq(app(X, Y), Z).
proc(app(X, Y), Z) :- proc(X, X1), proc(Y, Y1), not(eq(X, X1)), proc(app(X1, Y1), Z).
proc(app(X, Y), Z) :- proc(X, X1), proc(Y, Y1), not(eq(Y, Y1)), proc(app(X1, Y1), Z).
Move code to swish prolog. It works much faster
time((term(X), proc(app(app(k, X), s), app(s,k)))).
% 356 inferences, 0.000 CPU in 0.000 seconds (94% CPU, 3768472 Lips)
X = app(s,k)
Implemented complete reduction procedure:
proc(app(app(app(app(s,app(k,app(s,i))),k),s),k), X)
answer contains: X = app(k,s)
There are still issues that I can not resolve
time((term(X), proc(app(app(X, k), s), app(s,k)))). runs forever
Answers are not ordered by reductions.
I have a rule that matches bc. When I encounter that in a string, I don't want to parse that string, otherwise parse anything else.
% Prolog
bc(B, C) --> [B, C], {
B = "b",
C = "c"
}.
not_bc(O) --> [O], % ?! bc(O, C).
% ?- phrase(not_bc(O), "bcdefg").
% false.
% ?- phrase(not_bc(O), "abcdefg").
% O = "a".
% ?- phrase(not_bc(O), "wxcybgz")
% O = "w".
% ?- phrase(not_bc(O), "wxybgz")
% O = "w".
Simplified version of my problem, hopefully solutions are isomorphic.
Similar to this question:
Translation to DCG Semicontext not working - follow on
An alternative:
process_bc(_) --> "bc", !, { fail }.
process_bc(C) --> [C].
This differs from my other solution in accepting:
?- time(phrase(process_bc(C), `b`, _)).
% 8 inferences, 0.000 CPU in 0.000 seconds (83% CPU, 387053 Lips)
C = 98.
In swi-prolog:
process_text(C1) --> [C1, C2], { dif([C1, C2], `bc`) }.
Results:
?- time(phrase(process_text(C), `bca`, _)).
% 11 inferences, 0.000 CPU in 0.000 seconds (79% CPU, 376790 Lips)
false.
?- time(phrase(process_text(C), `bd`, _)).
% 10 inferences, 0.000 CPU in 0.000 seconds (80% CPU, 353819 Lips)
C = 98.
?- time(phrase(process_text(C), `zbcagri4gj40w9tu4tu34ty3ty3478t348t`, _)).
% 10 inferences, 0.000 CPU in 0.000 seconds (80% CPU, 372717 Lips)
C = 122.
A single character, or no characters, are both presumably meant to be failures.
This is nicely efficient, only having to check the first 2 characters.
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).
TL;DR: This question is about one particular aspect of evaluating candidate failure-slices.
The following code of ancestor_of/2 expresses the transitive-closure of child_of/2:
ancestor_of(X, Y) :-
child_of(Y, X).
ancestor_of(X, Z) :-
child_of(Z, Y),
ancestor_of(X, Y).
If we define child_of/2 and include several cycles ...
child_of(xx, xy).
child_of(xy, xx).
child_of(x, x).
... ancestor_of(X, Y) does not terminate universally:
?- ancestor_of(X, Y), false.
**LOOPS**
With SWI-Prolog, we can limit the amount of work invested in the execution of the query:
?- time(call_with_inference_limit((ancestor_of(_,_),false), 10000, R)).
% 10,008 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 4579243 Lips)
R = inference_limit_exceeded ;
% 5 inferences, 0.000 CPU in 0.000 seconds (85% CPU, 235172 Lips)
false.
Alright, but it could be better!
First, we might be able to prove definitely that the goal loops.
Second, we might be able to do so with less effort.
Let's add an additional argument to ancestor_of/2 for transferring call stack information!
ancestor_of_open(X, Y, Open) :-
G = ancestor_of(X,Y),
( member(G, Open)
-> throw(loop(G,Open))
; ancestor_of_aux(X, Y, [G|Open])
).
ancestor_of_aux(X, Y, _Open) :-
child_of(Y, X).
ancestor_of_aux(X, Z, Open) :-
child_of(Z, Y),
ancestor_of_open(X, Y, Open).
Sample query:
?- time(ancestor_of_open(X,Y,[])).
% 4 inferences, 0.000 CPU in 0.000 seconds (92% CPU, 219696 Lips)
X = xy,
Y = xx ;
% 1 inferences, 0.000 CPU in 0.000 seconds (79% CPU, 61839 Lips)
X = xx,
Y = xy ;
% 1 inferences, 0.000 CPU in 0.000 seconds (79% CPU, 61084 Lips)
X = Y, Y = x ;
% 8 inferences, 0.000 CPU in 0.000 seconds (87% CPU, 317473 Lips)
X = Y, Y = xx ;
% 11 inferences, 0.000 CPU in 0.000 seconds (90% CPU, 262530 Lips)
ERROR: Unhandled exception: loop(ancestor_of(_G282,xx),[ancestor_of(_G282,xy),ancestor_of(_G282,xx)])
Is this it?! That was too easy. Does this cover the general case?
I feel like I'm missing something important, but I can't quite point my finger at it. Please help!
Many predicates essentially use some form of transitive closure, only to discover that termination has to be addressed too. Why not solve this once and forever with closure0/3:
:- meta_predicate closure0(2,?,?).
:- meta_predicate closure(2,?,?).
:- meta_predicate closure0(2,?,?,+). % internal
closure0(R_2, X0,X) :-
closure0(R_2, X0,X, [X0]).
closure(R_2, X0,X) :-
call(R_2, X0,X1),
closure0(R_2, X1,X, [X1,X0]).
closure0(_R_2, X,X, _).
closure0(R_2, X0,X, Xs) :-
call(R_2, X0,X1),
non_member(X1, Xs),
closure0(R_2, X1,X, [X1|Xs]).
non_member(_E, []).
non_member(E, [X|Xs]) :-
dif(E,X),
non_member(E, Xs).
Are there cases where this definition cannot be used for implementing transitive closure?
Why dif/2?
To answer #WouterBeek's comment in detail: dif/2 or dif_si/2 are ideal, because they are able to show or signal potential problems. However, in current implementations the top-level loop often hides the actual issues. Consider the goal closure0(\_^_^true,a,b) which certainly is quite problematic in itself. When using the following systems the actual problem is directly not visible.
| ?- closure0(\_^_^true,a,b). % SICStus
yes
?- closure0(\_^_^true,a,b). % SWI
true ;
true ;
true ...
Both top-level loops do not show what we actually want to see: the dangling constraints. In SICStus we need a pseudo variable to produce some substitution, in SWI, the query has to be wrapped with call_residue_vars/2. In this manner all variables that have constraints attached are now shown.
| ?- closure0(\_^_^true,a,b), Alt=t. % SICStus
Alt = t ? ;
Alt = t,
prolog:dif(_A,a),
prolog:dif(b,_A) ? ;
Alt = t,
prolog:dif(_A,a),
prolog:dif(_B,_A),
prolog:dif(_B,a),
prolog:dif(b,_B),
prolog:dif(b,_A) ...
?- call_residue_vars(closure0(\_^_^true,a,b),Vs). % SWI
Vs = [] ;
Vs = [_G1744, _G1747, _G1750],
dif(_G1744, a),
dif(b, _G1744) ;
Vs = [_G1915, _G1918, _G1921, _G1924, _G1927, _G1930, _G1933],
dif(_G1915, a),
dif(b, _G1915),
dif(_G1921, _G1915),
dif(_G1921, a),
dif(b, _G1921) ...
It's useful, but in my opinion not yet ideal because I cannot cut duplicate paths at the point of their creation.
Consider, with the complete graph K_n:
n_complete(N, Es) :-
numlist(1, N, Ns),
phrase(pairs(Ns), Es).
adjacent(Edges, X, Y) :- member(edge(X, Y), Edges).
pairs([]) --> [].
pairs([N|Ns]) --> edges(Ns, N), pairs(Ns).
edges([], _) --> [].
edges([N|Ns], X) --> [edge(X,N),edge(N,X)], edges(Ns, X).
The following query now has super-exponential runtime, although the closure can actually be found in polynomial time:
?- length(_, N), n_complete(N, Es), portray_clause(N),
time(findall(Y, closure0(adjacent(Es), 1, Y), Ys)),
false.
1.
16 inferences, 0.000 CPU in 0.000 seconds (97% CPU, 1982161 Lips)
2.
54 inferences, 0.000 CPU in 0.000 seconds (98% CPU, 4548901 Lips)
3.
259 inferences, 0.000 CPU in 0.000 seconds (97% CPU, 14499244 Lips)
4.
1,479 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 16219595 Lips)
5.
9,599 inferences, 0.000 CPU in 0.000 seconds (100% CPU, 27691393 Lips)
6.
70,465 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 28911161 Lips)
7.
581,283 inferences, 0.020 CPU in 0.020 seconds (100% CPU, 29397339 Lips)
8.
5,343,059 inferences, 0.181 CPU in 0.181 seconds (100% CPU, 29488001 Lips)
9.
54,252,559 inferences, 1.809 CPU in 1.808 seconds (100% CPU, 29994536 Lips)
10.
603,682,989 inferences, 19.870 CPU in 19.865 seconds (100% CPU, 30381451 Lips)
It would be great if a more efficient way to determine the closure could also be expressed with this meta-predicate.
For example, one would normally simply use Warshall's algorithm to compute the closure in cubic time, with code similar to:
node_edges_closure(Node, Edges, Closure) :-
warshall_fixpoint(Edges, [Node], Closure).
warshall_fixpoint(Edges, Nodes0, Closure) :-
findall(Y, (member(X, Nodes0), adjacent(Edges, X, Y)), Nodes1, Nodes0),
sort(Nodes1, Nodes),
( Nodes == Nodes0 -> Closure = Nodes0
; warshall_fixpoint(Edges, Nodes, Closure)
).
Yielding (with all drawbacks in comparison to the nicely declarative closure0/3):
?- length(_, N), n_complete(N, Es), portray_clause(N),
time(node_edges_closure(1, Es, Ys)),
false.
1.
% 16 inferences, 0.000 CPU in 0.000 seconds (75% CPU, 533333 Lips)
2.
% 43 inferences, 0.000 CPU in 0.000 seconds (85% CPU, 1228571 Lips)
3.
% 69 inferences, 0.000 CPU in 0.000 seconds (85% CPU, 1769231 Lips)
4.
% 115 inferences, 0.000 CPU in 0.000 seconds (89% CPU, 2346939 Lips)
5.
% 187 inferences, 0.000 CPU in 0.000 seconds (91% CPU, 2968254 Lips)
6.
% 291 inferences, 0.000 CPU in 0.000 seconds (92% CPU, 3548780 Lips)
7.
% 433 inferences, 0.000 CPU in 0.000 seconds (95% CPU, 3866071 Lips)
8.
% 619 inferences, 0.000 CPU in 0.000 seconds (96% CPU, 4268966 Lips)
9.
% 855 inferences, 0.000 CPU in 0.000 seconds (97% CPU, 4500000 Lips)
10.
% 1,147 inferences, 0.000 CPU in 0.000 seconds (98% CPU, 4720165 Lips)
etc.