wrapper for disgenet endpoint

See http://www.disgenet.org/rdf

*/

    7:- module(disgenet,
    8          [
    9           gene/1,
   10           disease/1,
   11           
   12           refers_to/2,
   13           has_evidence/2,
   14           
   15           association/1,
   16           gene_disease_association/1,
   17           gene_disease_association/3,
   18           gene_disease_association/4,
   19
   20           disease_pair_by_shared_gene/3
   21           ]).   22
   23:- use_module(library(sparqlprog)).   24:- use_module(library(semweb/rdf11)).   25
   26:- use_module(library(sparqlprog/owl_types)).   27:- use_module(library(sparqlprog/ontologies/sio),[has_evidence/2, has_source/2, refers_to/2, has_measurement_value/2]).   28:- use_module(library(typedef)).   29
   30:- type disgenet_protein ---> atomic_iri.
   31:- type disgenet_annotation ---> atomic_iri.
   32:- type disgenet_gene ---> atomic_iri.
   33:- type disgenet_publication ---> atomic_iri.
   34
   35:- sparql_endpoint( disgenet, 'http://rdf.disgenet.org/sparql/').   36
   37:- rdf_register_prefix(disgenet,'http://rdf.disgenet.org/').   38:- rdf_register_prefix(disgenet_gene_disease_association,'http://rdf.disgenet.org/resource/gene_disease_association/').   39:- rdf_register_prefix(sio, 'http://semanticscience.org/resource/SIO_').   40:- rdf_register_prefix(ncitevs, 'http://ncicb.nci.nih.gov/xml/owl/EVS/Thesaurus.owl#').   41:- rdf_register_prefix(umls, 'http://linkedlifedata.com/resource/umls/id/').   42:- rdf_register_prefix(ncbigene, 'http://identifiers.org/ncbigene/').
 disease(?D:disgenet_disease) is nondet
   47disease(D) :- rdf(D,rdf:type,ncitevs:'C7057').
 gene(?G:disgenet_gene) is nondet
   50gene(G) :- rdf(G,rdf:type,ncitevs:'C16612').
 association(?A:disgenet_annotation) is nondet
   53association(A) :- rdfs_individual_of(A,sio:'000897').
 gene_disease_association(?A:disgenet_annotation) is nondet
 gene_disease_association(?A:disgenet_annotation, ?G:disgenet_gene, ?D:disgenet_disease) is nondet
 gene_disease_association(?A:disgenet_annotation, ?G:disgenet_gene, ?D:disgenet_disease, ?P) is nondet
gene G is associated with disease D via evidence A
   60gene_disease_association(A) :- rdfs_individual_of(A,sio:'001121').
   61gene_disease_association(A,G,D) :- gene_disease_association(A),refers_to(A,G),gene(G),refers_to(A,D),disease(D).
   62gene_disease_association(A,G,D,P) :- gene_disease_association(A),refers_to(A,G),gene(G),refers_to(A,D),disease(D),has_evidence(A,P).
 disease_pair_by_shared_gene(?D1:disgenet_disease, ?D2:disgenet_disease, ?G:disgenet_gene) is nondet
both D1 and D2 are associated with the same gene G
   67disease_pair_by_shared_gene(D1,D2,G) :- gene_disease_association(_,G,D1),gene_disease_association(_,G,D2).
   68
   69% these should go to a generic SIO module
   70%has_measurement_value(A,V) :- rdf(A,sio:'000772',V).
   71%has_source(A,V) :- rdf(A,sio:'000253',V).
   72%has_value(A,V) :- rdf(A,sio:'000300',V).