vumix/commit

start implementation of probabilistic tag ranking

diff --git a/lib/ptr.pl b/lib/ptr.pl
new file mode 100644
index 0000000..7633f16
--- /dev/null
+++ b/lib/ptr.pl
@@ -0,0 +1,80 @@
+:- module(ptr,
+	  [ptr_rank/2,
+	   ptr/3
+	  ]).
+
+:- use_module(library(video_annotation)).
+:- use_module(library(stop_words)).
+:- use_module(library('R')).
+
+/* Probabilistic tag relevance
+
+http://www2009.eprints.org/36/1/p351.pdf
+
+*/
+
+:- dynamic
+	v_tag/2.
+
+ptr_rank(Video, RankedTags) :-
+	findall(T, video_tag(Video, literal(T)), Tags0),
+	sort(Tags0, Tags1),
+	remove_stop_words(Tags1, dutch, Tags),
+	length(Tags, TagCount),
+	debug(ptr, 'tags: ~w', TagCount),
+	ptr_probs(Tags, Video, TagCount, Probs),
+	pairs_keys_values(Probs, Tags, Pairs),
+	keysort(Pairs, Pairs1),
+	reverse(Pairs1, RankedTags).
+
+ptr_probs([], _, _, []).
+ptr_probs([Tag|Tags], Video, N, [Prob|Probs]) :-
+	N1 is N - 1,
+	debug(ptr, '~w ~w', [N, Tag]),
+	ptr(Video, Tag, Prob),
+	debug(ptr, '~f2~n', [Prob]),
+	ptr_probs(Tags, Video, N1, Probs).
+
+ptr(Video, Tag, Probability) :-
+	findall(V, video_tag(V, literal(Tag)), Neighbour_Videos0),
+	sort(Neighbour_Videos0, Neighbour_Videos),
+	length(Neighbour_Videos, V_Count),
+	debug(ptr, 'videos: ~w', [V_Count]),
+	tag_vectors([Video|Neighbour_Videos], [V_Vector|N_Vectors]),
+	kde(N_Vectors, V_Vector, Probability).
+
+
+tag_vectors(Videos, Vectors) :-
+	findall(Tag, (member(V,Videos),
+		      video_tag(V, literal(Tag)),
+		      assert(v_tag(V,Tag))
+		     ),
+		Tags0),
+	sort(Tags0, Tags1),
+	remove_stop_words(Tags1, dutch, Tags),
+	maplist(video_vector(Tags), Videos, Vectors),
+	retractall(v_tag(_,_)).
+
+
+
+
+video_vector([], _, []).
+video_vector([Tag|Tags], Video, [N|Vs]) :-
+	(   v_tag(Video, Tag)
+	->  N = 1
+	;   N = 0
+	),
+	video_vector(Tags, Video, Vs).
+
+kde(Neighbours, X_List, Prob) :-
+	length(X_List, Length),
+	r_open,
+	X =.. [c|X_List],
+	maplist(k(X, Length), Neighbours, Probs),
+	sumlist(Probs, Prob),
+	r_close.
+
+k(X, Length, N_List, Prob) :-
+	N =.. [c|N_List],
+	r_in( Prob <- exp(-(sum(sqrt(abs((X - N))^2))^2)/ (Length/4)^2) ).
+