1:- module(biotea,
    2          [
    3           src_term/2,
    4           ann_src_term/5,
    5           coannotation/6
    6           ]).    7
    8:- rdf_register_prefix(ncitevs, 'http://ncicb.nci.nih.gov/xml/owl/EVS/Thesaurus.owl#').    9:- rdf_register_prefix(snomed, 'http://purl.bioontology.org/ontology/SNOMEDCT/').   10
   11:- rdf_register_prefix(biotea,'https://biotea.github.io/biotea-ontololgy#').   12:- rdf_register_prefix(oa,'http://www.w3.org/ns/oa#').   13:- rdf_register_prefix(pmc,'http://linkingdata.io/pmcdoc/pmc/').   14
   15ann_src_term(A, Src, Para, TermUri, Label) :-
   16        rdf(A, oa:hasTarget, Para),
   17        rdf(Para, oa:hasSource, Src),
   18        rdf(A, oa:hasBody, Text),
   19        rdf(Text, rdf:value, Label),
   20        rdf(A, oa:hasBody, TermUri),
   21        \+ rdf(TermUri, rdf:type, oa:'TextualBody').
   22
   23
   24
   25src_term(Src, TermUri) :-
   26        ann_src_term(_, Src, _, TermUri).
   27
   28% e.g. `coannotation(pmc:'3875424',pmc:'3933681',_,_,_,_)`
   29coannotation(P1,P2,TermUri,Label,F1,F2) :-
   30        ann_src_term(A1,P1,_,TermUri,Label),
   31        ann_src_term(A2,P2,_,TermUri,_),
   32        rdf(A1,biotea:tf,F1),
   33        rdf(A2,biotea:tf,F2)