/*

  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


  This model (compared with finding_celebrities.pi) use another representation of the people.

  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..1)
      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,People,PartyMat),
   N = People.length,
   Map = new_map([PP=I : {PP,I} in zip(People,1..N)]),
   Party = new_array(N,N), 
   Party :: 0..1,
   foreach(ThisP in People)
     ThisPId = Map.get(ThisP),
     foreach(PP in People)
       if membchk(PP,PartyMat[ThisPId]) ; ThisP == PP  then
          Party[ThisPId,Map.get(PP)] #= 1
       else 
          Party[ThisPId,Map.get(PP)] #= 0
       end
     end
   end,

   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
%    ].

problem(1, People,Party) => 
  People = [adam,dan,eva,alice,peter],
  Party = [
   [dan,alice,peter,eva], % adam
   [adam,alice,peter],    % dan
   [alice,peter],     % eva 
   [peter],      % alice
   [alice]       % peter
   ].



% 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]
          ].