/*
Finding celebrities problem in Picat.
From Uwe Hoffmann
"Finding celebrities at a party"
http://www.codemanic.com/papers/celebs/celebs.pdf
"""
Problem: Given a list of people at a party and for each person the list of
people they know at the party, we want to find the celebrities at the party.
A celebrity is a person that everybody at the party knows but that
only knows other celebrities. At least one celebrity is present at the party.
"""
(This paper also has an implementation in Scala.)
Note: The original of this problem is
Richard Bird and Sharon Curtis:
"Functional pearls: Finding celebrities: A lesson in functional programming"
J. Funct. Program., 16(1):13–20, 2006.
The problem from Hoffmann's paper is to find of who are the
celebrity/celebrities in this party graph:
Adam knows {Dan,Alice,Peter,Eva},
Dan knows {Adam,Alice,Peter},
Eva knows {Alice,Peter},
Alice knows {Peter},
Peter knows {Alice}
Solution: the celebrities are Peter and Alice.
I blogged about this problem in "Finding celebrities at a party"
http://www.hakank.org/constraint_programming_blog/2010/01/finding_celebrities_at_a_party.html
Model created by Hakan Kjellerstrand, hakank@gmail.com
See also my Picat page: http://www.hakank.org/picat/
*/
import cp.
main => go.
go =>
foreach(P in 1..4)
writeln(problem=P),
if find_celebrities(P,Celebrities) then
println(celebrities=Celebrities),
printf("celebs: %w\n", [I : I in 1..Celebrities.length, Celebrities[I] #= 1])
else
println("no solution")
end,
nl
end.
% Find the celebrities of problem P
find_celebrities(P,Celebrities) =>
problem(P,N,Party),
Celebrities = new_list(N),
Celebrities :: 0..1, % is this a celebrity
NumCelebrities #= sum(Celebrities),
% There is at least one celebrity
% NumCelebrities #> 0,
% All persons know the celebrities,
% and the celebrities only know celebrities.
foreach(I in 1..N)
Celebrities[I] #<=> sum([(Party[J,I]#=1) : J in 1..N]) #= N,
Celebrities[I] #<=> sum([(Party[I,J]#=1) : J in 1..N]) #= NumCelebrities
end,
solve(Celebrities).
%
% The party graph of the example above:
%
% Adam knows [Dan,Alice,Peter,Eva], [2,3,4,5]
% Dan knows [Adam,Alice,Peter], [1,4,5]
% Eva knows [Alice,Peter], [4,5]
% Alice knows [Peter], [5]
% Peter knows [Alice] [4]
%
% Solution: Peter and Alice (4,5) are the celebrities.
%
problem(1, N, Party) =>
N = 5,
Party = [
[1,1,1,1,1], % 1
[1,1,0,1,1], % 2
[0,0,1,1,1], % 3
[0,0,0,1,1], % 4
[0,0,0,1,1] % 5
].
% In this example Alice (4) also knows Adam (1),
% which makes Alice a non celebrity, and since
% Peter (5) knows Alices, Peter is now also a
% non celebrity. Which means that there are no
% celebrities at this party.
%
problem(2, N, Party) =>
N = 5,
Party = [
[1,1,1,1,1],
[1,1,0,1,1],
[0,0,1,1,1],
[1,0,0,1,1],
[0,0,0,1,1]
].
%
% Here is another example. It has the following
% cliques:
% [1,2]
% [4,5,6]
% [6,7,8]
% [3,9,10]
%
% The celebrities are [3,9,10]
%
problem(3,N, Party) =>
N = 10,
Party = [
% 1 2 3 4 5 6 7 8 9 10
[0,1,1,0,0,0,0,1,1,1],
[1,0,1,0,0,0,0,0,1,1],
[0,0,1,0,0,0,0,0,1,1],
[0,1,1,0,1,1,0,0,1,1],
[0,0,1,1,0,1,0,0,1,1],
[0,0,1,1,1,0,1,1,1,1],
[0,0,1,0,0,1,0,1,1,1],
[0,0,1,0,0,1,1,0,1,1],
[0,0,1,0,0,0,0,0,1,1],
[0,0,1,0,0,0,0,0,1,1]
].
%
% This is the same graph as the one above
% with the following changes:
% - 9 don't know 3 or 10
% This party graph know consists of just
% one celebrity: [9]
%
problem(4,N,Party) =>
N = 10,
Party = [
[0,1,1,0,0,0,0,1,1,1],
[1,0,1,0,0,0,0,0,1,1],
[0,0,1,0,0,0,0,0,1,1],
[0,1,1,0,1,1,0,0,1,1],
[0,0,1,1,0,1,0,0,1,1],
[0,0,1,1,1,0,1,1,1,1],
[0,0,1,0,0,1,0,1,1,1],
[0,0,1,0,0,1,1,0,1,1],
[0,0,0,0,0,0,0,0,1,0],
[0,0,1,0,0,0,0,0,1,1]
].