1:- module(ebi,
    2          [
    3
    4           sample/1,
    5           sample_attribute/2,
    6           attribute_property_value/3,
    7           attribute_property_value/4,
    8           attribute_property_value/5,
    9           sample_biocharacteristic/2,
   10           sample_property_value/3,
   11           sample_property_value/4,
   12           sample_depth/2,
   13           sample_environment_feature/2,
   14           
   15           identifier/2,
   16           description/2,
   17           direct_mapping/2,
   18           see_also/2,
   19           alt_label/2,
   20           exon/1,
   21           protein_coding_gene/1,
   22           paralogous_to/2,
   23           orthologous_to/2,
   24           homologous_to/2,
   25           in_taxon/2,
   26           transcribed_from/2,
   27           translates_to/2,
   28           has_part/2,
   29
   30           feature_in_range/4,
   31           mouse_ortho_by_range/5,
   32           has_mouse_ortholog/2
   33           ]).   34
   35:- use_module(library(sparqlprog/ontologies/faldo)).   36:- use_module(library(sparqlprog/ontologies/sequence_feature), []).   37
   38:- sparql_endpoint( ebi, 'https://www.ebi.ac.uk/rdf/services/sparql').   39%:- sparql_endpoint( ebi, ['https://www.ebi.ac.uk/rdf/services/sparql', 'https://integbio.jp/rdf/mirror/ebi/sparql']).
   40
   41% samples
   42:- rdf_register_prefix(biosd_terms, 'http://rdf.ebi.ac.uk/terms/biosd/').   43:- rdf_register_prefix(biosd, 'http://rdf.ebi.ac.uk/resource/biosamples/sample/').   44
   45
   46:- rdf_register_prefix(ebi_atlas, 'http://rdf.ebi.ac.uk/terms/atlas/').   47
   48:- rdf_register_prefix(skos, 'http://www.w3.org/2004/02/skos/core#').   49:- rdf_register_prefix(ensembl,'http://rdf.ebi.ac.uk/resource/ensembl/').   50:- rdf_register_prefix(ensembl_protein,'http://rdf.ebi.ac.uk/resource/ensembl.protein/').   51:- rdf_register_prefix(dcterms,'http://purl.org/dc/terms/').   52:- rdf_register_prefix(so, 'http://purl.obolibrary.org/obo/SO_').   53:- rdf_register_prefix(ro, 'http://purl.obolibrary.org/obo/RO_').   54:- rdf_register_prefix(sio, 'http://semanticscience.org/resource/SIO_').   55:- rdf_register_prefix(taxon, 'http://identifiers.org/taxonomy/').   56:- rdf_register_prefix(human, 'http://identifiers.org/taxonomy/9606').   57
   58% Note: this needs updating every ensemnl release...    
   59:- rdf_register_prefix(grch38, 'http://rdf.ebi.ac.uk/resource/ensembl/92/homo_sapiens/GRCh38/').   60:- rdf_register_prefix(grcm38, 'http://rdf.ebi.ac.uk/resource/ensembl/92/mus_musculus/GRCm38/').   61
   62
   63sample(A) :- rdf(A,rdf:type,biosd_terms:'Sample').
 sample_biocharacteristic(?S:ebi_biosample, ?A:ebi_attribute_node) is nondet
   66sample_biocharacteristic(S,A) :-
   67        rdf(S,biosd_terms:'has-bio-characteristic',A).
 sample_attribute(?S:ebi_biosample, ?A:ebi_attribute_node) is nondet
   72sample_attribute(S,A) :-
   73        rdf(S,biosd_terms:'has-sample-attribute',A).
 attribute_property_value(?A:ebi_attribute_node, ?P:ebi_biosample_property, ?V:ebi_biosample_value) is nondet
   77attribute_property_value(A, P, V) :-
   78        rdf(A,ebi_atlas:propertyType,P),
   79        rdf(A,ebi_atlas:propertyValue,V).
   80attribute_property_value(A, P, V, T) :-
   81        rdf(A,rdf:type,T),
   82        rdf(A,ebi_atlas:propertyType,P),
   83        rdf(A,ebi_atlas:propertyValue,V).
   84attribute_property_value(A, P, V, T, G) :-
   85        rdf(A,rdf:type,T, G),
   86        rdf(A,ebi_atlas:propertyType,P),
   87        rdf(A,ebi_atlas:propertyValue,V).
 sample_property_value(?S:ebi_biosample, ?P:ebi_biosample_property, ?V:ebi_biosample_value) is nondet
   91sample_property_value(S, P, V) :-
   92        sample_attribute(S, A),
   93        attribute_property_value(A,P,V).
   94sample_property_value(S, P, V, T) :-
   95        sample_attribute(S, A),
   96        attribute_property_value(A,P,V, T).
   97
   98sample_depth(S,V) :-
   99        sample_property_value(S, "depth"^^xsd:string, V).
  100sample_environment_feature(S,V) :-
  101        sample_property_value(S,  "environment feature"^^xsd:string, V).
  102
  103% B seems to always be identifiers.org
  104see_also(A,B) :- rdf(A,rdfs:seeAlso,B).
  105
  106alt_label(A,B) :- rdf(A,skos:altLabel,B).
  107
  108in_taxon(A,B) :- rdf(A,ro:'0002162',B).
  109
  110identifier(A,X) :- rdf(A,dcterms:identifier,X).
  111description(A,X) :- rdf(A,dcterms:description,X).
  112translates_to(T,P) :- rdf(T,so:translates_to,P).  % e.g. T to G
  113transcribed_from(T,G) :- rdf(T,so:transcribed_from,G).  % e.g. T to G
  114has_part(T,E) :- rdf(T,so:has_part,E).                  % e.g. T to E
  115
  116direct_mapping(A,B) :- rdf(A,'http://rdf.ebi.ac.uk/terms/ensembl/DIRECT',B).
  117
  118protein_coding_gene(G) :- rdf(G,rdf:type,so:'0001217').
  119exon(X) :- rdf(X,rdf:type,so:'0000147').
  120transcript(X) :- rdf(X,rdf:type,so:'0000234').
  121
  122homologous_to(A,B) :- orthologous_to(A,B).
  123homologous_to(A,B) :- paralogous_to(A,B).
  124
  125orthologous_to(A,B) :- rdf(A,sio:'000558',B).
  126paralogous_to(A,B) :- rdf(A,'http://semanticscience.org/resource/SIO:000630',B).  % EBI uses incorrect PURL
  127
  128foo1('0').
  129
  130feature_in_range(Chr,B,E,F) :-
  131        location(F,FB,FE,Chr),
  132        FB >= B,
  133        FE =< E.
  134
  135% mostly for demo:
  136mouse_ortho_by_range(Chr,B,E,G,H) :-
  137        protein_coding_gene(G), % SO
  138        feature_in_range(Chr,B,E,G),
  139        orthologous_to(G,H),
  140        in_taxon(H,taxon:'10090').
  141
  142foo2('0').
  143
  144has_mouse_ortholog(HumanGene, MouseGene) :- 
  145        orthologous_to(MouseGene, HumanGene),
  146        in_taxon(MouseGene,taxon:'10090')