This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/CHR/chr/examples/kl-one.pl

275 lines
7.3 KiB
Prolog

% Terminological Reasoning (similar to KL-ONE or feature trees)
% Ph. Hanschke, DFKI Kaiserslautern, and Th. Fruehwirth
% 920120-920217-920413-920608ff-931210, LMU 980312
:- use_module( library(chr)).
handler klone.
% SYNTAX
% Basic operators
operator(1200,xfx,isa). % concept definition
operator(950,xfx,'::'). % A-Box membership and role-filler assertion
operator(940,xfy,or). % disjunction
operator(930,xfy,and). % conjunction
operator(700,xfx,is). % used in restricitions
operator(690,fy, nota). % complement
operator(650,fx, some). % exists-in restriction
operator(650,fx, every). % value restriction
% Operators for extensions
operator(100,fx, feature). % functional role / attribute
operator(100,fx, distinct). % concept distinct from any other concept
operator(100,fx, at_most_one). % local functional role
operator(100,yfx,of). % role chain (note associativity)
:- dynamic (feature)/1, (distinct)/1, (isa)/2. % to allow scattered clauses
% TYPES
role_assertion((I,J)::R):- individual(I),individual(J), role(R).
membership_assertion(I::T):- individual(I), concept_term(T).
concept_definition((C isa T)):- concept(C), concept_term(T).
concept_term(S):- concept(S).
concept_term(S or T):- concept_term(S), concept_term(T).
concept_term(S and T):- concept_term(S), concept_term(T).
concept_term(nota S):- concept_term(S).
concept_term(some R is S):- role(R), concept_term(S).
concept_term(every R is S):- role(R), concept_term(S).
concept_term(at_most_one R):- role(R). % extension
individual(I):- var(I) ; atomic(I).
role(R):- atom(R).
role(R1 of R2):- role(R1), role(R2). % extension
concept(C):- atom(C).
% CONSISTENCY CHECK
% A-box as constraint goals, T-box asserted (concept definitions by isa-rules)
constraints (::)/2, labeling/0.
% disjunction (is delayed as choice)
labeling, (I::S or T) # Ph <=>
(I::S ; I::T),
labeling
pragma passive(Ph).
% primitive clash
I::nota Q, I::Q <=> fail.
% duplicates
I::C \ I::C <=> true.
% top
I::top <=> true.
% complement nota/1
% nota-top
I::nota top <=> fail.
% nota-or
I::nota (S or T) <=> I::(nota S and nota T).
% nota-and
I::nota (S and T) <=> I::(nota S or nota T).
% nota-nota
I::nota nota S <=> I::S.
% nota-every
I::nota every R is S <=> I::some R is nota S.
% nota-some
I::nota some R is S <=> I::every R is nota S.
% conjunction
I::S and T <=> I::S, I::T.
% exists-in restriction
I::some R is S <=> role(R) | (I,J)::R, J::S. % generate witness
% value restriction
I::every R is S, (I,J)::R ==> J::S.
% Extensions ------------------------------------------------------------------
% value restriction merge and consistency test
I::every R is S1, I::every R is S2 <=> I::every R is S1 and S2, J::S1 and S2.
% distinct/disjoint concept
I::C1 \ I::C2 <=> concept(C1),concept(C2),distinct C1 | C1=C2.
% features/attributes/functional role
(I,J1)::F \ (I,J2)::F <=> feature F | J1=J2.
% role chains
(I,J)::C1 of C2 <=> (I,K)::C2, (K,J)::C1. % also covers "some" case
I::every R1 of R is S, (I,J)::R ==> J::every R1 is S.
I::at_most_one R1 of R, (I,J)::R ==> J::at_most_one R1.
% simple number restriction / local functional role using role chains
constraints at_most_one/3.
I::at_most_one R, (I,J)::R ==> at_most_one(I,J,R).
at_most_one(I,J,R) \ at_most_one(I,J1,R) <=> J1=J.
I::nota at_most_one R <=> (I,J1)::R, (I,J2)::R, (J1,J2)::different.
% concrete domain predicates
(X,X)::different <=> fail.
(X,Y)::identical <=> X=Y.
X::greater(Y) <=> ground(X) | X>Y.
(X,Y)::greater <=> ground(X), ground(Y) | X>Y.
X::smaller(Y) <=> ground(X) | X<Y.
(X,Y)::smaller <=> ground(X), ground(Y) | X<Y.
% binary concrete domain predicates using role chains
I::some (R1 and R2) is S <=> (I,J1)::R1, (I,J2)::R2, (J1,J2)::S.
constraints (every)/3.
I::every (R1 and R2) is S <=> every((I,I),(R1,R2),S).
every((I1,I2),(identical,identical),S) <=> (I1,I2)::S.
every((I1,I2),(identical,R),S), (I2,J2)::R ==>
(I1,J2)::S.
every((I1,I2),(identical,R2 of R),S), (I2,J2)::R ==>
every((I1,J2),(identical,R2),S).
every((I1,I2),(R,R2),S), (I1,J1)::R ==>
every((J1,I2),(identical,R2),S).
every((I1,I2),(R1 of R,R2),S), (I1,J1)::R ==>
every((J1,I2),(R1,R2),S).
% unfolding using concept definition
% if you use recursion in concepts, replace rules below by propagation rules
I::C <=> (C isa T) | I::T.
I::nota C <=> (C isa T) | I::nota T.
% EXAMPLES ===================================================================
% Family ---------------------------------------------------------------------
female isa nota male.
woman isa human and female.
man isa human and male.
parent isa human and some child is human.
father isa parent and man.
mother isa parent and woman.
grandfather isa father and some child is parent.
grandmother isa mother and some child is parent.
fatherofsons isa father and every child is male.
feature age.
person isa (man or woman) and every age is number.
distinct number.
X::number <=> nonvar(X) | number(X).
feature partner.
married_person isa person and every partner is married_person. % recursion !
% Configuration ---------------------------------------------------------------
distinct interface.
distinct configuration.
simple_device isa device and
some connector is interface.
feature component_1.
feature component_2.
simple_config isa configuration and
some component_1 is simple_device and
some component_2 is simple_device.
very_simple_device isa simple_device and
at_most_one connector.
feature price.
feature voltage.
feature frequency.
electrical_device isa very_simple_device and
some voltage is greater(0) and some price is greater(1).
low_cost_device isa electrical_device and
every price is smaller(200).
high_voltage_device isa electrical_device and
every voltage is greater(15).
electrical_config isa simple_configuration and
every component_1 is electrical_device and
every component_2 is electrical_device and
every (voltage of component_1 and voltage of component_2)
is greater.
bus_device isa simple_device and bus and
some frequency is greater(0).
cpu_device isa simple_device and cpu and
some frequency is greater(0).
bus_config isa configuration and
some main_device is bus_device and
every component is cpu_device and
every (frequency of main_device and frequency of sub_device)
is greater.
catalog(dev1) :- dev1::electrical_device,
(dev1,10)::voltage, (dev1,100)::price.
catalog(dev2) :- dev2::electrical_device,
(dev2,20)::voltage, (dev2,1000)::price.
possible_config(C) :-
catalog(D1), (C,D1)::component_1,
catalog(D2), (C,D2)::component_2.
/*
% Example Queries
:- possible_config(C).
:- possible_config(C), C::electrical_config.
:- possible_config(C), C::electrical_config,
(C,D1)::component_1, D1::low_cost_device,
(C,D2)::component_2, D2::high_voltage_device.
*/
% Prolog terms ---------------------------------------------------------
% see also handler term.chr
feature functor.
feature arity.
feature arg(N).
term isa top and some arity is number and some arity is greater(-1)
and some functor is top.
(X,_)::arg(N) ==> N>=1.
%(X,A)::arity ==> A>=0.
(X,A)::arity,(X,_)::arg(N) ==> A>=N,A>=1.
% (X,0)::arity <-> (X,X)::functor
(X,0)::arity ==> (X,X)::functor.
(X,X)::functor ==> (X,0)::arity.
% end of kl-one.pl ========================================================