1/* wrappers for dbpedia
    2
    3Note that this only wraps a small subset of dbpedia, for demo purposes.
    4
    5For complete ontology use rdfs2pl
    6
    7  
    8  
    9*/
   10
   11:- module(dbpedia,
   12          [dbpedia_class/1,
   13           dbpedia_rootclass/1,
   14           person/1,
   15           musical_artist/1,
   16           band/1,
   17           photographer/1,
   18           disease/1,
   19           food/1,
   20
   21           related_to/2,
   22           has_child/2,
   23           child_of/2,
   24           descendant_of/2,
   25           has_director/2,
   26           directed/2,
   27           has_genre/2,
   28           band_member/2,
   29           has_name/2,
   30
   31           city/1,
   32           country/1,
   33           sport_competition_result/1]).   34
   35:- use_module(library(sparqlprog)).   36:- use_module(library(semweb/rdf11)).   37
   38:- sparql_endpoint( dbp, 'http://dbpedia.org/sparql/').   39
   40:- rdf_register_prefix(foaf,'http://xmlns.com/foaf/0.1/').   41:- rdf_register_prefix(dbont,'http://dbpedia.org/ontology/').   42:- rdf_register_prefix(dbr,'http://dbpedia.org/resource/').   43
   44
   45dbpedia_class(C) :- rdf(C,rdf:type,owl:'Class').
   46
   47dbpedia_rootclass(C) :- dbpedia_class(C),rdf(C,rdfs:subClassOf,owl:'Thing').
   48
   49
   50person(Person) :- rdf(Person,rdf:type,foaf:'Person').
 has_name(?S, ?L) is nondet
binds foaf:Name
   56has_name(S,L) :- rdf(S,foaf:'Name',L).
 has_genre(?S, ?G) is nondet
binds dbont:genre
   62has_genre(S,G) :- rdf(S,dbont:genre,G).
 has_director(?S, ?O) is nondet
binds dbont:director
   70has_director(S,O) :- rdf(S,dbont:director,O).
 directed(?S, ?O) is nondet
binds dbont:directed
   77directed(S,O) :- rdf(O,dbont:director,S).
 has_child(?S, ?O) is nondet
   83has_child(S,O) :- rdf(S,dbont:child,O).
 child_of(?S, ?O) is nondet
   89child_of(S,O) :- rdf(O,dbont:child,S).
 descendant_of(?S, ?O) is nondet
true if S can be connected to O via one or more has_child/2 relationships
   95descendant_of(S,O) :- rdf_path(O,oneOrMore(dbont:child),S).
 band_member(?S, ?O) is nondet
  102band_member(S,O) :- rdf(S,dbont:bandMember,O).
  103
  104related_to(S,O) :- related_to(S,O,_).
  105related_to(S,O,has_child) :- has_child(S,O).
  106related_to(S,O,has_parent) :- has_child(O,S).
  107
  108grandchild_of(S,O) :- child_of(S,Z),child_of(Z,O).
  109
  110
  111food(X) :- rdf(X,rdf:type,dbont:'Food').
 band(?X) is nondet
  119band(X) :- rdf(X,rdf:type,dbont:'Band').
 photographer(?X) is nondet
  125photographer(X) :- rdf(X,rdf:type,dbont:'Photographer').
 musical_artist(?X) is nondet
  131musical_artist(X) :- rdf(X,rdf:type,dbont:'MusicalArtist').
 disease(?X) is nondet
  138disease(X) :- rdf(X,rdf:type,dbont:'Disease').
  139
  140city(X) :- rdf(X,rdf:type,dbont:'City').
  141country(X) :- rdf(X,rdf:type,dbont:'Country').
  142sport_competition_result(X) :- rdf(X,rdf:type,dbont:'SportCompetitionResult')