1:- module(obo_util,
    2          [gen_obo/2,
    3           gen_stanza/3,
    4           gen_header/3,
    5
    6           entity_def_xrefs/3
    7          ]).    8
    9:- use_module(library(obo_metadata/oio)).   10
   11:- use_module(library(semweb/rdf11)).   12:- use_module(library(semweb/rdfs)).   13:- use_module(library(sparqlprog/owl_util)).   14:- use_module(library(sparqlprog/ontologies/obo)).   15:- use_module(library(sparqlprog/emulate_builtins)).   16
   17entity_obotype(E,T) :- entity_obotype(E,T,_).
   18entity_obotype(E,'Term',G) :- rdf(E,rdf:type,owl:'Class',G), rdf_is_iri(E).
   19entity_obotype(E,'Typedef',G) :- rdf(E,rdf:type,owl:'ObjectProperty',G).
   20
   21ensure_curie_wrap(U,X) :-
   22        ensure_curie(U,X1),
   23        (   atom_concat('http://purl.obolibrary.org/obo/',Frag,X1),
   24            concat_atom([Pre,Post],'_',Frag)
   25        ->  concat_atom([Pre,Post],':',X)
   26        ;   X=X1).
   27
   28
   29        
   30ensure_id(U,Id) :-
   31        ensure_curie_wrap(U,X),
   32        (   atom_concat(Id,':',X)
   33        ->  true
   34        ;   Id=X).
   35
   36
   37entity_def_xrefs(E,D,Xs) :-
   38        triple_property_axiom_annotations(E,def:'',D1,oio:hasDbXref,Xs1),
   39        ensure_atom(D1,D),
   40        ensure_atoms(Xs1,Xs).
   41
   42
   43syntype_uri_to_id(V1,V) :-
   44        concat_atom([_,V],'#',V1),
   45        !.
   46syntype_uri_to_id(V,V).
   47
   48entity_xref_xrefs(E,X,QVs) :-
   49        triple_axiom_annotations(E,oio:hasDbXref,X1,QVs),
   50        ensure_atom(X1,X).
   51
   52
   53entity_xref_prefix_srcont(C,X,P,S) :-
   54        entity_xref_prefix(C,X,P),
   55        entity_xref_src(C,X,SC),
   56        curie_prefix(SC,S).
   57
   58entity_synonym_scope_type_xrefs(E,V,Scope,Type,Xrefs) :-
   59        synprop_scope(P,Scope),
   60        triple_axiom_annotations(E,P,V1,Anns),
   61        ensure_atom(V1,V),
   62        convlist(['http://www.geneontology.org/formats/oboInOwl#hasDbXref'-Y1,
   63                  Y]>>ensure_atom(Y1,Y),
   64                 Anns,Xrefs),
   65        (   member('http://www.geneontology.org/formats/oboInOwl#hasSynonymType'-Type1,Anns)
   66        ->  syntype_uri_to_id(Type1,Type)
   67        ;   Type='').
   68
   69subset_uri_to_id(V1,V) :-
   70        % envo has some subset tags as strings
   71        rdf_is_literal(V1),
   72        !,
   73        ensure_atom(V1,V).
   74subset_uri_to_id(V1,V) :-
   75        concat_atom([_,V],'#',V1),
   76        !.
   77subset_uri_to_id(V,V).
   78
   79
   80entity_subset_id(E,V) :-
   81        rdf(E,oio:inSubset,V1),
   82        subset_uri_to_id(V1,V).
 curie_prefix(Literal:str, Pre:str)
curie_prefix(Literal,Pre) :- str_before(Literal,":",Pre).
   90entity_nameatom(E,N) :-
   91        label(E,N1),
   92        ensure_atom(N1,N).
   93
   94
   95gen_obo(S,Opts) :-
   96        gen_obo(S,_,Opts).
   97
   98gen_obo(S,G,Opts) :-
   99        forall(gen_header(S,G,Opts),true),
  100        format(S,'~n',[]),
  101        setof(E,T^entity_obotype(E,T,G),Es),
  102        forall((member(E,Es),\+is_dangling(E)),
  103               gen_stanza(S,E,G,Opts)).
  104
  105
  106
  107gen_header(S,G,Opts) :-
  108        forall(gen_header1(S,G,Opts),true).
  109
  110gen_header1(S,G,_) :-
  111        rdf_graph(G),
  112        ensure_id(G,Id),
  113        format(S,'ontology: ~w~n',Id).
  114gen_header1(S,_G,_) :-
  115        rdf(V1,rdfs:subPropertyOf,oio:'SubsetProperty'),
  116        subset_uri_to_id(V1,V),
  117        format(S,'subsetdef: ~w "~w"~n',[V,V]).
  118
  119gen_stanza(S,E,Opts) :-
  120        gen_stanza(S,E,_G,Opts).
  121
  122gen_stanza(S,E,G,Opts) :-
  123        entity_obotype(E,T),
  124        ensure_id(E,Id),
  125        format(S,'[~w]~n',[T]),
  126        format(S,'id: ~w~n',[Id]),
  127        forall(gen_tag(S,E,G,Opts),true),
  128        format(S,'~n',[]),
  129        !.
  130gen_stanza(_S,E,G,_Opts) :-
  131        format(user_error,'Cannot write: ~w ~w~n',[E,G]).
  132
  133
  134
  135gen_tag(S,E,_,_) :-
  136        entity_nameatom(E,N),
  137        format(S,'name: ~w~n',[N]).
  138gen_tag(S,E,_,_) :-
  139        entity_def_xrefs(E,N,Xrefs),
  140        escq(N,N1),
  141        serialize_xrefs(Xrefs,X),
  142        format(S,'def: "~w" ~w~n',[N1,X]).
  143
  144gen_tag(S,E,_,_) :-
  145        entity_subset_id(E,X),
  146        format(S,'subset: ~w~n',[X]).
  147
  148gen_tag(S,E,_,_) :-
  149        entity_synonym_scope_type_xrefs(E,V1,Scope,Type,Xrefs),
  150        serialize_xrefs(Xrefs,X),
  151        escq(V1,V),
  152        format(S,'synonym: "~w" ~w ~w ~w~n',[V,Scope,Type,X]).
  153
  154gen_tag(S,E,_,_) :-
  155        entity_xref_xrefs(E,X,_PVs),
  156        format(S,'xref: ~w~n',[X]).
  157
  158gen_tag(S,E,_,_) :-
  159        is_a(E,X),
  160        tv(S,is_a,[X]).
  161
  162gen_tag(S,E,_,_) :-
  163        relationship(E,R,O),
  164        tv(S,relationship,[R,O]).
  165
  166gen_tag(S,E,_,_) :-
  167        class_genus(E,G),
  168        \+ \+ class_differentia(E,_,_),
  169        tv(S,intersection_of,[G]),
  170        forall(class_differentia(E,P,Y),
  171               tv(S,intersection_of,[P,Y])).
  172
  173gen_tag(S,E,_,_) :-
  174        rdf(E,rdf:type,owl:'TransitiveProperty'),
  175        tv(S,is_transitive,[true]).
  176
  177tv(S,T,Vs) :-
  178        format(S,'~w:',[T]),
  179        forall((member(V,Vs),ensure_id(V,Id)),
  180               format(S,' ~w',[Id])),
  181        findall(N,(member(V,Vs),entity_nameatom(V,N)),
  182                Ns),
  183        (   Ns=[]
  184        ->  true
  185        ;   format(S,' !',[]),
  186            forall(member(N,Ns),
  187                   format(S,' ~w',[N]))),
  188        nl(S).
  189
  190
  191serialize_xrefs(Xs,A) :-
  192        concat_atom(Xs,', ',A1),
  193        concat_atom(['[',A1,']'],A).
  194
  195
  196
  197escq(A,C) :-
  198        concat_atom(Xs,'"',A),
  199        concat_atom(Xs,'\\"',B),
  200        concat_atom(Xs2,'\n',B),
  201        concat_atom(Xs2,' ',C)