1/*
    2
    3  Deprecated - use rdf_matcher now
    4*/
    5:- module(nlp_util,
    6          [rdf_nliteral/3,
    7           rdf_nliteral/4,
    8           rdf_nliteral_tr/5,
    9           shares_literal/6,
   10
   11           entity_match/6,
   12           new_entity_match/6]).   13
   14%:- use_module(library(tabling)).
   15%:- use_module(library(memo)).
   16%:- use_module(library(typedef)).
   17
   18:- rdf_register_ns(oio, 'http://www.geneontology.org/formats/oboInOwl#').   19
   20
   21:- rdf_meta lprop(r).
   22
   23% TODO: reuse
   24lprop(rdfs:label).
   25lprop(oio:hasExactSynonym).
   26lprop(oio:hasRelatedSynonym).
   27lprop(oio:hasNarrowSynonym).
   28lprop(oio:hasBroadSynonym).
   29
   30
   31%:- table rdf_nliteral_tr/5.
   32
   33rdf_nliteral(X,P,V,G) :- rdf(X,P,Lit,G), bind(lcase(Lit), V).
   34rdf_nliteral(X,P,V) :- rdf_nliteral(X,P,V,_).
   35
   36rdf_nliteral_tr(X,P,V,lcase,G) :- lprop(P),rdf(X,P,Lit,G), bind(lcase(Lit), V).
   37
   38%:- table shares_literal/6.
   39shares_literal(A,B,PA,PB,V,F) :-
   40        rdf_nliteral_tr(A,PA,V,F,_),rdf_nliteral_tr(B,PB,V,F,_),A\=B.
   41
   42entity_match(A,B,PA,PB,V,F) :-
   43        shares_literal(A,B,PA,PB,V,F),
   44        different_prefix(A,B).
   45
   46new_entity_match(A,B,PA,PB,V,F) :-
   47        entity_match(A,B,PA,PB,V,F),
   48        rdf_global_id(PrefixA:_, A),
   49        rdf_global_id(PrefixB:_, B),
   50        \+ alt_equiv(A, PrefixB),
   51        \+ alt_equiv(B, PrefixA).
   52
   53alt_equiv(A, PrefixB) :-
   54        rdf_path(A,((owl:equivalentClass)| \(owl:equivalentClass)),B),
   55        rdf_global_id(PrefixB:_, B).
   56
   57
   58different_prefix(A,B) :-
   59        rdf_global_id(PrefixA:_, A),
   60        rdf_global_id(PrefixB:_, B),
   61        PrefixA \= PrefixB