1:- module(owl, [
    2    owl_assert_individual/4,    % +Subject:iri, +Class:iri, +Label:rdf_literal, +Graph
    3    owl_date_time/3,            % +TimeStamp:float, -DateTime:compound, +TimeZone:atom
    4    owl_format_date_time/2,     % +DateTime:compound, -Text:atom
    5    owl_object_atom/2,          % +Object:atom, -Atom:atom
    6    owl_reachable/3,            % +Subject, +Property, -Object
    7    owl_remove_individual/2     % +Individual:iri, +Graph
    8]).
Predicates for querieng RDF graphs using OWL Semantics
   12:- use_module(library(semweb/rdf11)).   13:- use_module(library(semweb/rdfs)).   14:- use_module(library(apply)).   15
   16:- reexport(library(semweb/rdfs) , [
   17    rdfs_individual_of/2 as owl_individual_of
   18]).   19:- reexport(library(semweb/rdf11) , [
   20    rdf_has/3 as owl_has
   21]).   22
   23:- rdf_meta 
   24    owl_assert_individual(r,r,o,r),
   25    owl_has(r,r,o),    
   26    owl_individual_of(r,r),
   27    owl_object_atom(o,-),
   28    owl_reachable(r,r,o),
   29    owl_remove_individual(r, +).
   30
   31
   32%%% PUBLIC PREDICATES %%%%%%%%%%%%%%%%%%%%%%%%%%
 owl_assert_individual(+Subject:iri, +Class:iri, +Label:rdf_literal, +Graph) is det
asserts the named individual of Class with the SubjectIri IRI and assigns it label Label. The individual is asserted into the graph Graph
   37owl_assert_individual(SubjectIri, Class, Label, Graph) :-
   38    rdf_assert(SubjectIri, rdf:type, owl:'NamedIndividual', Graph),
   39    rdf_assert(SubjectIri, rdf:type, Class, Graph),
   40    rdf_assert(SubjectIri, rdfs:label, Label, Graph).
 owl_date_time(+TimeStamp:float, -DateTime:compound, +TimeZone:atom) is det
   43owl_date_time(TimeStamp, DateTime, TimeZone) :-
   44    TimeStamp == now,
   45    get_time(T),
   46    owl_date_time(T, DateTime, TimeZone),
   47    !.
   48 owl_date_time(TimeStamp, DateTime, TimeZone) :-
   49    number(TimeStamp),
   50    stamp_date_time(TimeStamp, DateTime0, TimeZone),
   51    DateTime0 =.. [_, YYYY, MM, DD, HH, Min, SSs, TZ | _],
   52    SS is floor(SSs),
   53    DateTime1 =.. [ date_time, YYYY, MM, DD, HH, Min, SS, TZ],
   54    rdf_lexical_form(DateTime1, DateTime).
 owl_format_date_time(+DateTime:compound, -Text:atom) is det
Unifies Text with the xsd representation of the date_time/7 compound.
   58owl_format_date_time(date_time(Y,M,D,H,Min, S, Offset), Text) :-
   59    format_time(atom(Text), '%FT%T%:z', date(Y,M,D,H,Min, S, Offset, _, _)).
 owl_object_atom(+Object:atom, -Atom:atom) is det
Unifies Atom with the atomic representation of the Object, which is either atomic representation of literal or label of the resource represented by the Object.
   64owl_object_atom(Object, Atom) :-
   65    rdf_is_literal(Object),
   66    (        
   67        Object = ^^(Date,'http://www.w3.org/2001/XMLSchema#dateTime'),
   68        owl_format_date_time(Date, Value)
   69    ;
   70        Object = ^^(Value,_)
   71    ;
   72        Object = @(Value, _)
   73    ;   
   74        Value = ''
   75    ),
   76    atomic_list_concat([Value], Atom),
   77
   78    !.
   79 owl_object_atom(Object, Atom):-
   80    rdf_is_iri(Object),
   81    rdfs_label(Object, Value),
   82    atomic_list_concat([Value], Atom),
   83    !.
   84 owl_object_atom(Object, Atom):-
   85    rdf_is_iri(Object),
   86    rdf_global_id(_:Atom, Object),
   87    !.
   88 owl_object_atom(Object, Object).
 owl_reachable(+Subject, +Property, -Object) is nondet
owl_reachable(-Subject, +Property, +Object) is nondet Succeeds if Subject is reachable to Object with respect to OWL semantics. It uses the semantics of rdf_reachable/3 but Resource is not considered to be reachable to itself unless:

As such the predicate handles subpropertyOf, inverseOf, transient, reflexive, and irreflexive properties of the Property

  101owl_reachable(_, Property, _) :-
  102    var(Property),
  103    throw(instantiation_error('Property')).
  104 owl_reachable(Subject, _, Object) :-
  105    var(Subject), var(Object),
  106    throw(instantiation_error('Subject, Object')).
  107 owl_reachable(Subject, Property, Object) :- 
  108    copy_term(s(Subject, Property, Object), Call),
  109    owl_reachable_stack(Subject, Property, Object, [Call]).
 owl_remove_individual(+Individual:iri, +Graph) is det
Removes all rdf entries from the Graph where Individual is either in the subject or object role.
  113owl_remove_individual(Individual, Graph) :-
  114    rdf_retractall(Individual, _, _, Graph),
  115    rdf_retractall(_, _, Individual, Graph).
  116    
  117%%% PRIVATE PREDICATES %%%%%%%%%%%%%%%%%%%%%%%%%
  118
  119non_circular(Call, Stack, [Call | Stack]) :-
  120    \+ memberchk(Call, Stack).
  121
  122noncircular_reachable(S, P, O, Stack) :-
  123    copy_term(s(S,P,O), Call),
  124    (           
  125        memberchk(Call, Stack)
  126    ->  rdf_reachable(S,P,O) 
  127    ;   owl_reachable_stack(S,P,O, [ Call | Stack])
  128    ),
  129    S \== O.
  130
  131owl_reachable_stack(Subject, Property, Object, _) :-
  132    rdf_reachable(Subject, Property, Object),
  133    (   Subject == Object
  134    ->  ( rdf_has(Subject, Property, Object)
  135        -> \+ rdf(Property, rdf:type, owl:'IrreflexiveProperty' )
  136        ;   rdf(Property, rdf:type, owl:'ReflexiveProperty' ) 
  137        )
  138    ;   true
  139    ).
  140 owl_reachable_stack(S, P, O, Stack) :-
  141    \+ var(S),    
  142    rdf(P, owl:propertyChainAxiom, Chain),
  143    rdf_list(Chain, PropertyChain),
  144    foldl(
  145        {Stack}/[Property, Subject, Object]
  146            >> noncircular_reachable(Subject, Property, Object, Stack),
  147        PropertyChain, S, O).
  148owl_reachable_stack(S, P, O, Stack) :-
  149    \+ var(O),
  150    rdf(P, owl:propertyChainAxiom, Chain),
  151    rdf_list(Chain, PropertyChain),
  152    reverse(PropertyChain, RevertedChain),
  153    foldl(
  154        {Stack}/[Property, Object, Subject] 
  155            >> noncircular_reachable(Subject, Property, Object, Stack), 
  156        RevertedChain, O, S)