amalgame/commit

IMPROVED: Added new uniq_label_voc_select module

authorJacco van Ossenbruggen
Thu Apr 30 18:10:47 2015 +0200
committerJacco van Ossenbruggen
Thu Apr 30 18:10:47 2015 +0200
commit5e34550c292e45c2737d04d140cc17c0b52a4ccf
tree3e435fabe73661ba1096bc9853621e8111ffee7a
parentb70befdc53914796038047a046f3682e69bf06e2
Diff style: patch stat
diff --git a/config-available/ag_modules.pl b/config-available/ag_modules.pl
index 438d712..25b6698 100644
--- a/config-available/ag_modules.pl
+++ b/config-available/ag_modules.pl
@@ -36,6 +36,7 @@
 :- use_module(library(ag_modules/subtree_select)).
 :- use_module(library(ag_modules/type_select)).
 :- use_module(library(ag_modules/propvalue_select)).
+:- use_module(library(ag_modules/uniq_label_voc_select)).
 
 % MultiInput
 :- use_module(library(ag_modules/map_merger)).
diff --git a/lib/ag_modules/uniq_label_voc_select.pl b/lib/ag_modules/uniq_label_voc_select.pl
new file mode 100644
index 0000000..8e74bf9
--- /dev/null
+++ b/lib/ag_modules/uniq_label_voc_select.pl
@@ -0,0 +1,39 @@
+:- module(uniq_label_voc_select, []).
+
+:- public amalgame_module/1.
+:- public parameter/4.
+:- public specifier/5.
+:- public selecter/5.
+
+:- use_module(library(option)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(amalgame/vocabulary)).
+:- use_module(library(amalgame/ag_stats)).
+
+amalgame_module(amalgame:'UniqLabelVocSelect').
+
+parameter(property, uri, Default,
+	  'RDF property by which to select the concepts') :-
+	rdf_equal(skos:prefLabel, Default).
+parameter(language, oneof(L), Default,
+	  'Language of source label') :-
+	amalgame_vocabulary_languages(L),
+	(   member(en, L)
+	->  Default = en
+	;   L = [Default|_]
+	).
+
+specifier(VocSpec, Sel, Dis, Und, Options) :-
+	option(property(Property), Options),
+	option(language(Language), Options),
+	VocSpec = rscheme(Scheme),
+	node_stats(_Strategy, Scheme, Stats, [compute(deep)]),
+	Sel =  label(uniq,  Scheme, Property, Language, Stats),
+	Dis =  label(ambig, Scheme, Property, Language, Stats),
+	Und =  label(none,  Scheme, Property, Language, Stats).
+
+selecter(VocSpec, SelConcepts, DisConcepts, UndConcepts, Options) :-
+	specifier(VocSpec, SelSpec, DisSpec, UndSpec, Options),
+	all_vocab_members(SelSpec, SelConcepts),
+	all_vocab_members(DisSpec, DisConcepts),
+	all_vocab_members(UndSpec, UndConcepts).
diff --git a/lib/amalgame/vocabulary.pl b/lib/amalgame/vocabulary.pl
index feccf9d..c5d4cf8 100644
--- a/lib/amalgame/vocabulary.pl
+++ b/lib/amalgame/vocabulary.pl
@@ -79,6 +79,7 @@ vocab_member(E, type(Class)) :-
 vocab_member(E, graph(G)) :-
 	!,
 	rdf(E, rdf:type, _, G).
+
 vocab_member(E, propvalue(any, Value)) :- !,
 	rdf(E, _Property, Value).
 vocab_member(E, propvalue(Property, any)) :- !,
@@ -139,6 +140,25 @@ expand_vocab(Scheme, VocSpec) :-
 	rdfs_individual_of(Strategy, amalgame:'AlignmentStrategy'),
 	expand_node(Strategy, Scheme, VocSpec).
 
+get_amb_concepts(Property, Lang, Stats, Concepts) :-
+	get_dict(properties, Stats, PropsStats),
+	get_dict(Property, PropsStats, PropStats),
+	get_dict(Lang, PropStats, LocalStats),
+	get_dict(ambiguousConcepts, LocalStats, Concepts).
+
+all_vocab_members(label(Type, Scheme, Property, Lang, Stats), Concepts) :-
+	!,
+	get_amb_concepts(Property, Lang, Stats, Ambiguous),
+	(   Type == ambig
+	->  Concepts = Ambiguous
+	;   Type == uniq
+	->  all_vocab_members(Scheme, G1s),
+	    ord_subtract(G1s, Ambiguous, Concepts)
+	;   Type = none
+	->  all_vocab_members(Scheme, G1s),
+	    findall(C, (member(C, G1s), \+ rdf_has(C, Property, _)), Concepts)
+	).
+
 all_vocab_members(and(G1,not(G2)), Concepts) :-
 	!,
 	all_vocab_members(G1, G1s),
diff --git a/rdf/tool/ag_modules.ttl b/rdf/tool/ag_modules.ttl
index 31c8d55..1e65f63 100644
--- a/rdf/tool/ag_modules.ttl
+++ b/rdf/tool/ag_modules.ttl
@@ -164,6 +164,11 @@ amalgame:SubtreeSelect
     skos:definition "Partition a vocabulary based on the concepts being in the sub-tree below (using BT/NT) a common parent concept, or not."@en ;
     rdfs:subClassOf amalgame:VirtualVocabPartitioner .
 
+amalgame:UniqLabelVocSelect
+    rdfs:label "partition on unique labels"@en ;
+    skos:definition "Partition a vocabulary based on the concepts being uniquely labeled, or not."@en ;
+    rdfs:subClassOf amalgame:VirtualVocabPartitioner .
+
 ####################
 
 amalgame:EvaluationProcess