Prolog do predicate for all pairs in List?

1
votes

I have a set of possibilities in a Prolog script and want to find the largest set, where a particular predicate applied to all pairs of the list evaluates true.

A simplified example would be a set of people, and you want to find the largest group where all of them are mutual friends. So, given:

% Four-way friend CIRCLE
link(tom, bill).
link(bill, dick).
link(dick, joe).
link(joe, tom).

% Four-way friend WEB
link(jill, sally).
link(sally, beth).
link(beth, sue).
link(sue, jill).
link(jill, beth).
link(sally, sue).

% For this example, all friendships are mutual
friend(P1, P2) :- link(P1, P2); link(P2, P1).

The possible matches should be (presenting each pair alphabetically for clarity):

% the two-person parts of both sets :
[bill, tom], [bill, dick], [dick, joe], [joe, tom],
[jill, sally], [beth, sally], [beth, sue], [jill, sue],
  [beth, jill], [sally, sue]

% any three of the web :
[beth, jill, sally], [beth, sally, sue], [beth, jill, sue]

% and the four-person web :
[beth, jill, sally, sue]

I can find all the two-person matches with:

% Mutual friends?
friendCircle([Person1, Person2]) :-
    friend(Person1, Person2),
    % Only keep the alphabetical-order set:
    sort([Person1, Person2], [Person1, Person2]).

But then I get snagged trying to find the larger sets:

friendCircle([Person1|Tail]) :-
    friendWithList(Person1, Tail),
    Tail = [Person2|Tail2],
    % Only keep if in alphabetical order:
    sort([Person1, Person2], [Person1, Person2]),
    friendWithList(Person2, Tail2).

% Check all members of the list for mutual friendship with Person:
friendWithList(Person, [Head|Tail]) :-
    friend(Person, Head), % Check first person in list
    friendWithList(Person, Tail). % Check rest of list

But when I run that, after enumerating the two-person lists, Prolog just hangs and eventually runs out of stack space. What am I doing wrong?

What I'm trying to do is walk the web, which for a five-friend web would be checking each of these pairs for friend status:

(1,2) (1,3), (1,4), (1,5) % Compare element 1 with the rest of the list
      (2,3), (2,4), (2,5) % Remove element 1 and repeat
             (3,4), (3,5)
                    (4,5)

Which is what I thought my two friendsWithList/2 calls in the friendCircle/1 rule were doing.

3
prolog
Note that sort([Person1, Person2], [Person1, Person2]) is just a complicated way of saying Person1 @=< Person2. – Fred Foo
@larsman: A complicated way it is indeed. But it is not evident, what you are saying. Consider: ?- Person1 = john, sort([Person1, Person2], [Person1, Person2]). which gives Person2 = john. – false

3 Answers

2
votes

I believe you are entering a loop. You should check to see if you already 'visited' a friend when building the friend circle.

My take on this:

friendCircle(Friends):-
  findall(SFriendCircle,
    (
      friend(Person1, Person2),
      friendCircle([Person1, Person2], FriendCircle),
      sort(FriendCircle, SFriendCircle)
     ),
    LFriends),
  sort(LFriends, SFriends),
  member(Friends, SFriends).

friendCircle([From|Tail], Friends):-
  friend(From, To),
  \+ member(To, Tail),
  forall(member(Friend, Tail), friend(To, Friend)),
  friendCircle([To,From|Tail], Friends).
friendCircle(Friends, Friends).

Test: 

?- friendCircle(Friends).
Friends = [ben, tom] ;
Friends = [dick, joe] ;
Friends = [dick, joe, tom] ;
Friends = [dick, tom] ;
Friends = [joe, tom].
1
votes

Here's the cleaned-up version I ended up using (with comments for added clarity), which eliminates the bagof, sort and findall calls (and forall, if your prolog doesn't have that):

% Four-way friend CIRCLE
link(tom, bill).
link(bill, dick).
link(dick, joe).
link(joe, tom).

% Four-way friend WEB
link(jill, sally).
link(sally, beth).
link(beth, sue).
link(sue, jill).
link(jill, beth).
link(sally, sue).

% Assume if one is friends with the other, it's reflexive
friend(Person1, Person2) :- (link(Person1, Person2); link(Person2, Person1)).

% Replace a forall/2 call
friendWithList(_, []).
friendWithList(Person, [Friend|Tail]) :-
    friend(Person, Friend),
    friendWithList(Person, Tail).

% Build a friend web
friendCircle(Friends):-
    friend(Person1, Person2), % Start with two random friends...
    Person1 @=< Person2, % ...who are in alphabetical order.
    validCircle([Person1, Person2], Friends). % Build a web with them.


% Given a valid web in the first parameter,
% find a valid web and put it in the second parameter.

% Because the input is a valid web, the simplest output is itself:
validCircle(Friends, Friends).

% The other option is to try and grow the web:
validCircle([Person|Tail], Output):-
    friend(Person, NewGuy), % Grab a friend of the first person in the list... 
    NewGuy @=< Person, % ...who alphabetically comes before that person...
    \+ member(NewGuy, Tail), % ...and we don't have in the list already.

    % Check that the new guy is friends with everyone already on the list
    % If you have the forall/2 predicate,
    % you can swap the comment on the next two lines
    friendWithList(NewGuy, Tail), 
    %forall(member(ExistingFriend, Tail), friend(NewGuy, ExistingFriend)),

    % Build a valid circle with the new inputs,
    % and put that in the output slot.
    validCircle([NewGuy,Person|Tail], Output).
0
votes

This observation

?- setof(Friend, friend(Person, Friend), Friends).
Person = beth,
Friends = [jill, sally, sue] ;
Person = bill,
Friends = [dick, tom] ;
....

leads me to write:

pair(P1, A, B) :-
    append(_, [A|As], P1),
    append(_, [B|_], As).

circles(Cs) :-
    setof(C, X^P^A^B^(setof(Person, friend(Person, X), P),
              forall(pair(P, A, B), friend(A, B)),
              sort([X|P], C)
             ), Cs).

with this result

?- circles(L).
L = [[beth, jill, sally, sue]].