tag_matcher/commit

move the actual tag_match to a library module.

authorMichiel Hildebrand
Sat Jan 22 20:21:57 2011 +0100
committerMichiel Hildebrand
Sat Jan 22 20:21:57 2011 +0100
commitdcf95f079d2aae1562b200b0c7856e993e49edd5
tree2b91eb3bcb44ff479d7c3eccafff91186e0b8f65
parent52c060dfaeacd7d8a3cd4577e26388e53ef7b1f3
Diff style: patch stat
diff --git a/api/tag_matcher.pl b/api/tag_matcher.pl
index 58d84a2..e7c58e0 100644
--- a/api/tag_matcher.pl
+++ b/api/tag_matcher.pl
@@ -1,7 +1,4 @@
-:- module(tag_matcher,
-	  [ tag_match/5,
-	    find_tag_concept/3
-	  ]).
+:- module(tag_matcher, []).
 
 :- use_module(library(http/http_dispatch)).
 :- use_module(library(http/http_parameters)).
@@ -10,13 +7,8 @@
 :- use_module(library(http/http_json)).
 :- use_module(library(http/json)).
 :- use_module(library(http/json_convert)).
-:- use_module(library(semweb/rdf_db)).
-:- use_module(library(semweb/rdfs)).
-:- use_module(library(semweb/rdf_litindex)).
-:- use_module(library(snowball)).
-
+:- use_module(library(tag_match)).
 :- use_module(components(label)).
-:- use_module(library(find_resource)).
 
 /** <module> Tag matcher
 
@@ -29,8 +21,6 @@ This module provides a web service for fuzzy matching of two strings
 :- http_handler(root(tagmatch), http_tag_match_page, []).
 :- http_handler(root(api/tagmatch), http_tag_match_api, []).
 
-:- rdf_register_ns(gtaa, 'http://data.beeldengeluid.nl/gtaa/').
-:- rdf_register_ns(cornetto, 'http://purl.org/vocabularies/cornetto/').
 
 :- rdf_meta
         scheme_type(r,-).
@@ -141,7 +131,6 @@ example_link(e(Name, Tag1, Tag2)) -->
 example(exact, verhagen, verhagen).
 example(stemming, auto, autos).
 example(synonym, auto, wagen).
-example('synonym: word order', 'geert wilders', 'wilders, geert').
 example(specific, labrador, hond).
 example(specific2, 'amsterdam-oost', amsterdam).
 example(generic, paal, amsterdammertje).
@@ -164,88 +153,3 @@ http_tag_match_api(Request) :-
 			 t2=json([tag=Tag2|T2Data]),
 			 match=MatchType
 			])).
-
-%%	tag_match(+Tag1, +Tag2, -Match, -Tag1Data, -Tag2Data)
-%
-%	Succeeds if Tag1 and Tag2 match exactly or there is a relation
-%	between the concepts associcated with the Tags. TagData provides
-%	info about how the matching concepts are found.
-
-tag_match(T, T, exact, TData, _) :-	!,
-	(   find_tag_concept(T, _R, Hit)
-	->  tag_data(Hit, TData)
-	;   TData = []
- 	).
-tag_match(T1, T2, stem, TData, _) :-
-	snowball(dutch, T1, T),
-	snowball(dutch, T2, T),
-	!,
-	(   find_tag_concept(T, _R, Hit)
-	->  tag_data(Hit, TData)
-	;   TData = []
- 	).
-tag_match(T1, T2, Type, T1Data, T2Data) :-
-	find_tag_concept(T1, R1, Hit1),
-	find_tag_concept(T2, R2, Hit2),
-	tag_concept_match(R1, R2, Type),
-	!,
-	tag_data(Hit1, T1Data),
-	tag_data(Hit2, T2Data).
-
-tag_concept_match(R, R, synonym) :- !.
-tag_concept_match(R1, R2, specific) :-
- 	ancestor_of(R1, R2),
-	!.
-tag_concept_match(R1, R2, generic) :-
- 	ancestor_of(R2, R1),
-	!.
-
-
-tag_data(hit(D,R,P,L), Data) :-
-	Data = [uri=R, match=L, matchtype=P, distance=D, type=Type],
-	tag_concept_type(R, Type).
-
-
-%%	find_tag_concept(?String, ?Concept)
-%
-%	String is a label of Concept.
-
-find_tag_concept(Tag, R, Hit) :-
-	rdf_equal(rdfs:label, Label),
-	rdf_equal(skos:prefLabel, PrefLabel),
-	rdf_equal(cornetto:synonym, Syn),
-	LabelList = [Syn-0,
-		     PrefLabel-0,
-		     Label-1
-		    ],
-	Options = [match(stem),
-		   attributes(LabelList),
-		   distance(true)
-		  ],
-	find_resource_by_name(Tag, Hits, Options),
-	member(Hit, Hits),
-	Hit = hit(D,R,_,_),
-	D =< 3.
-
-
-%%	tag_concept_type(+Concept, -Type)
-%
-%	Type is one of predefined tag types of Concept.
-
-tag_concept_type(R, Type) :-
-	rdf(R, skos:inScheme, Scheme),
-	scheme_type(Scheme, Type),
-	!.
-tag_concept_type(_, unknown).
-
-scheme_type(gtaa:'Maker', person) :- !.
-scheme_type(gtaa:'Name', person):- !.
-scheme_type(gtaa:'Person', person) :- !.
-scheme_type(gtaa:'Location', location) :- !.
-
-%%	ancestor_of(+R, +Ancestor)
-%
-%	True if Ancestor is reachable by skos:broader from R.
-
-ancestor_of(R, A) :-
-	rdf_reachable(R, skos:broader, A).
diff --git a/lib/tag_match.pl b/lib/tag_match.pl
new file mode 100644
index 0000000..4ef1e24
--- /dev/null
+++ b/lib/tag_match.pl
@@ -0,0 +1,99 @@
+:- module(tag_match,
+	  [ tag_match/5,	 % +Tag1, +Tag2, -MatchType, -Tag1Data, -Tag2Data
+	    find_tag_concept/3   % +Tag, -Resource, -HitData
+	  ]).
+
+
+:- use_module(library(find_resource)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdfs)).
+:- use_module(library(semweb/rdf_litindex)).
+:- use_module(library(snowball)).
+
+
+%%	tag_match(+Tag1, +Tag2, -Match, -Tag1Data, -Tag2Data)
+%
+%	Succeeds if Tag1 and Tag2 match exactly or there is a relation
+%	between the concepts associcated with the Tags. TagData provides
+%	info about how the matching concepts are found.
+
+tag_match(T, T, exact, TData, _) :-	!,
+	(   find_tag_concept(T, _R, Hit)
+	->  tag_data(Hit, TData)
+	;   TData = []
+ 	).
+tag_match(T1, T2, stem, TData, _) :-
+	snowball(dutch, T1, T),
+	snowball(dutch, T2, T),
+	!,
+	(   find_tag_concept(T, _R, Hit)
+	->  tag_data(Hit, TData)
+	;   TData = []
+ 	).
+tag_match(T1, T2, Type, T1Data, T2Data) :-
+	find_tag_concept(T1, R1, Hit1),
+	find_tag_concept(T2, R2, Hit2),
+	tag_concept_match(R1, R2, Type),
+	!,
+	tag_data(Hit1, T1Data),
+	tag_data(Hit2, T2Data).
+
+tag_concept_match(R, R, synonym) :- !.
+tag_concept_match(R1, R2, specific) :-
+ 	ancestor_of(R1, R2),
+	!.
+tag_concept_match(R1, R2, generic) :-
+ 	ancestor_of(R2, R1),
+	!.
+
+
+tag_data(hit(D,R,P,L), Data) :-
+	Data = [uri=R, match=L, matchtype=P, distance=D, type=Type],
+	tag_concept_type(R, Type).
+
+
+%%	find_tag_concept(?String, ?Concept)
+%
+%	String is a label of Concept.
+
+find_tag_concept(Tag, R, Hit) :-
+	rdf_equal(rdfs:label, Label),
+	rdf_equal(skos:prefLabel, PrefLabel),
+ 	LabelList = [PrefLabel-0,
+		     Label-1
+		    ],
+	Options = [match(stem),
+		   attributes(LabelList),
+		   distance(true)
+		  ],
+	find_resource_by_name(Tag, Hits, Options),
+	member(Hit, Hits),
+	Hit = hit(D,R,_,_),
+	D =< 3.
+
+
+%%	tag_concept_type(+Concept, -Type)
+%
+%	Type is one of predefined tag types of Concept.
+
+tag_concept_type(R, Class) :-
+	rdf(R, rdf:type, Class),
+	\+ rdf_equal(Class, skos:'Concept'),
+	!.
+tag_concept_type(R, Scheme) :-
+	rdf(R, skos:inScheme, Scheme),
+	!.
+tag_concept_type(R, Concept) :-
+	rdf_equal(Concept, skos:'Concept'),
+	rdf(R, rdf:type, Concept),
+	!.
+tag_concept_type(_, unknown).
+
+
+%%	ancestor_of(+R, +Ancestor)
+%
+%	True if Ancestor is reachable by skos:broader from R.
+
+ancestor_of(R, A) :-
+	rdf_reachable(R, skos:broader, A).
+