1:- module(ontobee,
    2          [
    3           in_graph/2,
    4           typed_in_graph/3,
    5           in_ontology/2,
    6           in_ontology/3,
    7
    8           graph_ontology/2,
    9
   10           searchall/4,
   11           ontsearch/4,
   12
   13           compare_via_xref/1,
   14           compare_via_xref/6,
   15           ontobee_edge/3
   16           ]).   17
   18:- use_module(library(sparqlprog)).   19:- use_module(library(semweb/rdf11)).   20
   21:- rdf_register_prefix(obomerged,'http://purl.obolibrary.org/obo/merged/').   22:- rdf_register_prefix(obo,'http://purl.obolibrary.org/obo/').   23
   24:- rdf_register_prefix('MONDO','http://purl.obolibrary.org/obo/MONDO_').   25
   26
   27
   28in_graph(X,G) :-
   29        typed_in_graph(X,G,_).
   30typed_in_graph(X,G,T) :-
   31        rdf(X,rdf:type,T,G).
   32
   33
   34:- srule(in_ontology,[entity:iri, ontology:iri],
   35         'Entity is declared to be of some type in Ontology').   36in_ontology(X,O) :-
   37        in_ontology(X,O,_).
   38
   39:- srule(in_ontology,[entity:iri, ontology:iri, type:iri],
   40         'Entity is declared to be of type T in Ontology').   41in_ontology(X,O,T) :-
   42        typed_in_graph(X,G,T),
   43        graph_ontology(G,O).
   44
   45:- srule(graph_ontology,[graph:iri, ontology:iri], 'maps an ontobee graph IRI to an ontology name (e.g. hp, go, uberon, ncit)').   46graph_ontology(G,O) :-
   47        G == uri(concat('http://purl.obolibrary.org/obo/merged/',ucase(O))).    
   48
   49
   50ontsearch(O,P,C,L) :- graph_ontology(G,O),rdf(C,rdfs:label,L,G),regex(str(L),P).
   51searchall(G,P,C,L) :- rdf(C,rdfs:label,L,G),regex(str(L),P).
   52
   53
   54
   55curie_uri_graph(X,URI,G) :-
   56        concat_atom([DB,Local],':',X),
   57        DB\=http,
   58        atom_concat('http://purl.obolibrary.org/obo/merged/',DB,G),
   59        concat_atom(['http://purl.obolibrary.org/obo/',DB,'_',Local],URI).
   60
   61% UBERON:0002228 ! rib
   62compare_via_xref(C) :-
   63        compare_via_xref(C,_R,_P,_CX,_XG,_Status).
   64
   65compare_via_xref(C_id,R,P,CX,XG,Status) :-
   66        ensure_uri(C_id,C),
   67        format('# Testing: ~w~n',[C]),
   68        ontobee_edge(C,R,P),
   69        ontobee_label(P,PN),
   70        format('# Edge: ~w ~w ~w ~w~n',[C,R,P,PN]),
   71        ontobee_has_dbxref(C,CX),
   72        format('# C xref: ~w~n',[CX]),
   73        curie_uri_graph(CX,CXU,XG),
   74        format('# Checking if present in : ~w~n',[XG]),
   75        find_and_compare_edge(C,R,P,CXU,XG, Status),
   76        format('# Status: Checking for relationship ~w ~w "~w" in ~w, Status:  ~w~n',[R,P,PN,XG,Status]).
   77
   78
   79
   80find_and_compare_edge(_C,R,P,CXU,XG, Status) :-
   81        ontobee_has_dbxref(P,PX),
   82        curie_uri_graph(PX,PXU,XG),
   83        !,
   84        test_for_edge(R,CXU, PXU, Status).
   85find_and_compare_edge(_,_,P,_,XG, no_equiv_to(P,XG)).
   86
   87test_for_edge(RU,CXU, PXU, analogous_edge(Same)) :-
   88        ontobee_edge(CXU,RXU,PXU),
   89        !,
   90        is_same_rel(RU,RXU,Same).
   91xxxxxtest_for_edge(RU,CXU, PXU, indirect_subclass(Same)) :-
   92        service(ontobee,rdfs_subclass_of(CXU,PXU)),
   93        !,
   94        is_same_rel(RU,rdfs:subClassOf,Same).
   95test_for_edge(_,_, _, no_relationship_between_equivs) :- !.
   96        
   97is_same_rel(RU,RXU,Same) :-
   98        (   RU=RXU
   99        ->  Same=same_rel
  100        ;   Same=diff_rel).
  101        
  102        
  103ontobee_edge(C,R,P) :-
  104        service(ontobee,subclass_of_some(C,R,P)).
  105ontobee_edge(C,subClassOf,P) :-
  106%        service(ontobee,((subClassOf(C,P),\+rdf_bnode(P)))).
  107%        service(ontobee,(subClassOf(C,P),\+is_blank(P))).
  108        service(ontobee,(subClassOf(C,P))).
  109
  110ontobee_has_dbxref(C,CX):-
  111        service(ontobee,has_dbxref(C,CX1)),
  112        literal_atom(CX1,CX).
  113ontobee_label(C,N):-
  114        service(ontobee,rdf(C,rdfs:label,N1)),
  115        !,
  116        literal_atom(N1,N).
  117ontobee_label(_,'')