amalgame/commit

avoid direct queries on skos:broader/narrower

authorJacco van Ossenbruggen
Thu Aug 14 09:12:34 2014 +0200
committerJacco van Ossenbruggen
Thu Aug 14 09:12:34 2014 +0200
commit74e7cfcc66c023bb231a6ef5da7a26182601d7b7
tree8e1fcb1621ddaf503b85207be5d8469779aa5058
parent0c8c764dea11b937771b1b67dfb627c30980c180
Diff style: patch stat
diff --git a/applications/builder.pl b/applications/builder.pl
index 835406c..0c44261 100644
--- a/applications/builder.pl
+++ b/applications/builder.pl
@@ -10,6 +10,8 @@
 :- use_module(library(yui3_beta)).
 :- use_module(user(user_db)).
 
+:- use_module(library(skos/util)).
+
 :- use_module(library(amalgame/voc_stats)).
 :- use_module(library(amalgame/util)).
 :- use_module(library(amalgame/json_util)).
@@ -336,7 +338,7 @@ graph_mappings(Graphs, Graphs).
 
 
 mapped_descendant_count(Concept, Graphs, Count) :-
-	findall(C, descendant_of(Concept, C), Descendants0),
+	findall(C, skos_descendant_of(Concept, C), Descendants0),
 	sort(Descendants0, Descendants),
 	(   Descendants	= []
 	->  Count = @null
@@ -346,14 +348,6 @@ mapped_descendant_count(Concept, Graphs, Count) :-
 	    atomic_list_concat([Mapped_Count, '/', Descendant_Count], Count)
 	).
 
-descendant_of(Concept, D) :-
-	rdf_reachable(D, skos:broader, Concept),
-	\+ D = Concept.
-descendant_of(Concept, D) :-
-	rdf_reachable(Concept, skos:narrower, D),
-	\+ D = Concept.
-
-
 mapped_chk([], _, []).
 mapped_chk([C|T], Graphs, [C|Rest]) :-
 	is_mapped(C, Graphs),
diff --git a/components/amalgame/correspondence.pl b/components/amalgame/correspondence.pl
index 636b95d..1852859 100644
--- a/components/amalgame/correspondence.pl
+++ b/components/amalgame/correspondence.pl
@@ -242,39 +242,34 @@ image_examples(R, Es) :-
 
 %%	resource_tree(+Resource, -Tree)
 %
-%	Tree contains the ancesestors and children from Resource.
+%	Tree contains the ancestors and children from Resource.
 
 resource_tree(R, Tree) :-
 	Node = node(R, [hit], Children),
-	rdf_equal(skos:broader, Rel),
-	ancestor_tree(Node, Rel, Tree, []),
-        children(R, Rel, Children, []).
+	ancestor_tree(Node, Tree, []),
+        children(R, Children).
 
-ancestor_tree(Node, Rel, Tree, Options) :-
+ancestor_tree(Node, Tree, Options) :-
         Node = node(URI,_,_),
-        rdf_has(URI, Rel, Parent),
+	skos_parent_child(Parent, URI),
         URI \== Parent,
         (   select_option(sibblings(true), Options, Options1)
-        ->  ancestor_tree(node(Parent, [], [Node|Siblings]), Rel, Tree, Options1),
-            children(Parent, Rel, Children, Options),
+        ->  ancestor_tree(node(Parent, [], [Node|Siblings]), Tree, Options1),
+            children(Parent, Children),
             select(node(URI,_,_), Children, Siblings)
-        ;   ancestor_tree(node(Parent, [], [Node]), Rel, Tree, Options)
+        ;   ancestor_tree(node(Parent, [], [Node]), Tree, Options)
         ).
-ancestor_tree(Tree, _Rel, Tree, _).
-
-children(R, Rel, Children, _Options) :-
-        findall(node(Child, [], HasChild),
-		(   rdf_has(Child, Rel, R),
-		    has_child(Child, Rel, HasChild)
-		),
-		Children).
-
-has_child(R, Rel, true) :-
-        rdf_has(_, Rel, R),
-        !.
-has_child(_, _, false).
+ancestor_tree(Tree, Tree, _).
 
+children(Concept, List) :-
+	findall(D, skos_descendant_of(Concept, D), Dlist),
+	maplist(has_child, Dlist, List).
 
+has_child(C, node(C, [], HasChild)) :-
+	  (   skos_parent_child(C, _)
+	  ->  HasChild = true
+	  ;   HasChild = false
+	  ).
 
 html_alt_labels([]) --> !.
 html_alt_labels(Alt) -->
diff --git a/lib/ag_modules/ancestor_match.pl b/lib/ag_modules/ancestor_match.pl
index f627164..b6b6f1f 100644
--- a/lib/ag_modules/ancestor_match.pl
+++ b/lib/ag_modules/ancestor_match.pl
@@ -2,6 +2,7 @@
 	  []).
 
 :- use_module(library(semweb/rdf_db)).
+:- use_module(library(skos/util)).
 :- use_module(library(amalgame/vocabulary)).
 :- use_module(library(amalgame/map)).
 
@@ -78,15 +79,8 @@ match(align(S, T, Prov0), BackgroundMatches, align(S, T, [Prov|Prov0]), Options)
 	       ].
 
 ancestor(R, MaxSteps, Parent, rdf(R, Prop, Parent), Steps) :-
-	rdf_equal(skos:broader, Prop),
-	rdf_reachable(R, Prop, Parent, MaxSteps, Steps),
-	\+ R == Parent.
-ancestor(R, MaxSteps, Parent, rdf(R, Broader, Parent), Steps) :-
-	rdf_equal(skos:narrower, Narrower),
-	rdf_equal(skos:broader, Broader),
-	rdf_reachable(Parent, Narrower, R, MaxSteps, Steps),
-	\+ R == Parent,
-	\+ rdf_reachable(R, Broader, Parent).
+	skos_descendant_of(Parent, R, MaxSteps, Steps),
+	rdf_equal(amalgame:descendant, Prop).
 
 selecter(In, Sel, Dis, Und, Options) :-
 	option(snd_input(SecList), Options),
diff --git a/lib/ag_modules/descendent_match.pl b/lib/ag_modules/descendent_match.pl
index 77f830d..ebb744e 100644
--- a/lib/ag_modules/descendent_match.pl
+++ b/lib/ag_modules/descendent_match.pl
@@ -2,6 +2,7 @@
 	  []).
 
 :- use_module(library(semweb/rdf_db)).
+:- use_module(library(skos/util)).
 :- use_module(library(amalgame/vocabulary)).
 :- use_module(library(amalgame/map)).
 
@@ -76,18 +77,9 @@ match(align(S, T, Prov0), BackgroundMatches, align(S, T, [Prov|Prov0]), Options)
 		graph([R1,R2])
 	       ].
 
-	/* FIXME: need to make a decision about what to do with align:relation ...
-        */
-
 descendent(R, MaxSteps, Child, rdf(R, Prop, Child), Steps) :-
-	rdf_equal(skos:narrower, Prop),
-	rdf_reachable(R, Prop, Child, MaxSteps, Steps),
-	\+ R == Child.
-descendent(R, MaxSteps, Child, rdf(Child, Prop, R), Steps) :-
-	rdf_equal(skos:broader, Prop),
-	rdf_reachable(Child, Prop, R, MaxSteps, Steps),
-	\+ R == Child,
-	\+ rdf_reachable(R, skos:narrower, Child).
+	skos_descendant_of(R, Child, MaxSteps, Steps),
+	rdf_equal(amalgame:descendant, Prop).
 
 selecter(In, Sel, Dis, Und, Options) :-
 	option(snd_input(SecList), Options),
diff --git a/lib/ag_modules/most_generic.pl b/lib/ag_modules/most_generic.pl
index 061ffcd..294faf3 100644
--- a/lib/ag_modules/most_generic.pl
+++ b/lib/ag_modules/most_generic.pl
@@ -1,6 +1,7 @@
 :- module(most_generic,[]).
 
 :- use_module(library(semweb/rdf_db)).
+:- use_module(library(skos/util)).
 :- use_module(library(amalgame/map)).
 
 :- public amalgame_module/1.
@@ -60,10 +61,10 @@ hierarchy_related([], _, align(S,T,P), align(S,T,Pnew), []) :-
 hierarchy_related([A|As], target, G0, G, [A1|Rest]) :-
 	A = align(_,T,_),
 	G0 = align(_,T0,_),
-	(   rdf_reachable(T, skos:broader, T0)
+	(   skos_descendant_of(T0, T)
 	->  G1 = G0,
 	    A1 = A
-	;   rdf_reachable(T0, skos:broader, T)
+	;   skos_descendant_of(T, T0)
 	->  G1 = A,
 	    A1 = G0
 	),
@@ -72,10 +73,10 @@ hierarchy_related([A|As], target, G0, G, [A1|Rest]) :-
 hierarchy_related([A|As], source, G0, G, [A1|Rest]) :-
 	A = align(S,_,_),
 	G0 = align(S0,_,_),
-	(   rdf_reachable(S, skos:broader, S0)
+	(   skos_descendant_of(S0, S)
 	->  G1 = G0,
 	    A1 = A
-	;   rdf_reachable(S0, skos:broader, S)
+	;   skos_descendant_of(S, S0)
 	->  G1 = A,
 	    A1 = G0
 	),
diff --git a/lib/ag_modules/sibling_selecter.pl b/lib/ag_modules/sibling_selecter.pl
index c8487e0..bce60f3 100644
--- a/lib/ag_modules/sibling_selecter.pl
+++ b/lib/ag_modules/sibling_selecter.pl
@@ -1,6 +1,7 @@
 :- module(sibling_selecter,[]).
 
 :- use_module(library(semweb/rdf_db)).
+:- use_module(library(skos/util)).
 :- use_module(library(amalgame/map)).
 
 :- public amalgame_module/1.
@@ -43,7 +44,7 @@ partition_(target, [A|As], Depth, Sel, Und) :-
 	A = align(S,T,_),
 	same_source(As, S, Same, Rest),
 	(   Same \= [],
-	    rdf_reachable(T, skos:broader, Parent, Depth, _),
+	    skos_descendant_of(Parent,T, Depth, _),
 	    siblings(target, Same, Parent, Depth)
 	->  append([A|Same], SelRest, Sel),
 	    Und = UndRest
@@ -56,7 +57,7 @@ partition_(source, [A|As], Depth, Sel, Und) :-
 	A = align(S,T,_),
 	same_target(As, T, Same, Rest),
 	(   Same \= [],
-	    rdf_reachable(S, skos:broader, Parent, Depth, _),
+	    skos_descendant_of(Parent, S, Depth, _),
 	    siblings(source, Same, Parent, Depth)
 	->  append([A|Same], SelRest, Sel),
 	    Und = UndRest
@@ -68,13 +69,13 @@ partition_(source, [A|As], Depth, Sel, Und) :-
 siblings(_, [], _, _).
 siblings(target, [A|As], Parent, Depth) :-
 	A = align(_,T,_),
-	rdf_reachable(T, skos:broader, Parent, Depth, _),
+	skos_descendant_of(Parent, T, Depth, _),
 	!,
 	siblings(target, As, Parent, Depth).
 
 siblings(source, [A|As], Parent, Depth) :-
 	A = align(S,_,_),
-	rdf_reachable(S, skos:broader, Parent, Depth, _),
+	skos_descendant_of(Parent, S, Depth, _),
 	!,
 	siblings(source, As, Parent, Depth).
 
diff --git a/lib/amalgame/vocabulary.pl b/lib/amalgame/vocabulary.pl
index c66b709..67e039c 100644
--- a/lib/amalgame/vocabulary.pl
+++ b/lib/amalgame/vocabulary.pl
@@ -65,7 +65,8 @@ vocab_member(E, propvalue(Property, Value)) :- !,
 	rdf(E, Property, Value).
 vocab_member(E, subtree(Root)) :-
 	!,
-	rdf_reachable(E, skos:broader, Root).
+	skos_descendant_of(Root, E).
+
 vocab_member(F, 'http://sws.geonames.org/') :-
 	!,
 	rdfs_individual_of(F, 'http://www.geonames.org/ontology#Feature').