5
6:- module(monarch,
7 [
8
9 protein_coding_gene/1,
10 human_gene/1,
11 disease_to_gene/2,
12 13 association/4,
14 association/5,
15 clinvar_to_rs_number/2,
16 dbsnp_to_rs_number/2,
17 has_phenotype_association/3,
18 has_phenotype_association/4,
19 has_phenotype_freq/3,
20
21 phenotype_rel/3,
22 disease_to_phenotype_SD/2,
23 disease_to_phenotype_EE/4,
24 disease_to_phenotype_EE/2,
25
26 disease_to_phenotype_SX/4
27 ]). 28
29:- use_module(library(sparqlprog)). 30:- use_module(library(semweb/rdf11)). 31:- use_module(library(sparqlprog/ontologies/oban)). 32
34:- sparql_endpoint( monarch, 'https://translator.ncats.io/monarch-blazegraph/namespace/kb/sparql/'). 35
36
37:- rdf_register_ns(oio,'http://www.geneontology.org/formats/oboInOwl#'). 38:- rdf_register_prefix(oban,'http://purl.org/oban/'). 39:- rdf_register_prefix(foaf,'http://xmlns.com/foaf/0.1/'). 40:- rdf_register_prefix(obo,'http://purl.obolibrary.org/obo/'). 41:- rdf_register_prefix(mondo,'http://purl.obolibrary.org/obo/MONDO_'). 42:- rdf_register_prefix(so,'http://purl.obolibrary.org/obo/SO_'). 43:- rdf_register_prefix(bds,'http://www.bigdata.com/rdf/search#'). 44:- rdf_register_prefix(monarch,'https://monarchinitiative.org/'). 45
47:- rdf_register_prefix(mgi,'http://www.informatics.jax.org/accession/MGI:'). 48:- rdf_register_prefix(orphanet,'http://www.orpha.net/ORDO/Orphanet_'). 49:- rdf_register_prefix(clinvar,'http://www.ncbi.nlm.nih.gov/clinvar/'). 50
51id_uri(ID,URI) :-
52 concat_atom([Pre,Frag],':',ID),
53 concat_atom(['http://purl.obolibrary.org/obo/',Pre,'_',Frag],URI).
54
56user:term_expansion(pname_id(P,Id),
57 [( Head :- Body),
58 (:- initialization(export(P/2), now))
59 ]) :-
60 Head =.. [P,S,O],
61 id_uri(Id,Px),
62 Body = rdf(S,Px,O).
63
68user:term_expansion(cname_id(C,Id),
69 [Rule,
70 RuleInf,
71 RuleIsa,
72 (:- initialization(export(InfC/1), now)),
73 (:- initialization(export(SubC/1), now)),
74 (:- initialization(export(C/1), now))
75 ]) :-
76 id_uri(Id,Cx),
77
78 Head =.. [C,I],
79 Body = rdf(I,rdf:type,Cx),
80 Rule = (Head :- Body),
81
82 atom_concat(C,'_inf',InfC),
83 Head2 =.. [InfC,I],
84 Body2 = rdfs_individual_of(I,Cx),
85 RuleInf = (Head2 :- Body2),
86
87 atom_concat('isa_',C,SubC),
88 Head3 =.. [SubC,I],
89 Body3 = rdfs_subclass_of(I,Cx),
90 RuleIsa = (Head3 :- Body3).
91
92
93
94has_phenotype_association(A,S,O) :-
95 has_phenotype_iri(P),
96 association(A,S,P,O).
97
98has_phenotype_association(A,S,O,Src) :-
99 has_phenotype_association(A,S,O),
100 rdf(A,dc:source,Src).
101
102has_phenotype_freq(X,P,F) :-
103 has_phenotype_association(X,P,A),
104 rdf(A,monarch:frequencyOfPhenotype,F).
112disease_to_phenotype_EE(D,P) :-
113 disease_to_phenotype_EE(D,P,_,_).
114disease_to_phenotype_EE(D,P,Dx,Px) :-
115 owl_equivalent_class(D,Dx),
116 has_phenotype(Dx,Px),
117 owl_equivalent_class(Px,P).
124disease_to_phenotype_ED(D,P) :-
125 owl_equivalent_class(D,Dx),
126 has_phenotype(Dx,P).
133disease_to_phenotype_SD(D,P) :-
134 rdfs_subclass_of(Ds,D),
135 owl_equivalent_class(Ds,Dx),
136 has_phenotype(Dx,P).
137
138disease_to_phenotype_SX(D,P,Dx,Px) :-
139 rdfs_subclass_of(Ds,D),
140 owl_equivalent_class(Ds,Dx),
141 has_phenotype(Dx,Px),
142 owl_equivalent_class(Px,P).
143
144
145d2v(D,V) :- is_marker_for(V,D).
146disease_to_gene(D,G) :- is_marker_for(V,D),rdf(V,obo:'GENO_0000418',G).
147
148
149
150protein_coding_gene(G) :- rdfs_subclass_of(G,obo:'SO_0001217').
151human_gene(G) :- protein_coding_gene(G), in_taxon(G,obo:'NCBITaxon_9606').
152
153
154phenotype_rel(Ph,Pr,Y) :-
155 rdf(Ph,owl:equivalentClass,EP),
156 has_part_iri(HasPart),
157 owl_some(EP,HasPart,I),
158 intersection_member(I,M),
159 owl_some(M,Pr,Y).
160
161
162clinvar_to_rs_number(V,Id) :-
163 164 rdf(V,rdf:type,obo:'GENO_0000030'),
165 rdf(V,oio:hasdbxref,X),
166 dbsnp_to_rs_number(X,Id).
167
168dbsnp_to_rs_number(X,Id) :-
169 170 replace(str(X),"http://www.ncbi.nlm.nih.gov/projects/SNP/snp_ref.cgi?rs=","",Id).
171dbsnp_to_curie(X,Id) :-
172 replace(str(X),"http://www.ncbi.nlm.nih.gov/projects/SNP/snp_ref.cgi?rs=","dbSNP:",Id).
173
174
175
178
179
181
182cname_id('individual_organism', 'SIO:010000').
183cname_id('disease', 'MONDO:0000001').
184cname_id('phenotypic_feature', 'UPHENO:0000001').
185cname_id('confidence_level', 'CIO:0000028').
186cname_id('evidence_type', 'ECO:0000000').
187cname_id('publication', 'IAO:0000311').
188cname_id('chemical_substance', 'SIO:010004').
189cname_id('genomic_entity', 'SO:0000110').
190cname_id('genome', 'SO:0001026').
191cname_id('transcript', 'SO:0000673').
192cname_id('exon', 'SO:0000147').
193cname_id('coding_sequence', 'SO:0000316').
194cname_id('gene', 'SO:0000704').
195cname_id('protein', 'PR:000000001').
196cname_id('RNA_product', 'CHEBI:33697').
197cname_id('microRNA', 'SO:0000276').
198cname_id('macromolecular_complex', 'GO:0032991').
199cname_id('gene_family', 'NCIT:C20130').
200cname_id('zygosity', 'GENO:0000133').
201cname_id('sequence_variant', 'GENO:0000512').
202cname_id('drug_exposure', 'ECTO:0000509').
203cname_id('treatment', 'OGMS:0000090').
204cname_id('molecular_activity', 'GO:0003674').
205cname_id('biological_process', 'GO:0008150').
206cname_id('cellular_component', 'GO:0005575').
207cname_id('cell', 'GO:0005623').
208