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.
edge is a :- dynamic edge/2
the edge indicates only if the vertex are joined, example:
edge(a, b).
edge(c, d).
edge(r, c).
edge(c, t).
edge(a, t).
And I want to know if a vertex have 3 or more edges but only one of them, if there are more than one with 3 or more should return no.
Thanks
In SWI Prolog:
test() :-
findall([A,B], edge(A,B), VRaw), % find every vertex.
flatten(VRaw, VFlat), % make a flat list of them.
msort(VFlat, VSorted), % sort them.
clumped(VSorted, VClumped), % count how many of each.
include([_-C]>>(C>=3), VClumped, V3), % filter the ones with count>=3.
length(V3, 1). % was there exactly one?
Another possible solution:
unique_vertex_with_three_or_more_edges(V) :-
setof(V, vertex_with_three_or_more_edges(V), [V]).
vertex_with_three_or_more_edges(V) :-
setof(W, (edge(V,W) ; edge(W,V)), [_,_,_|_]).
Example:
?- time(unique_vertex_with_three_or_more_edges(X)).
% 78 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
X = c.
?- time(unique_vertex_with_three_or_more_edges(c)).
% 35 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
true.
?- time(unique_vertex_with_three_or_more_edges(a)).
% 33 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)
false.
Browsing through the awesome On-Line Encyclopedia of Integer Sequences (cf. en.wikipedia.org), I stumbled upon the following integer sequence:
A031877: Nontrivial reversal numbers (numbers which are integer multiples of their reversals), excluding palindromic numbers and multiples of 10.
By re-using some code I wrote for my answer to the related question "Faster implementation of verbal arithmetic in Prolog" I could
write down a solution quite effortlessly—thanks to clpfd!
:- use_module(library(clpfd)).
We define the core relation a031877_ndigits_/3 based on
digits_number/2 (defined earlier):
a031877_ndigits_(Z_big,N_digits,[K,Z_small,Z_big]) :-
K #> 1,
length(D_big,N_digits),
reverse(D_small,D_big),
digits_number(D_big,Z_big),
digits_number(D_small,Z_small),
Z_big #= Z_small * K.
The core relation is deterministic and terminates universally whenever
N_digit is a concrete integer. See for yourself for the first 100 values of N_digit!
?- time((N in 0..99,indomain(N),a031877_ndigits_(Z,N,Zs),false)).
% 3,888,222 inferences, 0.563 CPU in 0.563 seconds (100% CPU, 6903708 Lips)
false
Let's run some queries!
?- a031877_ndigits_(87912000000087912,17,_).
true % succeeds, as expected
; false.
?- a031877_ndigits_(87912000000987912,17,_).
false. % fails, as expected
Next, let's find some non-trivial reversal numbers comprising exactly four decimal-digits:
?- a031877_ndigits_(Z,4,Zs), labeling([],Zs).
Z = 8712, Zs = [4,2178,8712]
; Z = 9801, Zs = [9,1089,9801]
; false.
OK! Let's measure the runtime needed to prove universal termination of above query!
?- time((a031877_ndigits_(Z,4,Zs),labeling([],Zs),false)).
% 11,611,502 inferences, 3.642 CPU in 3.641 seconds (100% CPU, 3188193 Lips)
false. % terminates universally
Now, that's way too long!
What can I do to speed things up? Use different and/or other constraints? Maybe even redundant ones? Or maybe identify and eliminate symmetries which slash the search space size? What about different clp(*) domains (b,q,r,set)? Or different consistency/propagation techniques? Or rather Prolog style coroutining?
Got ideas? I want them all! Thanks in advance.
So far ... no answers:(
I came up with the following...
How about using different variables for labeling/2?
a031877_ndigitsNEW_(Z_big,N_digits,/* [K,Z_small,Z_big] */
[K|D_big]) :-
K #> 1,
length(D_big,N_digits),
reverse(D_small,D_big),
digits_number(D_big,Z_big),
digits_number(D_small,Z_small),
Z_big #= Z_small * K.
Let's measure some runtimes!
?- time((a031877_ndigits_(Z,4,Zs),labeling([ff],Zs),false)).
% 14,849,250 inferences, 4.545 CPU in 4.543 seconds (100% CPU, 3267070 Lips)
false.
?- time((a031877_ndigitsNEW_(Z,4,Zs),labeling([ff],Zs),false)).
% 464,917 inferences, 0.052 CPU in 0.052 seconds (100% CPU, 8962485 Lips)
false.
Better! But can we go further?
?- time((a031877_ndigitsNEW_(Z,5,Zs),labeling([ff],Zs),false)).
% 1,455,670 inferences, 0.174 CPU in 0.174 seconds (100% CPU, 8347374 Lips)
false.
?- time((a031877_ndigitsNEW_(Z,6,Zs),labeling([ff],Zs),false)).
% 5,020,125 inferences, 0.614 CPU in 0.613 seconds (100% CPU, 8181572 Lips)
false.
?- time((a031877_ndigitsNEW_(Z,7,Zs),labeling([ff],Zs),false)).
% 15,169,630 inferences, 1.752 CPU in 1.751 seconds (100% CPU, 8657015 Lips)
false.
There is still lots of room for improvement, for sure! There must be...
We can do better by translating number-theoretic properties into the language of constraints!
All terms are of the form 87...12 = 4*21...78 or 98...01 = 9*10...89.
We implement a031877_ndigitsNEWER_/3 based on a031877_ndigitsNEW_/3 and directly add above property as two finite-domain constraints:
a031877_ndigitsNEWER_(Z_big,N_digits,[K|D_big]) :-
K in {4}\/{9}, % (new)
length(D_big,N_digits),
D_big ins (0..2)\/(7..9), % (new)
reverse(D_small,D_big),
digits_number(D_big,Z_big),
digits_number(D_small,Z_small),
Z_big #= Z_small * K.
Let's re-run the benchmarks we used before!
?- time((a031877_ndigitsNEWER_(Z,5,Zs),labeling([ff],Zs),false)).
% 73,011 inferences, 0.006 CPU in 0.006 seconds (100% CPU, 11602554 Lips)
false.
?- time((a031877_ndigitsNEWER_(Z,6,Zs),labeling([ff],Zs),false)).
% 179,424 inferences, 0.028 CPU in 0.028 seconds (100% CPU, 6399871 Lips)
false.
?- time((a031877_ndigitsNEWER_(Z,7,Zs),labeling([ff],Zs),false)).
% 348,525 inferences, 0.037 CPU in 0.037 seconds (100% CPU, 9490920 Lips)
false.
Summary: For the three queries, we consistently observed a significant reduction of search required. Just consider how much the inference counts shrank: 1.45M -> 73k, 5M -> 179k, 15.1M -> 348k.
Can we do even better (while preserving declarativity of the code)? I don't know, I guess so...
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.