Given word/1,
word(W) :- abs(ABs), ABs = W. abs([]). abs([AB|ABs]) :- abs(ABs), ab(AB). ab(a). ab(b). ?- word(W). W = [] ; W = [a] ; W = [b] ; W = [a,a] ; W = [b,a] ; W = [a,b] ; W = [b,b] ; W = [a,a,a] ; W = [b,a,a] ; W = [a,b,a] ; W = [b,b,a] ; W = [a,a,b] ; W = [b,a,b] ; W = [a,b,b] ; W = [b,b,b] ; W = [a,a,a,a] ... how does a more compact definition of word/1 look like, otherwise identical w.r.t. termination and the set of solutions, fairness, with the following constraints:
No use of built-ins like
(=)/2.No use of control constructs like
(',')/2or(;)/2, orcall/1.Uses one fact, one recursive rule, and one rule for
word/1.
Maybe simpler is to ask for the terms F1 ... F4 in:
word(W) :- p(F1). p(F2). p(F3) :- p(F4). For the record: The property exploited here is closely related to the undecidability of termination of a single binary clause. Praise goes to:
Philippe Devienne, Patrick Lebègue, Jean-Christophe Routier, and Jörg Würtz. One binary horn clause is enough (http://dl.acm.org/citation.cfm?id=694839). STACS '94.
7 Answers
Answers 1
The solution I have come up with is:
word(W) :- p([[]|Ls], Ls, W). p([W|_], _, W). p([W0|Ws], [[a|W0],[b|W0]|Ls], W) :- p(Ws, Ls, W).
Sample query and answer:
?- word(W). W = [] ; W = [a] ; W = [b] ; W = [a, a] ; W = [b, a] ; W = [a, b] ; W = [b, b] ; W = [a, a, a] ; W = [b, a, a] ; W = [a, b, a] ; W = [b, b, a] ; W = [a, a, b] ; W = [b, a, b] ; W = [a, b, b] ; W = [b, b, b] ; W = [a, a, a, a] ; W = [b, a, a, a] ; etc.
I am using a difference list to incrementally materialize the solutions I want the toplevel to report.
Answers 2
Okay so not an answer yet.
The closest I had was :
s_s1([],[a]). s_s1([b|T],[a|T]). s_s1([a|T],[b|T2]):- s_s1(T,T2). word([]). word(W2):- word(W), s_s1(W,W2). Which does not either meet the criteria or give the right solutions!
So next I thought we could try and use prolog to find the answer.. The structure is given so we need to search for the args..
%First define the first 16 correct solutions.. correct_sols(X):- X=[ [], [a], [b], [a,a], [b,a], [a,b], [b,b], [a,a,a], [b,a,a], [a,b,a], [b,b,a], [a,a,b], [b,a,b], [a,b,b], [b,b,b], [a,a,a,a] ]. %Then a mi provable(true, _) :- !. provable((G1,G2), Defs) :- !, provable(G1, Defs), provable(G2, Defs). provable(BI, _) :- predicate_property(BI, built_in), !, call(BI). provable(Goal, Defs) :- member(Def, Defs), copy_term(Def, Goal-Body), provable(Body, Defs). %From 4 Vars find 16 solutions to word(X) vars_16sols(Vars,List):- Vars =[Args,Args0,Args1,Argsx], findnsols(16,X,provable(word(X),[ a(Args)-true, a(Args0)-a(Args1), word(X)-a(Argsx)] ),List). %Evaluate the score, for the solutions found how many match correct evaluate_score(Solutions,Score):- correct_sols(C), maplist(correct_test_tf,C,Solutions,TrueFalse), findall(_,member(true,TrueFalse),Matches), length(Matches,Score). %The main search, give a form for the starting 4 arguments, if they match all 16 correct stop. startingargs_solution(Start,Sol):- vars_16sols(Start,SolsStart), evaluate_score(SolsStart,Score), Score =16, SolsStart=Sol. %Othewise refine args, and try again. startingargs_solution(Start,Sol):- vars_16sols(Start,SolsStart), evaluate_score(SolsStart,Score), Score <16, start_refined(Start,Refined), startingargs_solution(Refined,Sol). We would still need to define :
- correct_test_tf/3
- start_refined/2 with some constraints, such as the size of the terms for args(needs to be reasonable to be a 'compact definition', and what things need to be included, i.e. at least
aandbsomewhere and probably[].
Clearly not finished and not sure if it will be possible to do this but thought I would post an answer to see what people have to say.. The search is naive at the moment!
This is only testing the first 16 solutions but maybe that is adequate to get a correct answer..
Also maybe this is harder then solving the question on its own!
Answers 3
So to clarify, the intended solution is an instance of the following schema?
fact(Args). recursive_rule(Args0) :- recursive_rule(Args1). word(W) :- recursive_rule(Args). Where each occurrence of an Args variable stands for zero or more terms and presumably (but not necessarily) fact and recursive_rule are actually the same functor?
Answers 4
With Guy coder's suggestions this is closer?
unfold([], []). unfold([H|T], [[a|H], [b|H]|L]) :- unfold(T, L). ab([], [[]]). ab([_|N1],L):- ab(N1, L1), unfold(L1, L). word(X):- length(List,_), ab(List,Values), member(X,Values). Answers 5
My closest yet.
unfold20([], []). unfold20([H|T], [[a|H], [b|H]|L]) :- unfold20(T, L). member20(X, [X|_]). member20(X, [_|Tail]) :- member20(X, Tail). swap20(R,R) :- write('swap20 R: '),write(R),nl. swap20(In,L) :- write('swap20 In: '),write(In),nl, unfold20(In,L), swap20(L,_), write('swap20 L: '),write(L),nl. word20(W) :- swap20([[]],L), write('word20 L: '),write(L),nl, member20(W,L), write('word20 W: '),write(W),nl. % ?- word20(X). % swap20 R: [[]] % word20 L: [[]] % word20 W: [] % X = [] ; % swap20 In: [[]] % swap20 R: [[a],[b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] ; % word20 W: [b] % X = [b] ; % swap20 In: [[a],[b]] % swap20 R: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] ; % word20 W: [b] % X = [b] ; % swap20 In: [[a,a],[b,a],[a,b],[b,b]] % swap20 R: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] ; % word20 W: [b] % X = [b] ; % swap20 In: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 R: [[a,a,a,a],[b,a,a,a],[a,b,a,a],[b,b,a,a],[a,a,b,a],[b,a,b,a],[a,b,b,a],[b,b,b,a],[a,a,a,b],[b,a,a,b],[a,b,a,b],[b,b,a,b],[a,a,b,b],[b,a,b,b],[a,b,b,b],[b,b,b,b]] % swap20 L: [[a,a,a,a],[b,a,a,a],[a,b,a,a],[b,b,a,a],[a,a,b,a],[b,a,b,a],[a,b,b,a],[b,b,b,a],[a,a,a,b],[b,a,a,b],[a,b,a,b],[b,b,a,b],[a,a,b,b],[b,a,b,b],[a,b,b,b],[b,b,b,b]] % swap20 L: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] % word20 L: [[a],[b]] % word20 W: [a] % X = [a] If you look you will see that there is no use of ; which I am sure is a problem some people are having. Also all of the rules are simple enough that they should be able to be folded into the requirements by using additional arguments. e.g. unfold(A,B) would become unfold(A,B,C,D) or a variation.
The problem with this version is that I get the correct answers as the evaluation progresses, it is just getting them back to the top level.
e.g.
% swap20 L: [[a,a,a],[b,a,a],[a,b,a],[b,b,a],[a,a,b],[b,a,b],[a,b,b],[b,b,b]] % swap20 L: [[a,a],[b,a],[a,b],[b,b]] % swap20 L: [[a],[b]] I will keep working on this before the dead line, but if someone is able to use what I have here, hats off to them, I just ask that you give credit if any part of this helped you get the answer.
The unfold predicate is based on this SO answer. Credit to salva
member is an old friend. Notice that it starts with [[]] and not [].
swap I created this predicate. I have swap working for different variation yet the variation fails for a different reason.
Answers 6
Not a solution, but an insight toward a solution.
This started with using DCG
abs4 --> []. abs4 --> abs4, ([a] | [b]). ?- phrase(abs4,X). X = [] ; X = [a] ; X = [b] ; X = [a, a] ; X = [a, b] ; X = [b, a] ; X = [b, b] ; X = [a, a, a] ; X = [a, a, b] ; X = [a, b, a] ; X = [a, b, b] ; X = [b, a, a] ; X = [b, a, b] ; X = [b, b, a] ; X = [b, b, b] ; X = [a, a, a, a] ; X = [a, a, a, b] ; then looking at the listing
?- listing(abs4). abs4(A, A). abs4(A, C) :- abs4(A, B), ( B=[a|C] ; B=[b|C] ). and using member to remove the ;.
word5(W) :- abs5(W,[]). abs5(A, A). abs5(A, C) :- abs5(A, [D|C]), member5(D,[a,b]). member5(X, [X|_]). member5(X, [_|Tail]) :- member5(X, Tail). ?- word5(X). X = [] ; X = [a] ; X = [b] ; X = [a, a] ; X = [a, b] ; X = [b, a] ; X = [b, b] ; X = [a, a, a] ; X = [a, a, b] ; X = [a, b, a] ; X = [a, b, b] ; X = [b, a, a] Answers 7
Normally I would post these as a single answer, but @false asked me to keep them separate.
If you read my comments and answers you will see that I was aware that I had to pass the result from one iteration back into the next iteration. What gave me insight into that was using a cross-product predicate which I found in
"The Craft of Prolog" by Richard A. O'Keefe pg. 243
If you are serious about learning Prolog, the book is a must have.
To quote the Preface
There are a lot of introductory Prolog books around. This not one of them. Think of it as "second steps in Prolog". If you have already read one of the introductory books, if you have taken an introductory course on Prolog, if you have written ore or two Prolog programs, and if you are wondering why it is still hard to write good Prolog programs, this book is meant to help you. The purpose of the book is to show you how you can write Prolog programs that work, that don't take an unreasonable amount of time, and that are clean enough to show to your friends.
Here is a slight variation that I used for one variation that did not work.
combine(X,Y,[X,Y]). product(P,Xs,Ys,PXYs) :- product1(Xs,Ys,PXYs,P). product1([],_,[],_). product1([X|Xs],Ys,PXYs0,P) :- product1(Ys,X,P,PXYs0,PXYs1), product1(Xs,Ys,PXYs1,P). product1([],_,_) --> []. product1([Y|Ys],X,P) --> { call(P,X,Y,PXY) }, [PXY], product1(Ys,X,P). ?- product(combine,[a,b],[a,b],R). R = [[a, a], [a, b], [b, a], [b, b]]. 
0 comments:
Post a Comment