1:- module(faldo,
    2          [
    3
    4           location/2,
    5           location/4,
    6           location/5,
    7           stranded_location/6,
    8           begin/2,
    9           end/2,
   10
   11           begin_coord/3,
   12           end_coord/3,
   13           position/2,
   14           reference/2,
   15
   16           feature_contains/2
   17           ]).

wrapper for FALDO genome interval vocabulary

FALDO is a vocabulary for specifying locations of sequence features along sequence intervals (DNA, RNA, or protein sequences). This module provides convenient wrappers for this vocabulary.

*/

   29:- use_module(library(typedef)).   30:- use_module(library(sparqlprog/owl_types)).   31
   32:- rdf_register_prefix(faldo,'http://biohackathon.org/resource/faldo#').   33
   34% TYPES
   35
   36:- type faldo_feature ---> rdf_resource.
   37:- type faldo_location ---> rdf_resource.
 location(?F:faldo_feature, ?L:faldo_location) is nondet
L is the location of feature F
   45location(F,L) :- rdf(F,faldo:location,L).
 location(?F, ?L, ?B, ?E, ?R) is nondet
 location(?F, ?B, ?E, ?R) is nondet
feature F has location L, which has starts at B, ends at E, on reference R

assumes feature is not split across references

   53location(F,L,B,E,R) :- rdf(F,faldo:location,L),begin(L,PB),position(PB,B),reference(PB,R),end(L,PE),position(PE,E),reference(PE,R).
   54location(F,B,E,R) :- location(F,_,B,E,R).
   55
   56
   57
   58%stranded_location(F,L,B,E,R,Str) :- location(F,L,B,E,R), bind(if(B<E, 1, -1), Str).
   59
   60stranded_location(F,L,B,E,R,Str) :- location(F,L,B,E,R), B < E, bind(1,Str).
   61stranded_location(F,L,E,B,R,Str) :- location(F,L,B,E,R), B > E, bind(-1,Str).
   62stranded_location(F,L,B,B,R,Str) :- location(F,L,B,B,R), bind(0,Str).
 begin(?L, ?P) is nondet
location L starts at position P
   70begin(L,P):- rdf(L,faldo:begin,P).
 end(?L, ?P) is nondet
location L ends at position P
   76end(L,P):- rdf(L,faldo:end,P).
 begin_coord(?L, ?C, ?R) is nondet
location L has start coordinate value C on reference R
   83begin_coord(L,C,R):- begin(L,P),position(P,C),reference(P,R).
 end_coord(?L, ?C, ?R) is nondet
location L has end coordinate value C on reference R
   89end_coord(L,C,R):- end(L,P),position(P,C),reference(P,R).
 position(?L, ?P) is nondet
location L has position P
   96position(L,P):- rdf(L,faldo:position,P).
 reference(?L, ?R) is nondet
location L has reference R
  102reference(L,R):- rdf(L,faldo:reference,R).
  103
  104feature_contains(F1,F2) :-
  105        location(F1,B1,E1,R),
  106        E1>B1,
  107        location(F2,B2,E2,R),
  108        B2 =< E1,
  109        B2 >= B1,
  110        E2 =< E1,
  111        E2 >= B1,
  112        F1\=F2