vumix/commit
start implementation of probabilistic tag ranking
author | Michiel Hildebrand |
---|---|
Thu May 24 10:58:39 2012 +0200 | |
committer | Michiel Hildebrand |
Thu May 24 10:58:39 2012 +0200 | |
commit | fa14b5fc70c6f345a85cc10c60cff36f43d8f79e |
tree | ecacd446122d645bb51fcddafab5a0a1b9730a3a |
parent | 8eac0c86b2e2c12d8d3588c19f3097ba06867cbc |
Diff style: patch stat
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) ). +