/* 

  Simple semantic net in Picat.

  Translation of the Prolog program
  http://www.idi.ntnu.no/emner/tdt4136/PRO/heterarchy.txt
  """
  Contains examples of a semantic net with multiple inheritance

  ...

  The following properties will be derived
  1. Mary has legs = 2
  2. John has legs = 1
  3. Mary has height = 170
  4. John has height = 175
  5. Robert has height = 100 
  6. Alice has height = 100 and height=170.
  """
 
  This Picat model was created by Hakan Kjellerstrand, hakank@gmail.com
  See also my Picat page: http://www.hakank.org/picat/

*/


% import util.
% import cp.


main => go.


go =>
  Queries = $[
          hasvalues(mary,legs),
          hasvalues(john,legs),
          hasvalues(mary,height),
          hasvalues(john,height),
          hasvalues(robert,height),
          hasvalues(alice,height)
  ],

  foreach(Q in Queries) 
    println(Q),
    (call(Q) ; true),
    nl
  end,
  nl.



index(-,-)(+,-)(-,+)(+,+)
ako(person,mammal).
 
ako(female,person).
ako(male,person).
ako(child,person).

ako(girl,female).
ako(girl,child).
    
ako(boy,male).
ako(boy,child).

index(-,-,-)(-,-,+)(-,+,-)(-,+,+)(+,-,-)(+,-,+)(+,+,+)
haveatt(person,legs,number).
haveatt(person,height,centimeter).

index(-,-,-)(-,-,+)(-,+,-)(-,+,+)(+,-,-)(+,-,+)(+,+,+)
have(person,legs,2).
have(person,height,175).
have(female,height,170).  
have(child,height,100).

% have(male,height,180). %% """omitted for sake of demonstration"""

index(-,-)(+,-)(-,+)(+,+)
isa(mary,female).
isa(john,male).

isa(alice,girl). 
isa(robert,boy).

index(-,-,-)(-,-,+)(-,+,-)(-,+,+)(+,-,-)(+,-,+)(+,+,+)
has(john,legs,1).
% has(alice,height,145). % hakank: This will override both answers on alice's height

% Access relations

hasvalues(X,A) ?=> % query predicate
    hasvalue(X,A,V),
    ans([X,A,V]).

hasvalue(X,A,V) ?=>
    has(X,A,V).
hasvalue(X,A,V) =>
    not has(X,A,_),
    instant(X,C),
    have(C,A,V),
    not interveningatt(X,C,A).


instant(X,D) => %% instance
    isa(X,C),
    subclass0(C,D).


interveningatt(X,C2,A) =>
    interveningclass(X,C1,C2),
    have(C1,A,_).


interveningclass(X,C1,C2) =>
    instant(X,C1),
    subclass(C1,C2).


subclass(C,D) ?=> %% exclusive
    ako(C,C1),
    subclass0(C1,D).

subclass0(C,C1) ?=> C=C1. %% inclusive
subclass0(C,E) =>
    ako(C,D),
    subclass0(D,E).

ans(X) => 
    write(X),nl,fail.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% Eample Run


/*
 ?- [heterarchy].
yes
| ?- hasvalues(mary,legs).
[mary,legs,2]
no
| ?- hasvalues(john,legs).
[john,legs,1]
no
| ?- hasvalues(mary,height).
[mary,height,170]
no
| ?- hasvalues(john,height).
[john,height,175]
no
| ?- hasvalues(robert,height).
[robert,height,100]
no
| ?- hasvalues(alice,height).
[alice,height,170]
[alice,height,100]
no
| ?- 
*/