1:-use_module(library(trill)).    2
    3:- trill. % or :- trillp. or :- tornado.
    4
    5/*
    6An toy KB to test local consistency.
    7This KB is inconsistent due to individuals ind1 and ind2.
    8*/

?- instanceOf(b,ind1,E). % locally inconsistent ?- inconsistent_theory(E). E = [classAssertion(a, ind1), classAssertion(complementOf(x), ind2), subClassOf(a, allValuesFrom(r, x)), propertyAssertion(r, ind1, ind2) ]. ?- property_value(r,ind3,ind4,E). % locally consistent ?- instanceOf(x,ind4,E). % locally consistent

*/

   25% Axioms 
   26classAssertion(a,ind1).
   27subClassOf(a,allValuesFrom(r,x)).
   28propertyAssertion(r,ind1,ind2).
   29%classAssertion(complementOf(x),ind2). %TODO uncomment
   30subClassOf(a,b).
   31
   32propertyAssertion(u,ind3,ind4).
   33subPropertyOf(u,s).
   34subPropertyOf(s,t).
   35subPropertyOf(t,r).
   36classAssertion(a,ind3)