1/*
    2  
    3*/
    4
    5:- module(nextprot,
    6          [
    7
    8           keyword/2,
    9           keyword_term/2,
   10
   11           isoform/2,
   12           gene/2,
   13           child_of/2,
   14           term_child_of/2,
   15           
   16           cellular_component/2,
   17           cellular_component_term_child_of/2,
   18
   19           expression/2,
   20           expression_term_child_of/2,
   21           expression_term_child_of/3,
   22           evidence_expression_level/2,
   23           
   24           topology/2,
   25           topology_transmembrane/2,
   26
   27           phosphoprotein/1,
   28
   29           ensembl_localid/2,
   30
   31           protein_phosphorylated_in_cytoplasm/1,
   32           high_expression_in_brain/1
   33
   34           ]).   35
   36:- use_module(library(sparqlprog)).   37:- use_module(library(semweb/rdf11)).   38
   39:- sparql_endpoint( nextprot, 'https://api.nextprot.org/sparql').   40
   41:- rdf_register_prefix(nextprot,'http://nextprot.org/rdf#').   42:- rdf_register_prefix(nextprot_cv,'http://nextprot.org/rdf/terminology/').   43
   44keyword(G,K) :- rdf(G,nextprot:keyword,K).
   45keyword_term(G,T) :-
   46        rdf(G,nextprot:keyword,K),
   47        rdf(K,nextprot:term,T).
   48
   49isoform(A,B) :- rdf(A,nextprot:isoform,B).
   50gene(A,B) :- rdf(A,nextprot:gene,B).
   51
   52child_of(A,B) :- rdf(A,nextprot:childOf,B).
   53term_child_of(T,B) :- rdf(T,nextprot:term,A), rdf(A,nextprot:childOf,B).
   54
   55cellular_component(P,C) :- rdf(P,nextprot:cellularComponent,C).
   56cellular_component_term_child_of(P,C) :- cellular_component(P,Z),term_child_of(Z,C).
   57
   58expression(P,E) :- rdf(P,nextprot:expression,E).
   59expression_term_child_of(P,T,E) :- expression(P,E),term_child_of(E,T).
   60expression_term_child_of(P,T) :- expression_term_child_of(P,T,_).
   61
   62evidence_expression_level(E,L) :- rdf(E,nextprot:evidence,Ev), rdf(Ev,nextprot:expressionLevel,L).
   63
   64topology(P,S) :- rdf(P,nextprot:topology,S).
   65
   66topology_transmembrane(P,S) :- topology(P,S),rdf(S,rdf:type,nextprot:'TransmembraneRegion').
   67
   68
   69phosphoprotein(P) :- keyword_term(P,nextprot_cv:'KW-0597').
   70
   71% ----------------------------------------
   72% IDs
   73% ----------------------------------------
   74ensembl_localid(G,Id) :- bind(replace(str(G),"http://nextprot.org/rdf/gene/",""), Id).
   75
   76
   77% ----------------------------------------
   78% Example queries
   79% ----------------------------------------
   80
   81protein_phosphorylated_in_cytoplasm(P) :-
   82        isoform(P,F),
   83        phosphoprotein(F),
   84        cellular_component_term_child_of(F,nextprot_cv:'SL-0086').
   85
   86high_expression_in_brain(P) :-
   87        isoform(P,F),
   88        expression(F,E),
   89        term_child_of(E,nextprot_cv:'TS-0095'),
   90        evidence_expression_level(E,nextprot:'High')