Usage of distinct still leading to duplicates - prolog

I'm new to prolog, and as I understand it, the purpose of 'distinct' is to weed out duplicates. However, this code block:
allpartsincity(City):-
distinct((proj(Project, _, City), sppj(_, Part, Project, _), part(Part, _, _, _, _))),
part(Part, Name, Color, Num, X),
format('~w ~w ~w ~w ~w ~n', [Part, Name, Color, Num, X]),
fail
;
true.
yields the following:
?- allpartsincity(london).
p2 bolt green 17 paris
p5 cam blue 12 paris
p2 bolt green 17 paris
p6 cog red 19 london
p5 cam blue 12 paris
true.
I'm not sure what I'm missing, but I'd appreciate if someone could point me in the right direction.

distinct/1 is a quite new predicate. It is only of relevance, if the incremental evaluation is of importance either because of infinite data or because (for some obscure reason) the exact order of answers is of relevance. OK, and maybe also because there are many redundant answers and the space to store them would be forbidding, but then a good setof/3 implementation might use a similar technique as well. In your case, you have just a data base of finitely many facts.
Since 19821, the classic predicate for your purpose is setof/3.
You did not give a minimal reproducible example. So I need to do some guessing. In any case, do trust the prolog-toplevel for printing.
city_part(City, CPart) :-
setof(t, city_part0(City, CPart), _).
city_part0(City, part(Part, Name, Color, Num, X)) :-
proj(Project, _A1, City),
sppj(_A2, Part, Project, _A3),
part(Part, Name, Color, Num, X).
You can avoid the intermediary predicate, but then the variable quantification will become cumbersome. I have given these variables already the names A1, A2, A3. These plus Project are only internal variables.
city_part(City, CPart) :-
setof(t, A1^A2^A3^Project^
( CPart = part(Part, Name, Color, Num, X),
proj(Project, A1, City),
sppj(A2, Part, Project, A3),
part(Part, Name, Color, Num, X)
), _).

As you wrote it, the goal part/5 that provides displayed values is unrelated to the conjunction you asked for in distinct/1. If I understand your problem correctly, most likely you should use distinct/2 instead. Try for instance
allpartsincity(City):-
distinct(part(Part, Name, Color, Num, X), (proj(Project, _, City), sppj(_, Part, Project, _), part(Part, _, _, _, _))),
format('~w ~w ~w ~w ~w ~n', [Part, Name, Color, Num, X]),
fail
;
true.

Related

Proof as an output argument in Prolog meta interpreter

I am putting together a simple meta interpreter which outputs the steps of a proof. I am having trouble with getting the proof steps as an output argument. My predicate explain1 returns the proof in the detailed form that i would like, but not as an output argument. My predicate explain2 returns the proof as an output argument but not with the level of detail that i would like. Can explain2 be modified so that it yields as much info as explain1? I don't need it to output text "Explaining..." and "Explanation...", just the actual explanans and explanandum.
The toy data at the bottom of the program ("if healthy and rich, then happy") is just an example and the idea is to have a database with more facts about other things. I want to try to make a predicate that accepts an effect, e.g. happy(john), and returns an explanation for it. So the E argument of explain is supposed to be entered by the user; another query might thus be explain(_, smokes(mary), _) and so on. I can't get what i want directly from the C and E variables in explain, because i want the program to output steps in the Proof process, where C and E vary, e.g. "rich and healthy, so happy; wins so rich; TRUE so rich; TRUE so happy" and so on. I.e. return all causal links that lead up to an effect.
The excellent site by Markus Triska has some details on this, but i am having trouble adapting that code to my problem.
Any help would be greatly appreciated!
Thanks/JCR
My program:
main1:-explain1(_, happy(john), _), fail.
main2:-explain2(_, happy(john), _, T), writeln(T), fail.
explain1(C, E, P):-
C = ['True'],
p(C, E, P),
write('Explaining '), write(E),
write('. An explanation is: '), write(C),
write(' with probability '), write(P), nl.
explain1(C, E, P):-
p(C, E, P),
not(C = ['True']),
write('Explaining '), write(E),
write('. An explanation is: '), write(C),
write(' with probability '), write(P), nl.
explain1(C, E, P):-
p(C0, E, P0),
maplist(explain1, C1, C0, P1),
flatten(C1, C),
append([P0], P1, P2),
flatten(P2, P3),
foldl(multiply, P3, 1, P),
write('Explaining '), write(E),
write('. An explanation is: '), write(C),
write(' with probability '), write(P), nl.
explain2(C, E, P, T):-
C = ['True'],
p(C, E, P),
T = [C, E, P].
explain2(C, E, P, T):-
p(C, E, P),
not(C = ['True']),
T = [C, E, P].
explain2(C, E, P, T):-
p(C0, E, P0),
maplist(explain2, C1, C0, P1, _),
flatten(C1, C),
append([P0], P1, P2),
flatten(P2, P3),
foldl(multiply, P3, 1, P),
T = [C, E, P].
multiply(V1, V2, R) :- R is V1 * V2.
p(['True'], wins(john), 0.7).
p([wins(john)], rich(john), 0.3).
p(['True'], healthy(john), 0.9).
p([rich(john), healthy(john)], happy(john), 0.6).
The output of main1:
Explaining happy(john). An explanation is: [rich(john), healthy(john)] with probability 0.6
Explaining rich(john). An explanation is: [wins(john)] with probability 0.3
Explaining healthy(john). An explanation is: [True] with probability 0.9
Explaining happy(john). An explanation is: [wins(john), True] with probability 0.162
Explaining wins(john). An explanation is: [True] with probability 0.7
Explaining rich(john). An explanation is: [True] with probability 0.21
Explaining healthy(john). An explanation is: [True] with probability 0.9
Explaining happy(john). An explanation is: [True, True] with probability 0.1134
The output of main2:
[[rich(john), healthy(john)], happy(john), 0.6]
[[wins(john), True], happy(john), 0.162]
[[True, True], happy(john), 0.1134]
I'm unclear on the probability portion of this metainterpreter, but I actually think it's incidental to your question so I'm going to try and sketch out how I would approach this.
You can think of call/1 as the prototypical interpreter for Prolog, because it simply proves a single goal. So it seems like the API you want is something like prove(+Goal, -Proof), where Goal gets proven just like it does with call/1, but you get a second thing back, a proof of some kind.
When normal Prolog sees an expression like Goal1, Goal2, you could think of it expanding into call(Goal1), call(Goal2). So what does your proof-returning metainterpreter do in this situation instead? It should prove both goals and then somehow combine those "subproofs".
All this suggests to me that something missing from your conception is, what is the structure of a proof? I would think hard about what kind of thing you're going to get back, because if you don't want a string, you'll want something you can traverse more easily. It will probably wind up having a tree structure similar to what Prolog does (except without the failure branches). I would thus expect it to have some kind of nesting and it could certainly "resemble" the call stack somehow, although I expect this would limit its utility for you (how are you going to traverse that tree usefully for a generic query?).
Let's consider your base case. It's probably something like this:
prove(true, true) :- !.
True is intrinsically true, because it is true.
The next case I would be interested in is "and".
prove((G1, G2), (P1, P2)) :-
!,
prove(G1, P1),
prove(G2, P2).
This looks fairly tautological, but the key idea really is that we are combining the proofs of G1 and G2 with (P1, P2) in the proof.
The next case would be "or" probably:
prove((G1;_), P1) :- prove(G1, P1).
prove((_;G2), P2) :- !, prove(G2, P2).
This is the part where we are losing the failing branches. If the first branch succeeds, its proof will appear in the result; if the second branch succeeds instead, its proof will appear in the result. But they won't ever both appear in the result.
Finally we must handle builtins and user predicates, per a question I asked some time ago:
prove(H, subproof(H, Subproof)) :- clause(H, Body), prove(Body, Subproof).
prove(H, builtin(H)) :- call(H).
At this point we have a metainterpreter that produces very simple proofs. I'm going to add a few clauses and then try it with our metainterpreter:
mortal(X) :- man(X).
man(socrates).
Here's the query:
?- prove((member(X, [bread,socrates]), mortal(X)), Proof).
X = socrates,
Proof = (builtin(member(socrates, [bread, socrates])),
subproof(mortal(socrates),
subproof(man(socrates), true)))
For reasons I do not yet understand, the use of member/2 will bomb out on a second query. I have opened a question about that on the SWI forum and will update this answer when I find out what's going on there.
Update. The issue is related to the autoloading of library(lists) which happens when you use member/2. On the first call, member/2 has no clauses, so it enters call/1, which invokes the autoloader and then invokes it as a built-in. On a subsequent attempt, member/2 has clauses, but their bodies involve predicates in the lists module, and this metainterpreter does not handle modules properly. A quick-and-dirty solution is to change the third clause to this:
prove(H, subproof(H, Subproof)) :-
\+ predicate_property(H, imported_from(_)),
clause(H, Body),
prove(Body, Subproof).
I hope this helps!

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 to make fact(any) in Prolog?

I have database which consists of list of trees and facts about those trees. For example:
softness(soft).
softness(hard).
softness(veryhard).
color(gray_brown).
color(soft_red).
color(light).
color(dark).
wood(oak, leafes(leafed), softness(hard), color(gray_brown), on_touch(smalltexture)).
And I'm trying to make rule which will ask user input on specific parameters of tree and then seek for appropriate one. Like this.
what_wood(A, B):-
wood(A, B, _, _, _);
wood(A, _, B, _, _);
wood(A, _, _, B, _);
wood(A, _, _, _, B);
wood(A, B, _, _); %I have one tree with three parameters =/
wood(A, _, B, _);
wood(A, _, _, B).
what_wood(A) :-
write('Leafes: '), read(X), what_wood(A, leafes(X)),
write('Softness: '), read(Y), what_wood(A, softness(Y)),
write('Color: '), read(Z), what_wood(A, color(Z)),
write('On touch: '), read(Q), what_wood(A, on_touch(Q)).
So my question - if user wants to specify parameter as "any" is there a way to do something like this?
leafes(leafed).
leafes(coniferous).
leafes(any):-
leafes(X). %this one doesn't work. Prints false
%leafes(leafed);leafes(coniferous). %Of course this doesn't work too.
(Sorry for my English :) )
=====UPDATE=====
I ended up with this code which works fine thanks to you :)
Will add check for user input also.
wood(oak, leafed).
wood(oak, hard).
wood(oak, gray_brown).
wood(oak, smalltexture).
wood(beech, leafed).
wood(beech, hard).
wood(beech, soft_red).
wood(beech, largetexture).
wood(yew, leafed).
wood(yew, veryhard).
wood(yew, dark).
...
what_wood(A, B, C, D, E):-
wood(A, B), wood(A, C), wood(A, D), wood(A, E).
what_wood(A) :-
write('Leafes: '), read(X), convert(X, Leaves),
write('Softness: '), read(Y), convert(Y, Softness),
write('Color: '), read(Z), convert(Z, Color),
write('On touch: '), read(Q), convert(Q, OnTouch),
what_wood(A, Leaves, Softness, Color, OnTouch).
convert(any, _) :-
!.
convert(Attrib, Attrib).
This code returns same answers like
A = oak ;
A = oak ;
...
A = beech ;
A = beech .
But this is other story which have nothing to do with current question.
Assuming that the number of wood attributes is fixed, four in your example, you can define a predicate wood/5with facts such as:
% wood(Wood, Leaves, Softness, Color, OnTouch).
wood(oak, leafed, hard, gray_brown, smalltexture).
Then, you can modify your what_wood/1 predicate such that when the user enters the atom any for an attribute, it uses an anonymous variable when trying to match wood/5 facts. Something like:
what_wood(Wood) :-
write('Leafes: '), read(Leafes0), convert(Leafes0, Leafes),
write('Softness: '), read(Softness0), convert(Softness0, Softness),
write('Color: '), read(Color), convert(Color0, Color),
write('On touch: '), read(OnTouch), convert(OnTouch0, OnTouch),
wood(Wood, Leaves, Softness, Color, OnTouch).
convert(any, _) :-
!.
convert(Attribute, Attribute).
The next step would be to check the validity of the values entered by the user and e.g. repeat the question if invalid. For example, you could define a read_attribute/2 predicate that would do the reading repeating it until the user enters a valid value:
read_attribute(Attribute, Value) :-
repeat,
write('Value for '), write(Attribute), write(': '),
read(Value),
valid_attribute(Attribute, Value),
!.
valid_attribute(leafes, leafed).
valid_attribute(leafes, coniferous).
valid_attribute(leafes, any).
...
This can be improved in several ways. E.g. by printing the possible values for an attribute when asking its value so that the user knows what is accepted as valid values. The predicate valid_attribute/2 can also be rewritten to avoid creating choice points when testing. You can also rewrite this predicate to take advantage of the facts you already have for valid attributed values:
valid_attribute(Attribute, Value) :-
Test =.. [Attribute, Value],
once(Test).
Prolog is a language with a clean relational data model. I would choose a different schema, separating each attribute: like
wood(oak, leafes(leafed)).
wood(oak, softness(hard)).
...
in this way you can rely on the usual relational patterns to apply in your 'application'. Specifically, Prolog use queries as procedures...

Querying each element of a list

I am doing homework for AI class and I am writing a prolog program.
I am supposed to take a list of names and check if each person in the list belongs to a specific country chosen.
what i have so far
% facts
person(bruce, australia, rhodri, bronwyn).
person(rhodri, newyork, dan, mary).
person(bronwyn, miami, gar, roo).
person(dan, miami, george, mimi).
person(mary, texas, mack, tiki).
person(gar, jamaica, zid, rem).
person(roo, newzealand, john, jill).
person(tom, mayday, dick, mel).
person(dick, newyork, harry, rin).
person(mel, miami, tom, stacey).
person(harry, miami, george, mimi).
person(rin, texas, mack, tiki).
person(tom, jamaica, zid, rem).
person(stacey, newzealand, john, jill).
% rules
eligible(P,C) :-
person(P, C, F, M) , !
; person(F, C, Newfather, Newmother), !
; person(M, C, Newfather, Newmother), !
; person(Newfather, C, Grandfather , Grandmother), !
; person(Newmother, C, Grandfather, Grandmother).
checkteam([] , C).
checkteam([H|T] , C) :- eligible(H, C) , checkteam(T, C).
the last two lines in particular i am having issues with, i am trying to test each member of the list with the eligible() function then let the first element of tail become the head and repeat.
I cant figure out a way to test each member and then display a fail if any of the members are not eligible or true if all members belong to that country.
Thanks in advance.
EDIT: was fooling around and changed the code a little, as for results
?- checkteam([bruce, dan], mayday).
true.
even though neither bruce or dan are from mayday or any parents or grandparents that do.
Your eligible predicate doesn't make sense to me (probably I am misunderstanding). But, if person is defined as person(Name, Country, Father, Mother) then it could be:
eligible(Name, Country) :- person(Name, Country, _, _).
eligible(Name, Country) :- person(Name, _, Father, _),
person(Father, Country, _, _).
eligible(Name, Country) :- person(Name, _, _, Mother),
person(Mother, Country, _, _).
Then your checkteam should still give you a warning. Put an underscore at the beginning of the variable name to get rid of it:
checkteam([], _Country).

English constraint free grammar prolog

I ran into an infinite recursion problem while trying to implement a very simple constraint free grammar in prolog.
Here are my rules: (vp -> verb phrase, np -> noun phrase, ap -> adj phrase, pp -> prep phrase)
verb(S) :- member(S, [put, pickup, stack, unstack]).
det(S) :- member(S, [the]).
adj(S) :- member(S, [big, small, green, red, yellow, blue]).
noun(S) :- member(S, [block, table]).
prep(S) :- member(S, [on, from]).
vp([V|R]) :- verb(V), pp(PP), np(NP), append(NP, PP, R).
np([D, N]) :- det(D), noun(N).
np([D|R]) :- det(D), ap(AP), noun(N), append(AP, [N], R).
ap([A]) :- adj(A).
ap([A|R]) :- adj(A), ap(R).
pp([P|R]) :- prep(P), np(R).
The problem im running into is that the rule for ap can produce arbitrarily long strings of adjectives, so at some point, i get stuck trying to satisfy the query by trying all these infinite possibilities.
For example, the following query will never produce S = [put, the, red, block, on, the, green, block] because it will first expand the adjective phrase on the left "red" to infinite possibilities before ever trying on the right.
?- vp(S)
S = [put, the, red, green, block, on, the, block] ;
The short answer is: Use Definite Clause Grammars (dcg) to represent your grammar. See this answer for a typical encoding.
But now to your actual problem in your program. Not only will you not get the desired answer ; the situation is worse: even in a much simpler fragment of your program will you have the very same problems. Here is the smallest fragment of your program that still does not terminate:
verb(S) :- member(S, [put, pickup, stack, unstack]).
det(S) :- member(S, [the]).
adj(S) :- member(S, [big, small, green, red, yellow, blue]).
noun(S) :- false, member(S, [block, table]).
prep(S) :- member(S, [on, from]).
vp([V|R]) :- verb(V), pp(PP), false, np(NP), append(NP, PP, R).
np([D, N]) :- false, det(D), noun(N).
np([D|R]) :- det(D), ap(AP), false, noun(N), append(AP, [N], R).
ap([A]) :- false, adj(A).
ap([A|R]) :- adj(A), ap(R), false.
pp([P|R]) :- prep(P), np(R), false.
?- vp([put, the, red, green, block, on, the, block]).
By inserting goals false we got a small fragment of your program that still does not terminate.
The actual source is ap/1 which is recursive but not limited by the actual input. See failure-slice for more examples.
There is no easy way out to fix your program. The easiest way out is to use grammars.
Seems like you're are abusing of Prolog generative power, placing append at last position. I tried to change to a more sensible place:
...
vp([V|R]) :- verb(V), append(NP, PP, R), pp(PP), np(NP).
np([D, N]) :- det(D), noun(N).
np([D|R]) :- det(D), append(AP, [N], R), ap(AP), noun(N).
...
and now your parser apparently works.
?- vp([put, the, red, green, block, on, the, block]).
true .
but I suggest, as already false did (+1), to switch to DCG for parsing.
The fundamental problem is that Prolog is defined to do a DFS over rules, so when it comes to generation problems across an infinite search space (as with your case), parts of the space can get untouched. A platform-independent fix is to augment the grammar with a depth bound, and decrement the depth at each recursive call. Once the depth reaches 0, fail. By incrementally increasing the depth with repeated queries (e.g., vp(S, 1). vp(S, 2).), you guarantee that all parts of the state space will get touched eventually.
This is basically just iterative deepening. If you're on SWI-PL, you can also use the call_with_depth_limit/3 predicate to do the exact same thing without modifying the grammar.

Resources