yaz/commit

simple tag pair evalution

diff --git a/applications/yaz_match_evaluate.pl b/applications/yaz_match_evaluate.pl
new file mode 100644
index 0000000..4e845e9
--- /dev/null
+++ b/applications/yaz_match_evaluate.pl
@@ -0,0 +1,415 @@
+:- module(yaz_meval,
+	  [  ]).
+
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/html_head)).
+:- use_module(library(http/http_json)).
+:- use_module(library(http/js_write)).
+:- use_module(library(http/json)).
+:- use_module(library(http/json_convert)).
+:- use_module(library(http/http_session)).
+:- use_module(user(user_db)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdfs)).
+:- use_module(library(semweb/rdf_label)).
+
+:- use_module(library(yaz_util)).
+:- use_module(library(yui3)).
+:- use_module(library(user_process)).
+:- use_module(library(video_annotation)).
+:- use_module(library(rdf_history)).
+:- use_module(library(tag_match)).
+:- use_module(api(reconcile)).
+
+:- use_module(components(label)).
+:- use_module(components(yaz_page)).
+:- use_module(applications(yaz_game)).
+
+:- http_handler(yaz(meval), http_yaz_meval, []).
+:- http_handler(yaz('data/confirmmatch'), http_yaz_api_confirm_match, []).
+:- http_handler(yaz('data/meval'), http_yaz_api_mgarden_data, []).
+
+:- setting(request_interval, integer, 2000,
+	   'Interval between requests to the server (in miliseconds)').
+
+:- dynamic
+	player_score/3.
+
+:- dynamic
+	exact_match_cache/1,
+	match_cache/2.
+
+
+%%	http_yaz_meval(+Request)
+%
+%	Emit the a video player with a tag carousel running along side
+%	of it.
+
+http_yaz_meval(Request) :-
+	ensure_logged_on(User0),
+	user_property(User0, url(CurrentUser)),
+	http_parameters(Request,
+			[ video(Video,
+				[optional(true),
+				 description('Current video')]),
+			  process(Process,
+			       [desription('When set only annotations within this process are shown')])
+    			]),
+	rdf(Process,opmv:used,Video),
+	Options = [process(Process)
+   		  ],
+	create_user_process(CurrentUser,
+			    [rdf:type=pprime:'meval',
+			     opmv:used=Video
+			    ], _GardenProcess),
+	set_player_score(CurrentUser, Process),
+	video_annotations(Video, As0, Options),
+	sort_by_arg(As0, 2, As),
+	setting(yaz_game:match_interval, Interval),
+ 	tag_matches(As, Process, Interval, Annotations),
+	active_players(Process, Players),
+ 	html_video_page(Process, Video, CurrentUser, Players, Annotations, 0, Options).
+
+
+		 /*******************************
+		 *		matching	*
+		 *******************************/
+
+tag_matches([], _, _, []).
+tag_matches([A0|As], Process, Interval, [A|Rest]) :-
+	rdf_equal(skos:'Concept', Concept),
+	A0 = annotation(Value,Start,End,Entries,Score),
+	A =  annotation(Value,Start,End,Entries,Score,Matches),
+	Time is Start + Interval,
+	Entries = [i(Id,_)],
+	rdf(Id,pprime:creator,User),
+ 	tag_value(Value, Tag),
+	snowball(dutch, Tag, Stem0),
+	downcase_atom(Stem0, Stem),
+	reconcile(Tag, 10, Concept, [], Hits),
+ 	forward_matches(As, Id, Tag, Stem, Hits, User, Time, Matches),
+	Matches = [_|_],
+	!,
+   	tag_matches(As, Process, Interval, Rest).
+tag_matches([_A0|As], Process, Interval, Rest) :-
+	tag_matches(As, Process, Interval, Rest).
+
+
+backward_match(Id, M) :-
+	match_cache(Id, M),
+	retractall(match_cache(Id,M)).
+
+forward_matches([A|As], Id, Tag, Stem, Hits, User, End, Matches) :-
+	A =  annotation(Value1,Time1,_,[i(Id1,_)],_),
+	Time1 =< End,
+	!,
+	(   \+ rdf(Id1, pprime:creator, User),
+	    tag_value(Value1, Tag1),
+	    \+ Tag == Tag1,
+	    match(Stem, Hits, Tag1, Type)
+	->  match_reverse(Type, RType),
+	    assert(match_cache(Id1, match(RType, 0, Id, literal(Tag)))),
+	    Matches = [match(Type, 0, Id1, literal(Tag1))|Ms]
+	;   Matches = Ms
+	),
+	forward_matches(As, Id, Tag, Stem, Hits, User, End, Ms).
+forward_matches(_, _, _, _, _, _, _, []).
+
+
+match(Stem, _, Tag1, stem) :-
+	snowball(dutch, Tag1, Stem1),
+	downcase_atom(Stem1, Stem).
+match(_Stem, Hits, Tag1, Type) :-
+	Hits = [_|_],
+	reconcile(Tag1, 5, Hits1),
+	member(hit(_,C,_,_), Hits),
+	member(hit(_,C1,_,_), Hits1),
+	tag_concept_match(C, C1, Type).
+
+tag_concept_match(R, R, synonym) :- !.
+tag_concept_match(R1, R2, specific) :-
+ 	rdf_reachable(R1, skos:broader, R2),
+	!.
+tag_concept_match(R1, R2, generic) :-
+ 	rdf_reachable(R2, skos:broader, R1),
+	!.
+tag_concept_match(R1, R2, sibling) :-
+ 	rdf_reachable(R1, skos:broader, R, 2, _),
+	rdf_reachable(R2, skos:broader, R, 2, _),
+	!.
+tag_concept_match(R1, R2, related) :-
+ 	(   rdf(R2, skos:related, R1)
+	;   rdf(R1, skos:related, R2)
+	),
+	!.
+
+tag_value(literal(Tag), Tag).
+tag_value(uri(_URI,Tag), Tag).
+
+
+match_reverse(specific, generic).
+match_reverse(generic, specific).
+match_reverse(M, M).
+
+
+
+
+
+
+
+
+
+
+
+
+%%	html_video_page(+Game, +Video, +User, +Annotations, +StartTime,
+%%	+Options)
+%
+%	Emit an HTML page with a video player and a tag carousel.
+
+html_video_page(Game, Video, User, Players, Annotations, StartTime, Options) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - ', Video])
+			],
+			[ \html_requires(css('player.css')),
+  			  div(class('video-results'),
+			      \html_video_page_containers(Video, Options)),
+			 script(type('text/javascript'),
+				\html_video_page_yui(Game, Video, User, Players, Annotations, StartTime, Options))
+			]).
+
+html_video_page_containers(Video, _Options) -->
+	{ display_label(Video, Title)
+  	},
+	html([ h2(Title),
+ 	       div(id(video),
+		   [ div(id(tagplayer), []),
+		     div(id(videoplayer), [])
+		   ]),
+	       div(id(players), [])
+    	     ]).
+
+html_video_page_yui(Game, Video, User, Players, Annotations, StartTime, _Options) -->
+	{ video_source(Video, Src),
+ 	  http_absolute_location(js('videoplayer/'), FilePath, []),
+	  http_absolute_location(js('videoplayer/videoplayer.js'), VideoPlayer, []),
+	  http_absolute_location(js('tagcarousel/tagcarousel.js'), TagCarousel, []),
+	  http_absolute_location(js('game/players.js'), GamePlayers, []),
+	  setting(request_interval, RequestInterval),
+  	  annotation_to_json(Annotations, JSONTags)
+   	},
+	html_requires(js('videoplayer/swfobject.js')),
+ 	js_yui3([{modules:{'game-players':{fullpath:GamePlayers},
+			   'video-player':{fullpath:VideoPlayer},
+			   'tag-carousel':{fullpath:TagCarousel}
+  			  }}
+		],
+		[node,event,widget,anim,
+		 'querystring-stringify-simple','io','json',
+  		 'video-player','tag-carousel','game-players'
+ 		],
+		[ \js_new(videoPlayer,
+			  'Y.mazzle.VideoPlayer'({filepath:FilePath,
+ 						  src:Src,
+						  width:640,
+						  height:480,
+						  autoplay:symbol(false),
+						  controls:symbol(true),
+ 						  start:StartTime
+						 })),
+		  \js_new(tagCarousel,
+			  'Y.mazzle.TagCarousel'({tags:JSONTags,
+						  height:480,
+						  width:200,
+						  confirm:symbol(true),
+						  topIndent:symbol(false)
+ 						 })),
+		  \js_new(gamePlayers,
+			  'Y.mazzle.GamePlayers'({container:'#players',
+						  user:User,
+						  players:Players
+ 						 })),
+    		  'var oldTime;\n',
+ 		  \js_call('videoPlayer.render'('#videoplayer')),
+		  \js_call('tagCarousel.render'('#tagplayer')),
+ 		  \js_yui3_on(tagCarousel, itemSelect, \js_tag_select),
+ 		  \js_yui3_on(tagCarousel, itemConfirm, \js_confirm(Game, User)),
+		  \js_support_functions(Game, User),
+		  \js_call('Y.later'(RequestInterval, symbol('Y'),
+				     symbol(fetchData), symbol({}), symbol(true)))
+   		]).
+
+js_support_functions(Game, User) -->
+	{ http_location_by_id(http_yaz_api_mgarden_data, DataServer)
+	},
+	js_function_decl(fetchData, [e],
+			 \[
+'   var data = {user:"',User,'",
+	        game:"',Game,'"};
+    Y.io("',DataServer,'", {data: data,
+			    on: {success:handleResponse}
+			   });\n'
+			  ]),
+	js_function_decl(handleResponse, [id, o],
+			 \[
+'    var r = Y.JSON.parse(o.responseText);
+     tagCarousel.updateMatch(r.confirm);
+     gamePlayers.set("players", r.players);\n'
+			  ]).
+
+js_tag_select -->
+	js_function([e],
+		    \[
+'    if(e.tag.startTime)
+     { var time = (e.tag.startTime/1000)-2;
+       videoPlayer.setTime(time, true);
+     }\n'
+		    ]).
+
+js_confirm(Game, User) -->
+	{ http_location_by_id(http_yaz_api_confirm_match, ConfirmServer)
+	},
+	js_function([e],
+		    [
+'    var i = e.index,
+	 m = e.matchIndex,
+ 	 data = {source:e.annotation.annotations[0].uri,
+		 target:e.annotation.match[m].uri,
+		 action:e.action,
+		 match:e.annotation.match[m].type,
+		 game:"',Game,'",
+		 user:"',User,'"',
+		'};\n',
+     \js_call('Y.io'(ConfirmServer, {
+				       data:symbol(data),
+				       on:{success:symbol('function(id, o)
+				             {var r = Y.JSON.parse(o.responseText);
+					      tagCarousel.setConfirm(i,m,r.id,e.action)
+					     }')},
+				       context:symbol(tagCarousel)
+				      }))
+		     ]).
+
+
+
+%%	http_yaz_api_confirm_match(+Request)
+%
+%	Handler for GET submission of a tag modification.
+
+http_yaz_api_confirm_match(Request) :-
+ 	http_parameters(Request,
+			[ user(User,
+			       [description('URL of the user')]),
+			  game(Game,
+			       [description('URL of the game')]),
+			  action(Action,
+				 [description('accept or reject')]),
+			  source(Source,
+				   [description('URL of source')]),
+			  target(Target,
+			      [description('URL of the target')]),
+			  match(Match,
+				[description('type of the match')])
+			]),
+ 	debug(game, '~w confirm ~w match between ~w and ~w',
+	      [User, Match, Source, Target]),
+  	rdf_bnode(Id),
+	rdfh_transaction((rdfh_assert(Id, pprime:action, literal(Action)),
+			  rdfh_assert(Id, pprime:match, literal(Match)),
+			  rdfh_assert(Id, pprime:process, Game),
+			  rdfh_assert(Id, pprime:creator, User),
+			  rdfh_assert(Id, pprime:matchSource, Source),
+			  rdfh_assert(Id, pprime:matchTarget, Target))),
+  	reply_json(json([id=Id])).
+
+
+confirmed(specific, Game, Action, Source, Target, Id) :-
+	!,
+	(   confirmed_(specific, Game, Action, Source, Target, Id)
+	;   confirmed_(generic, Game, Action, Target, Source, Id)
+	).
+confirmed(generic, Game, Action, Source, Target, Id) :-
+	!,
+	(   confirmed_(generic, Game, Action, Source, Target, Id)
+	;   confirmed_(specific, Game, Action, Target, Source, Id)
+	).
+confirmed(Match, Game, Action, Source, Target, Id) :-
+ 	(   confirmed_(Match, Game, Action, Source, Target, Id)
+	;   confirmed_(Match, Game, Action, Target, Source, Id)
+	).
+
+confirmed_(Match, Game, Action, Source, Target, Id) :-
+	rdf(Id, pprime:process, Game),
+	rdf(Id, pprime:matchSource, Source),
+	rdf(Id, pprime:action, literal(Action)),
+	rdf(Id, pprime:match, literal(Match)),
+	rdf(Id, pprime:matchTarget, Target).
+
+match_score(stem, 75).
+match_score(synonym, 100).
+match_score(specific, 150).
+match_score(generic, 100).
+match_score(related, 75).
+match_score(sibling, 125).
+
+%%	http_yaz_api_mgarden_data(+Request)
+%
+%	Handler for request of match data.
+
+http_yaz_api_mgarden_data(Request) :-
+	http_parameters(Request,
+			[ user(User,
+			       [description('URL of the user')]),
+			  game(Game,
+			       [description('URL of the game')])
+			]),
+	current_user_process(Process),
+
+	Obj = json([id=Id, score=Score]),
+	findall(Obj, user_confirmed(User, Process, Game, Id, Score), Confirmed),
+ 	rdf_transaction(update_scores(Confirmed, Process, Game, User)),
+
+	PlayerObj = json([player=P, name=N, score=S]),
+	findall(PlayerObj,
+		active_player(Game, P, N, S),
+		Players),
+  	reply_json(json([confirm=Confirmed, players=Players])).
+
+user_confirmed(User, Process, Game, Id, Score) :-
+	rdf(Id, pprime:creator, User, Process),
+	confirmed_(Match, Game, Action, Source, Target, Id),
+	\+ rdf(Id, pprime:score, _),
+	confirmed(Match, Game, Action, Source, Target, Id1),
+	\+ rdf(Id1, pprime:creator, User),
+	match_score(Match, Score).
+
+update_scores([], _, _,_).
+update_scores([json([id=Id, score=Score])|T], Process, Game, User) :-
+	rdf(Id, pprime:matchSource, Source),
+  	update_garden_tag_score(Id, Source, Process, Score),
+	update_player_score(Game, User, Score),
+	update_scores(T, Process, Game, User).
+
+update_garden_tag_score(Confirm, Entry, Process, Score) :-
+	(   rdf(Confirm, pprime:score, literal(CS))
+ 	->  S is CS+Score
+ 	;   rdf(Entry, pprime:score, literal(ES))
+ 	->  S is ES+Score
+ 	;   S = Score
+ 	),
+  	rdf_retractall(Confirm, pprime:score, _),
+  	rdf_assert(Confirm, pprime:score, literal(S), Process).
+
+
+
+		 /*******************************
+		 *	       players		*
+		 *******************************/
+
+set_player_score(User, Game) :-
+	game_player_score(Game, User, _).
+set_player_score(User, Game) :-
+	set_game_player_score(Game, User, 0).