Related
I have a set of facts in Prolog, such that:
likes(alice, burger).
likes(bob, burger).
likes(charlie, burger).
likes(bob, sandwich).
likes(charlie, sandwich).
likes(alice, muffin).
I want to know what's the most popular dish (burgers in the example above). I'm not interested in the 2nd, 3rd, etc most popular for this query as the list of preferences can be really long.
I'm struggling to write this query in SWI-Prolog. Can you help me?
most_popular(Popular) :-
findall(X, likes(_, X), Xs),
sort(0, #=<, Xs, Items),
clumped(Items, Counts),
sort(2, #>=, Counts, [Popular|_]).
findall/3 pulls them out of the Prolog database into a list.
clumped/2 really does run length encoding, but if they are sorted first that is the same as counting them.
then sort them by the count (sort/4 first parameter is which part of the term to sort by. Item-Count is really the compound -(Item,Count) so 0 sorts with normal term sorting, 1 gets the Item name to sort by or 2 gets the Count to sort by) and unify the first element of the resulting list as the answer.
?- most_popular(Item-Count).
Count = 3,
Item = burger
I can't seem to wrap my head around how Prolog actually works. I'm very used to other programming languages like Java and Python but Prolog seems to be very different since it is based on a set of logical statements.
If someone can explain to me how I would approach a situation where I am given a set of rules such as
likes(john,mary).
likes(mary,adam).
likes(adam,mary).
likes(jack,destiny).
likes(destiny,adam).
likes(brianna,adam).
and I want to find out how to see who is the most liked person (in this case adam = 3), how would I do this?
Maybe it's easier if you think of Prolog as a special database retrieval language that can morph into functional programming in the same line.
Here we we have a relation likes/2 over which we want to run statistics.
One could use predicates from library(aggregate) or similar, but let's not
Suggestion is to chain three operations:
Create a nicer structure to run stats
Run stats over nicer structure
Find the best
Create nicer structure to run stats
Collect
the vector (in the form or a Prolog list) of persons that occur as second argument in predicate likes/2 (so that we have something to count), and
the set of persons (also in the form of a Prolog list) so that we can iterate over something.
The key are the collection predicates findall/3 and setof/3
findall/3 is used to collect all the Person that appear on second argument position of likes/2,
setof/3 is used to collect the set of all Person that appear on first or second argument position of likes/2.
To make that work, setof/3 needs to be told that the argument on the other position is unimportant by
"existentially quantifying" it with X^.
person_occurrences(PersonVec) :-
findall(Person,likes(_,Person),PersonVec).
person_set(PersonSet) :-
setof(Person,X^(likes(Person,X);likes(X,Person)),PersonSet).
Alternativey for person_set/2, more comprehensible:
person(Person) :- likes(Person,_).
person(Person) :- likes(X,Person).
person_set(PersonSet) :- setof(Person,person(Person),PersonSet).
Trying this on the "Prolog Toplevel" shows we are on the right track:
?- person_occurrences(PersonSet).
PersonSet = [mary, adam, mary, destiny, adam, adam].
?- person_set(PersonSet).
PersonSet = [adam, brianna, destiny, jack, john, mary].
We can easily count how often a person occurs in the vector of persons,
by using findall/3 to create an arbitrary list of x (for example),
one x for each occurrence, then determining the length of that list:
count(Person,PersonVec,Count) :-
findall(x,member(Person,PersonVec),Xs),length(Xs,Count).
Trying this on the "Prolog Toplevel" shows we are on the right track:
?- person_occurrences(PersonVec),count(mary,PersonVec,Count).
PersonVec = [mary, adam, mary, destiny, adam, adam],
Count = 2.
We now have the "nicer structure" that we can use to do stats, namely the
"vector of persons" and the "set of persons".
Run stats over nicer structure
The result here, called Stats shall be a list (it's always lists) of
pairs -(NumberOfOccurrencesOfPersonInPersonVector,Person),
which can be more easily written "infix": Count-Person, for example 2-mary.
This is a recursive definition (or an inductive definition) whereby we "count"
for each person element in PersonSet until the PersonSet is the empty set
(or rather, the empty list), upon which we are done and succeed. The result
is constructed in the third argument:
% stats(PersonVec,PersonSet,Stats)
stats(_,[],[]).
stats(PersonVec,[Person|MorePersons],[Count-Person|MoreStats]) :-
count(Person,PersonVec,Count), % count them
stats(PersonVec,MorePersons,MoreStats). % recursion
Trying this on the "Prolog Toplevel" shows we are on the right track:
?- person_occurrences(PersonVec),stats(PersonVec,[mary],Stats).
PersonVec = [mary, adam, mary, destiny, adam, adam],
Stats = [2-mary] ; % Maybe more solutions?
false. % Nope.
New we can build the whole of the stats list:
stats(Stats) :-
person_occurrences(PersonVec),
person_set(PersonSet),
stats(PersonVec,PersonSet,Stats).
Trying this on the "Prolog Toplevel" shows we are on the right track:
?- stats(Stats).
Stats = [3-adam, 0-brianna, 1-destiny, 0-jack, 0-john, 2-mary] ;
false.
Find the best
Given Stats, we can find a BestPerson by maximizing over the list of pairs.
This can be done directly by selecting the pair which is "largest"
according to "the standard order of term": the numeric count comes first
so a term with a larger numeric count is "larger" than one with a
smaller numeric count, which is what we want. The predicate
max_member/2
does what we want:
best(Stats,BestPerson,BestCount) :-
max_member(BestCount-BestPerson,Statss).
Alternatively, we can program-out the max_member/2 (and keep
it to numeric comparison of the first argument, AND get several
answers in case there are several persons with the same "likes"
count), like so:
% start the maximization over Stats with a dummy "(-1)-nobody"
best(Stats,BestPerson,BestCount) :-
best2(Stats, (-1)-nobody, BestCount-BestPerson).
% best2(Stats,BestCountSoFar-BestPersonSoFar,Result).
best2([],BestCountSoFar-BestPersonSoFar,BestCountSoFar-BestPersonSoFar).
best2([Count-_|MoreStats],BestCountSoFar-BestPersonSoFar,Result) :-
Count < BestCountSoFar,
best2(MoreStats,BestCountSoFar-BestPersonSoFar,Result). % keep best
best2([Count-_|MoreStats],BestCountSoFar-BestPersonSoFar,Result) :-
Count == BestCountSoFar,
best2(MoreStats,BestCountSoFar-BestPersonSoFar,Result). % keep best (2nd possibility below)
best2([Count-Person|MoreStats],BestCountSoFar-_,Result) :-
Count >= BestCountSoFar,
best2(MoreStats,Count-Person,Result). % take new, better, pair
Conclude
We run it together:
?- stats(Stats),best(Stats,BestPerson,BestCount).
Stats = [3-adam, 0-brianna, 1-destiny, 0-jack, 0-john, 2-mary],
BestPerson = adam, BestCount = 3 ; % maybe more solutions?
false. % no
Complete code
likes(john,mary).
likes(mary,adam).
likes(adam,mary).
likes(jack,destiny).
likes(destiny,adam).
likes(brianna,adam).
person_occurrences(PersonVec) :-
findall(Person,likes(_,Person),PersonVec).
person_set(PersonSet) :-
setof(Person,X^(likes(Person,X);likes(X,Person)),PersonSet).
count(Person,PersonVec,Count) :-
findall(x,member(Person,PersonVec),Xs),length(Xs,Count).
% stats(PersonVec,PersonSet,Stats)
stats(_,[],[]).
stats(PersonVec,[Person|MorePersons],[Count-Person|MoreStats]) :-
count(Person,PersonVec,Count), % count them
stats(PersonVec,MorePersons,MoreStats). % recursion
stats(Stats) :-
person_occurrences(PersonVec),
person_set(PersonSet),
stats(PersonVec,PersonSet,Stats).
% start the maximization over Stats with a dummy "(-1)-nobody"
best(Stats,BestPerson,BestCount) :-
best2(Stats, (-1)-nobody, BestCount-BestPerson).
% best2(Stats,BestCountSoFar-BestPersonSoFar,Result).
best2([],BestCountSoFar-BestPersonSoFar,BestCountSoFar-BestPersonSoFar).
best2([Count-_|MoreStats],BestCountSoFar-BestPersonSoFar,Result) :-
Count < BestCountSoFar,
best2(MoreStats,BestCountSoFar-BestPersonSoFar,Result). % keep best
best2([Count-_|MoreStats],BestCountSoFar-BestPersonSoFar,Result) :-
Count == BestCountSoFar,
best2(MoreStats,BestCountSoFar-BestPersonSoFar,Result). % keep best (2nd possibility below)
best2([Count-Person|MoreStats],BestCountSoFar-_,Result) :-
Count >= BestCountSoFar,
best2(MoreStats,Count-Person,Result). % take new, better, pair
Consider the set of facts:
likes(john,mary).
likes(mary,adam).
likes(adam,mary).
likes(jack,destiny).
likes(destiny,adam).
likes(brianna,adam).
Another possible solution is as follows:
You can use setof/3 to get the list of persons that like someone:
?- setof(Person, likes(Person,Someone), ListOfPersons).
Someone = adam,
ListOfPersons = [brianna, destiny, mary] ;
Someone = destiny,
ListOfPersons = [jack] ;
Someone = mary,
ListOfPersons = [adam, john].
Then, you can combine setof/3 with findall/3 to get a list of pairs of the form Someone-ListOfPersons:
?- findall(Someone-ListOfPersons, setof(Person, likes(Person,Someone), ListOfPersons), Pairs).
Pairs = [adam-[brianna, destiny, mary], destiny-[jack], mary-[adam, john]].
After that, you can use maplist/3 to map pairs of the form Someone-ListOfPersons into corresponding pairs of the form Someone-NumberOfPersons:
?- findall(Someone-ListOfPersons, setof(Person, likes(Person,Someone), ListOfPersons), Pairs),
maplist([Someone-ListOfPersons, Someone-NumberOfPersons]>>length(ListOfPersons,NumberOfPersons), Pairs, NewPairs).
Pairs = [adam-[brianna, destiny, mary], destiny-[jack], mary-[adam, john]],
NewPairs = [adam-3, destiny-1, mary-2].
Finally, you can use sort/4 to get the most liked person:
?- findall(Someone-ListOfPersons, setof(Person, likes(Person,Someone), ListOfPersons), Pairs),
maplist([Someone-ListOfPersons, Someone-NumberOfPersons]>>length(ListOfPersons,NumberOfPersons), Pairs, NewPairs),
sort(2,>=,NewPairs, SortedPairs).
Pairs = [adam-[brianna, destiny, mary], destiny-[jack], mary-[adam, john]],
NewPairs = [adam-3, destiny-1, mary-2],
SortedPairs = [adam-3, mary-2, destiny-1].
Thus, the final solution is:
most_liked(Person) :-
findall(Someone-ListOfPersons,
setof(Person, likes(Person,Someone), ListOfPersons),
Pairs),
maplist([Someone-ListOfPersons, Someone-NumberOfPersons]>>length(ListOfPersons, NumberOfPersons),
Pairs,
NewPairs),
sort(2, >=, NewPairs, [Person-_|_]).
Running example:
?- most_liked(Person).
Person = adam.
Another solution where we don't care about the admonition to "do things only once" and "let Prolog work for us" instead is simply this:
Determine how much an arbitrary person is "liked"
person_liked_count(Person,Count) :-
likes(_,Person), % Grab a Person
findall(x, % Create a list of 'x'
likes(_,Person), % one 'x' for each like of the Person
Xs), % and this will be list 'Xs'.
length(Xs,Count). % The number of likes is the length of the list
We now get multiple solutions for any person, but we don't care:
?- person_liked_count(Person,Count).
Person = mary, Count = 2 ;
Person = adam, Count = 3 ;
Person = mary, Count = 2 ;
Person = destiny, Count = 1 ;
Person = adam, Count = 3 ;
Person = adam, Count = 3.
Maximize by doing exactly what is demanded
Person with "likes count" Count is what we want if we have person_liked_count(Person,Count) and there is no other person that has higher count (there is no need to even check that _PersonOther is different from Person inside the negation-as-failure-marked-subgoal, although we can):
most_liked(Person,Count) :-
person_liked_count(Person,Count), % grab a Person and a Count
\+ (person_liked_count(_P,CountOther), % "where not exists" a person _P
CountOther > Count). % with a higher count
We now get several answers, but that is not a problem as they are all the same:
?- most_liked(Person,Count).
Person = adam, Count = 3 ;
Person = adam, Count = 3 ;
Person = adam, Count = 3.
We can always force determinism with once/1
?- once(most_liked(Person,Count)).
Person = adam, Count = 3.
Everything in one block
likes(john,mary).
likes(mary,adam).
likes(adam,mary).
likes(jack,destiny).
likes(destiny,adam).
likes(brianna,adam).
person_liked_count(Person,Count) :-
likes(_,Person), % Grab a Person
findall(x, % Create a list of 'x'
likes(_,Person), % one 'x' for each like of the Person
Xs), % and this will be list 'Xs'.
length(Xs,Count). % The number of likes is the length of the list
most_liked(Person,Count) :-
person_liked_count(Person,Count), % grab a Person and a Count
\+ (person_liked_count(_P,CountOther), % "where not exists" a person _P
CountOther > Count). % with a higher count
solution(Person,Count) :- once(most_liked(Person,Count)).
I'm trying to write a predicate that calculates which destination a group of friends will visit.
The friends list their countries of preferences like this
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
I want to write a predicate called where that takes 2 arguments to perform the calculation.
The formula I have in mind is that the first country is worth 3 points, the second one is worth 2 points, and the last one is worth 1 point.
Here's an example of what I'm trying to achieve.
?- where([marie,jean,sasha,helena,emma],Country).
peru .
So far I have this
where([], X).
where([H|T], N) :- choice(H, [A|B]), where(T,N).
It lets me iterate through all the different friends and shows their choices but I can't iterate through the list of choices and assign points to the destinations.
How should I go about iterating through the list of choices for each friend and assigning points to calculate the best destination?
While this will solve your problem, I know it uses many predicates that you have not seen. So think of this an opportunity to excel and learn a lot.
Even if you don't understand it all, there is enough detail and intermediate results in the test that you should be able to navigate your way to a proper solution you create.
Also this is by no means efficient, it was just a quick proof of concept I did to see how this could be done.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
destinations(Destinations) :-
findall(D1,choice(_,D1),D2),
flatten(D2,D3),
list_to_set(D3,Destinations).
init_weights(Destinations,Weights) :-
empty_assoc(Assoc),
init_weights(Destinations,Assoc,Weights).
init_weights([],Weights,Weights).
init_weights([H|T],Assoc0,Weights) :-
put_assoc(H,Assoc0,0,Assoc1),
init_weights(T,Assoc1,Weights).
update_weights([C1,C2,C3],Weights0,Weights) :-
del_assoc(C1,Weights0,Value0,Weights1),
Value1 is Value0 + 3,
put_assoc(C1,Weights1,Value1,Weights2),
del_assoc(C2,Weights2,Value2,Weights3),
Value3 is Value2 + 2,
put_assoc(C2,Weights3,Value3,Weights4),
del_assoc(C3,Weights4,Value4,Weights5),
Value5 is Value4 + 1,
put_assoc(C3,Weights5,Value5,Weights).
person_weight(Person,Weights0,Weights) :-
choice(Person,[C1,C2,C3]),
update_weights([C1,C2,C3],Weights0,Weights).
people(People) :-
findall(Person,choice(Person,_),People).
choice(Destination) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights1),
cross_ref_assoc(Weights1,Weights),
max_assoc(Weights, _, Destination),
true.
cross_ref_assoc(Assoc0,Assoc) :-
assoc_to_list(Assoc0,List0),
maplist(key_reverse,List0,List),
list_to_assoc(List,Assoc).
key_reverse(Key-Value,Value-Key).
update_choices([],Weights,Weights).
update_choices([Person|People],Weights0,Weights) :-
person_weight(Person,Weights0,Weights1),
update_choices(People,Weights1,Weights).
Tests
:- begin_tests(destination).
test(destinations) :-
destinations([peru, greece, vietnam]).
test(init_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights),
assoc_to_list(Weights,[greece-0, peru-0, vietnam-0]).
test(update_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
update_weights([peru,greece,vietnam],Weights0,Weights),
assoc_to_list(Weights,[greece-2,peru-3,vietnam-1]).
test(person_weight) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
person_weight(jean,Weights0,Weights),
assoc_to_list(Weights,[greece-3,peru-2,vietnam-1]).
test(people) :-
people([marie,jean,sasha,helena,emma]).
test(update_choices) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights),
assoc_to_list(Weights,[greece-10,peru-12,vietnam-8]).
test(cross_ref_assoc) :-
List0 = [1-a,2-b,3-c],
list_to_assoc(List0,Assoc0),
cross_ref_assoc(Assoc0,Assoc),
assoc_to_list(Assoc,[a-1,b-2,c-3]).
test(choice) :-
choice(peru).
:- end_tests(destination).
As suggested by GuyCoder, you need an accumulator to sum each person preferences, and foldl/N allows to does exactly this.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
where(People,Where) :-
foldl([Person,State,Updated]>>(choice(Person,C),update(State,C,Updated)),
People,
[0=greece,0=peru,0=vietnam],
Pref),
aggregate(max(S,S=W),member(S=W,Pref),max(_,_=Where)).
% sort(Pref,Sorted),
% last(Sorted,_=Where).
update(S0,[A,B,C],S3) :-
update(S0,3,A,S1),
update(S1,2,B,S2),
update(S2,1,C,S3).
update(L,V,C,U) :-
append(X,[Y=C|Z],L),
P is Y+V,
append(X,[P=C|Z],U).
I have left commented the last two goals replaced by the single goal aggregate/3, so you can try to understand the syntax...
I have written a Prolog code to find the cardinality of a list ie number of distinct elements. It gives correct output but it runs multiple times and I cant seem to get my head around it. I have used the debugger but cant understand whats wrong
member(A, [A|_]).
member(A, [_|L]) :- member(A, L).
crdnlty([],0).
crdnlty([A|R],N) :-
(
\+ member(A, R),
crdnlty(R, N1),
N is N1+1
);
(
member(A, R),
crdnlty(R, N)
).
member checks if A is present in the remaining list.
if its not present ie it is the last occurrence of that element cardinality is increased by 1.
for example if i run the query
crdnlty([1,2,1,1], N).
it returns
N = 2 ;
N = 2 ;
false.
but it should return
N = 2 ;
false.
This is not answer but just a testing suggestion that doesn't fit in a comment.
Besides the unwanted duplicated solution, there's also the question on how to test the predicate. A simple alternative solution is to use the ISO Prolog standard predicate sort/2 and the de facto standard predicate length/2. The alternative solution could be:
cardinality(List, Cardinality) :-
sort(List, Sorted),
length(Sorted, Cardinality).
We can use this alternative solution to define a property that your solution must comply with that allows to QuickCheck your solution (ignoring for now the unwanted non-determinism):
property(List) :-
once(crdnlty(List, C)),
sort(List, S),
length(S, C).
Using the QuickCheck implementation provided by Logtalk's lgtunit tool (which you can run in most Prolog systems; in this example I will be using GNU Prolog):
$ gplgt
...
| ?- {lgtunit(loader)}.
...
% (0 warnings)
(578 ms) yes
| ?- lgtunit::quick_check(property(+list(integer)), [n(2000)]).
% 2000 random tests passed
(1589 ms) yes
Of course, QuickCheck can show bugs but cannot prove their absence. That said, a distinctive feature of Logtalk's QuickCheck implementation is that it tries trivial/corner cases for the specified types before generating random values. This help in ensuring that the random testing will not miss obvious test cases (as we illustrate next).
What happens if we test instead the solution provided by Scott Hunter?
| ?- lgtunit::quick_check(property(+list(integer)), [n(2000)]).
* quick check test failure (at test 1 after 0 shrinks):
* property([])
no
In fact, his solution doesn't take into account that the list may be empty. Assuming that's considered a bug, adding the missing clause:
crdnlty([], 0).
Re-testing:
| ?- lgtunit::quick_check(property(+list(integer)), [n(2000)]).
% 2000 random tests passed
(1509 ms) yes
It might be better to build a list of distinct elements & yield its length for the cardinality:
crdnlty([A|R],N) :- distinct(R,N,[A],1).
% distinct(L,N,DL,DN): There are N distinct values in list L+DL,
% assuming there are DN distinct values in list DL alone.
distinct([],N,_,N).
distinct([A|R],N,DL,DN) :-
(
\+ member(A, DL),
DN1 is DN+1,
distinct(R, N, [A|DL], DN1)
);
(
member(A, DL),
distinct(R, N, DL, DN)
).
I'm looking for a way to count the numbers of predicates.
Example:
%facts
has_subclass(thing,animal).
has_subclass(thing,tree).
has_subclass(thing,object).
% and I ask
count_has_subclass(thing,X).
% result
X = 3.
For facts like your example:
count_has_subclass(What, Count):-
findall(1, call(has_subclass(What, _)), L),
length(L, Count).
We can use findall/3 for this, and then use length/2 to obtain the length of the list:
count_has_subclass(What, N):-
findall(X, has_subclass(What, X), L),
length(L, N).
If it is however possible that has_subclass/2 yields the same values multiple times for a given key (like thing), then we can use for example sort/2 as a duplicate filter, like:
count_has_subclass(What, N):-
findall(X, has_subclass(What, X), L),
sort(L, S), %% remove duplicates
length(S, N).
Note that if What is a free variable, then you will count all yeilds of has_subclass(_, _). (optionally with a uniqness filter on the second parameter).
Using the standard setof/3 is a better option as it allows easy definition of a more general predicate that can enumerate solutions when the class argument is not bound. For example, assume the following database:
has_subclass(thing,animal).
has_subclass(thing,tree).
has_subclass(thing,object).
has_subclass(animal,cat).
has_subclass(animal,dog).
has_subclass(tree,pine).
has_subclass(tree,oak).
And the definition:
subclass_count(Class, Count) :-
setof(Subclass, has_subclass(Class, Subclass), Subclasses),
length(Subclasses, Count).
Sample call:
| ?- subclass_count(Class, Count).
Class = animal
Count = 2 ? ;
Class = thing
Count = 3 ? ;
Class = tree
Count = 2
yes
If you try instead one of the findall/3 solutions in the other answers, we get instead:
| ?- count_has_subclass(What, Count).
Count = 7
But note that this solution also have a sensible interpretation as returning the number of all existing subclasses when the class is not specified.
To build a list just to count solutions seems 'old style', but in traditional Prolog there is only the DB (assert/retract) alternative to overcome the 'stateless' nature of computations. Indeed findall/3 and friends builtins could be (naively) rewritten by means of assert/retract. But something have shown up since the early 80's ages :). I illustrate with SWI-Prolog, but - more or less naively - all of them could be implemented by assert/retract. Of course, most Prolog implementations have 'non logical' (or 'imperative', or 'impure') facilities to implement such basic task, without resorting to the heavyweight DB interface - like setarg/3, nb_setval/2 and others...
I digress... library(aggregate) should be shown first:
?- aggregate(count, T^has_subclass(thing,T), C).
C = 3.
This lib is well worth to study, does a lot more than - efficiently - counting...
Another, recent, addition is library(solution_sequences). It's not more efficient than setof/3 + length/2, guess, but interesting in its own. Counting is a bit more involved, and uses call_nth/2:
?- order_by([desc(C)],call_nth(has_subclass(thing,T),C)).
C = 3,
T = object ;
...
Some far simpler code of mine, based on nb_setarg/3 (and help from #false):
?- [carlo(snippets/lag)].
true.
?- integrate(count,has_subclass(thing,T),C).
C = 3.