:- module(vumix_p0, []). % semweb :- use_module(library('semweb/rdf_db')). :- use_module(library('semweb/rdfs')). :- use_module(library('semweb/rdf_label')). :- use_module(library(yui3_beta)). % http libraries :- use_module(library('http/http_dispatch')). :- use_module(library('http/http_parameters')). :- use_module(library('http/html_write')). :- use_module(library('http/html_head')). :- use_module(library('http/http_path')). :- use_module(library('http/http_json')). :- use_module(components(label)). :- use_module(library(settings)). :- use_module(user(user_db)). :- use_module(library(instance_search)). :- use_module(library(graph_version)). :- use_module(api(annotation)). :- use_module(library(user_process)). %:- use_module(api(reconcile)). %:- use_module(library(video_annotation)). :- use_module(library(yaz_util)). %:- use_module(library(stop_words)). :- use_module(library(tfidf)). %:- use_module(library(tag_concept)). %:- use_module(library(semrank)). %:- use_module(library(real)). /*************************************************** * http handlers ***************************************************/ :- http_handler(cliopatria(vumix/p0), http_vumix_p0, []). :- http_handler(cliopatria(vumix/p0/session/finish), http_vumix_p0_finish, []). /*************************************************** * settings ***************************************************/ :- setting(login, boolean, true, 'Require login'). :- setting(min_query_length, integer, 3, 'Minimum number of characters that must be entered before a query event will be fired. A value of 0 allows empty queries; a negative value will effectively disable all query events and turn AutoComplete off. '). /*************************************************** * http replies ***************************************************/ http_vumix_p0_finish(Request) :- http_parameters(Request, [ target(Target, [uri, description('URI of the object to be annotated') ]), 'http://semanticweb.cs.vu.nl/prestoprime/personAnnotation'(Persons, [zero_or_more]), 'http://semanticweb.cs.vu.nl/prestoprime/placeAnnotation'(Places, [zero_or_more]), 'http://semanticweb.cs.vu.nl/prestoprime/nameAnnotation'(Names, [zero_or_more]), 'http://semanticweb.cs.vu.nl/prestoprime/subjectAnnotation'(Subjects, [zero_or_more]) ]), ( setting(login, true) -> ensure_logged_on(User) ; logged_on(User, anonymous) ), gv_resource_commit(Target, User, save_annotations(['http://semanticweb.cs.vu.nl/prestoprime/personAnnotation'-Persons, 'http://semanticweb.cs.vu.nl/prestoprime/placeAnnotation'-Places, 'http://semanticweb.cs.vu.nl/prestoprime/nameAnnotation'-Names, 'http://semanticweb.cs.vu.nl/prestoprime/subjectAnnotation'-Subjects ], Target, User, Graph), _Head, Graph), ( current_user_process(Process) -> end_user_process(Process) ; true ), http_redirect(see_other, location_by_id(http_vumix), Request). save_annotations([], _, _, _). save_annotations([Field-Values|Ts], Target, User, Graph) :- rdf_field_annotations(Values, Field, Graph, User, Target), save_annotations(Ts, Target, User, Graph). rdf_field_annotations([], _, _, _, _). rdf_field_annotations([Value|Vs], Field, Graph, User, Target) :- rdf_label(Value, Label), annotation_api:rdf_add_annotation( [graph(Graph), user(User), target(Target), field(Field), body(Value), label(Label) ], _,_), rdf_field_annotations(Vs, Field, Graph, User, Target). %% http_vumix_p0(+Request) % % Generate page to annotate a vumix. http_vumix_p0(Request) :- http_parameters(Request, [ target(Target, [uri, description('URI of the object to be annotated') ]), field(Fields0, [zero_or_more, description('URI of annotation field') ]) ]), ( Fields0 = [] -> Fields = ['http://semanticweb.cs.vu.nl/prestoprime/personAnnotation', 'http://semanticweb.cs.vu.nl/prestoprime/placeAnnotation', %'http://semanticweb.cs.vu.nl/prestoprime/nameAnnotation', 'http://semanticweb.cs.vu.nl/prestoprime/subjectAnnotation'] ; Fields = Fields0 ), ( setting(login, true) -> authorized(write(_,_)), logged_on(User) ; logged_on(User, anonymous) ), user_process(User, Target, _), tfidf_rank(Target, Concepts), %c_semantic_distance_rank(Target, Concepts), html_page(Target, Fields, Concepts). tfidf_rank(Target, Concepts) :- tag_rank(Target, Tags), link_tags_to_concepts(Tags, Concepts0), keysort(Concepts0, Concepts1), group_pairs_by_key(Concepts1, Concepts2), pairs_sort_by_value_sum(Concepts2, Concepts). %% link_tags_to_concepts(+Tags, -Concepts) % % Add candidate concepts. link_tags_to_concepts([], []). link_tags_to_concepts([Score-Tag|As], [Concept-Score|Rest]) :- %Score > 7, rdf_has(Concept,rdfs:label,literal(exact(Tag),_)), %reconcile(Tag, 3, _Type, [], Hits), %member(hit(D,Concept,_,_), Hits), %D < 3, %\+ rdf(Concept,skos:inScheme,gtaa:'OnderwerpenBenG'), % hack, to remove duplication between onderwerpenBenG en onderwerpen %( rdf(Concept,skos:inScheme,gtaa:'OnderwerpenBenG') %-> true %; rdf(Concept,skos:scopeNote,_) %), %hack. Concepts without a scopenote are dubious !, link_tags_to_concepts(As, Rest). link_tags_to_concepts([_|As], Rest) :- link_tags_to_concepts(As, Rest). /* video_annotations(Target, Tags0, [interval(10)]), remove_stop_words(Tags0, dutch, Tags), rdf_equal(skos:'Concept', SKOSConcept), link_tags_to_concepts(Tags, SKOSConcept, Concepts0), keysort(Concepts0, Concepts1), group_pairs_by_key(Concepts1, Concepts), %pairs_sort_by_value_count(Concepts2, Concepts), html_page(Target, Fields, Concepts). */ /* %% link_tags_to_concepts(+Annotations, -Annotations1) % % Add candidate concepts. link_tags_to_concepts([], _, []). link_tags_to_concepts([A0|As], Type, [Concept-Entries|Rest]) :- A0 = annotation(Tag,_Start,_End,Entries,_Score), tag_value(Tag, Value), rdf_has(Concept,rdfs:label,literal(exact(Value),_)), %reconcile(Value, 1, Type, [], [hit(D,Concept,_,_)]), %D < 10, !, link_tags_to_concepts(As, Type, Rest). link_tags_to_concepts([_|As], Type, Rest) :- link_tags_to_concepts(As, Type, Rest). tag_value(literal(L), L). tag_value(uri(_,L), L). hit_concept(hit(_,URI,_,Label), concept(URI,Label,Alt,Desc)) :- ( rdf_has(URI, rdfs:label, Lit), literal_text(Lit, Alt), \+ Alt == Label -> true ; Alt = '' ), ( rdf_has(URI,skos:scopeNote,Txt) -> literal_text(Txt,Desc) ; rdf_has(URI, skos:definition,Txt) -> literal_text(Txt,Desc) ; Desc = '' ). */ user_process(User, Target, Process) :- ( current_user_process(Process), rdf(Process, rdf:type, pprime:'AnnotationP0'), rdf(Process, opmv:used, Target) -> true ; create_user_process(User, [rdf:type=pprime:'AnnotationP0', opmv:used=Target ], Process) ), start_user_process(Process). /*************************************************** * annotation page ***************************************************/ %% html_page(+Target, +Fields) % % HTML page html_page(Target, Fields, Concepts) :- rdf_global_id(_:Id, Target), reply_html_page( [ title(['Annotate -- ', Id]) ], [ \html_requires(yui3('cssgrids/grids-min.css')), \html_requires(css('annotation.css')), \html_requires(css('vumix.css')), div(class('yui3-skin-sam yui-skin-sam'), [ div(id(hd), []), div(id(bd), div([id(layout), class('yui3-g')], [ div([id(fields), class('yui3-u ')], form(action(location_by_id(http_vumix_p0_finish)), [ input([type(hidden), name(target), value(Target)]), div([id('fields-accordion'), class('bd yui3-accordion')], \html_suggestion_fields(Fields, Concepts)), div(class(ft), input([type(submit), value(submit)])) ]) ), div([id(media), class('yui3-u')], [ div(id(title), []), div(id(video), []), div(id(videoFrames), []) ]) ]) ), div(id(ft), []) ]), script(type('text/javascript'), \yui_script(Target, Fields)) ]). % hack for mbh demo mbh_video_source(R, Video) :- rdf_has(R, dc:id, literal(FragmentId)), !, concat_atom(['http://eculture2.cs.vu.nl/pprime/videos/',FragmentId,'.mp4'], Video). mbh_video_source(_R, @null). %% html_annotation_fields(+FieldURIs) % % Write html for annotation fields. html_suggestion_fields([], _) --> !. html_suggestion_fields([URI|T], Concepts) --> html(div(class('annotate-field yui3-module yui3-accordion-item'), \html_annotation_field(URI, Concepts))), html_suggestion_fields(T, Concepts). html_annotation_field(Field, Concepts) --> { rdf_global_id(_:Id, Field), rdf_label(Field, L), literal_text(L, Label), ( rdf(Field, an:scheme, Scheme) -> field_suggestions(Concepts, Scheme, Suggestions) ; Suggestions = [] ) }, html([ div(class('annotate-header yui3-hd yui3-accordion-item-hd'), [ %a([href('#'), class('yui3-accordion-item-trigger')], h3(Label),%), \html_annotation_field_desc(Field) ]), %input([id(Id), type(text)]), div([id(Id+'Suggest'), class('suggest yui3-bd yui3-accordion-item-bd')], ul(\html_suggestions(Suggestions, Field))) ]). field_suggestions([], _, []). field_suggestions([Rank-Concept|Cs], Scheme, [Rank-Concept|Rest]) :- rdf(Concept, skos:inScheme, Scheme), !, field_suggestions(Cs, Scheme, Rest). field_suggestions([_Concept|Cs], Scheme, Rest) :- field_suggestions(Cs, Scheme, Rest). html_suggestions([], _) --> !. html_suggestions([_Rank-Concept|T], Field) --> { rdf_label(Concept, Label) %Score is round(Rank) }, html(li([input([name(Field),type(checkbox),value(Concept)]), Label %' (',Score,')' ])), html_suggestions(T, Field). /* html_suggestions([], _) --> !. html_suggestions([Concept-Entries|T], Field) --> { rdf_label(Concept, Label) }, html(li([input([name(Field),type(checkbox),value(Concept)]), Label, \html_tag_entries(Entries) ])), html_suggestions(T, Field). html_tag_entries([]) --> !. html_tag_entries([Entries|Es]) --> html(ul(\html_entries(Entries))), html_tag_entries(Es). html_entries([]) --> !. html_entries([i(Entry,Time)|Es]) --> { rdf(Entry,rdf:value,literal(V)) }, html(li([V, ' ', Time])), html_entries(Es). */ html_annotation_field_desc(URI) --> { rdf(URI, dc:comment, D), literal_text(D, Desc) }, !, html(div([class('annotate-description')], Desc)). html_annotation_field_desc(_URI) --> !. /******************************* * JavaScript * *******************************/ %% yui_script(+Graph) % % Emit YUI object. yui_script(Target, _Fields) --> { findall(M-C, js_module(M,C), Modules), pairs_keys(Modules, Includes) }, yui3([json([modules(json(Modules))])], ['recordset-base','anim'|Includes], [\js_video(Target), \js_video_frames(Target), \js_title_edit(Target), %\js_annotation_fields(Fields, Target), /*\yui3_plug(one(id('fields-accordion')), 'Y.Plugin.NodeAccordion', { anim:symbol(true), effect:'Y.Easing.backIn' }),*/ 'videoFrames.on("frameSelect", function(e) {videoPlayer.setTime(e.time, true)});' ]). js_module('videoplayer', json([fullpath(Path), requires([node,event,widget]) ])) :- http_absolute_location(js('vuplayer/videoplayer.js'), Path, []). js_module('videoframes', json([fullpath(Path), requires([node,event,widget]) ])) :- http_absolute_location(js('videoframes.js'), Path, []). js_module('textedit', json([fullpath(Path), requires([node,event,io,plugin,'querystring-stringify-simple']) ])) :- http_absolute_location(js('textedit.js'), Path, []). js_module('annotation', json([fullpath(Path), requires(['recordset-base', autocomplete, 'autocomplete-highlighters', overlay, 'io','json', 'querystring-stringify-simple' ]) ])) :- http_absolute_location(js('annotation.js'), Path, []). js_video_frames(Target) --> { http_location_by_id(serve_video_frame, FrameServer), mbh_video_source(Target, Src) }, yui3_new(videoFrames, 'Y.VideoFrames', {frameServer:FrameServer, video:Src, duration:343000, interval:5000, width:730 }), yui3_render(videoFrames, one(id(videoFrames))). js_title_edit(Target) --> { http_location_by_id(http_update_annotation, Update), rdf_equal(dcterms:title, Field), ( annotation_api:annotation_in_field(Target, Field, Annotation, _Body, Text, _C, _U) -> true ; Annotation = @null, Text = @null ) }, yui3_plug(one(id(title)), 'Y.Plugin.TextEdit', {target:Target, field:Field, annotation:Annotation, text:Text, store:{update:Update} }). js_video(Target) --> { http_absolute_location(js('vuplayer/'), FilePath, []), video_source(Target, Src) }, yui3_new(videoPlayer, 'Y.VideoPlayer', {filepath:FilePath, playerType:npo, src:Src, width:700, height:400, autoplay:symbol(false), controls:symbol(true) }), yui3_render(videoPlayer, one(id(video))). %% js_annotation_fields(+FieldURIs, +AnnotationTarget) % % Write JavaScript to init annotation fields js_annotation_fields([], _) --> !. js_annotation_fields([URI|T], Target) --> js_annotation_field(URI, Target), js_annotation_fields(T, Target). js_annotation_field(FieldURI, Target) --> { http_location_by_id(http_add_annotation, Add), http_location_by_id(http_remove_annotation, Remove), rdf_global_id(_:Id, FieldURI), setting(min_query_length, MinQueryLength), rdf(FieldURI, an:source, literal(Source)), annotation_api:json_annotation_list(Target, FieldURI, Tags) }, yui3_plug(one(id(Id)), 'Y.Plugin.Annotation', {target:Target, field:FieldURI, source:Source, store:{add:Add, remove:Remove }, tags:Tags, minQueryLength:MinQueryLength, resultListLocator: results, resultTextLocator: label, resultHighlighter: phraseMatch}). :- http_handler(cliopatria(vumix/overview), http_vumix_overview, []). :- rdf_meta gtaa_concepts(+, r, -), user_annotation(r,r,r,-), user_annotations(r,r,r,-), gtaa_concept_with_tag(r,r,-). key_score(R, 1-R). %% http_vumix_overview(+Request) % % http_vumix_overview(Request) :- http_parameters(Request, [ target(Target, [uri, description('URI of the object to be annotated') ]) ]), % video properties rdf_display_label(Target, Title), tag_rank(Target, Tags0), remove_stop_words(Tags0, dutch, FilteredTags), tags_with_gtaa_concepts(FilteredTags, TagsWithConcept), gtaa_concepts(FilteredTags, gtaa:'GTAA', Concepts), %gtaa_concepts(FilteredTags, gtaa:'OnderwerpenBenG', Onderwerpen), Goal = tag_concept(stem(0.9)), %Goal = tag_concept(exact), derived_concepts(FilteredTags, Goal, gtaa:'OnderwerpenBenG', Onderwerpen0), maplist(key_score, Onderwerpen0, Onderwerpen), gtaa_classifications(Onderwerpen, Classes0), sort(Classes0, Classes1), group_pairs_by_key(Classes1, Classes), video_concepts(Target, gtaa:'GTAA', Controlled0), maplist(key_score, Controlled0, Controlled), gtaa_classifications(Controlled, C_Classes0), sort(C_Classes0, C_Classes1), group_pairs_by_key(C_Classes1, C_Classes), length(Controlled, ControlledCount), length(Tags0, TagCount), length(FilteredTags, TagFilteredCount), length(TagsWithConcept, TagWithConceptCount), length(Concepts, ConceptCount), length(Onderwerpen, OnderwerpenCount), length(Classes, ClassCount), reply_html_page( [ title(['Concepts -- ', Target]) ], [ div(class('yui3-skin-sam yui-skin-sam'), [ div(id(hd), [ h3(Title), a(href(Target), Target) ]), div(id(bd), [ div(id(controlled), [ h4(['GTAA controlled concepts (',ControlledCount,')']), ul(\html_classes(C_Classes)) ]), div(id(tags), [ h4(['Tags (',TagCount,')']), \html_tags(Tags0) ]), div(id(filteredtags), [ h4(['Tags without stopwords (',TagFilteredCount,')']) ]), div(id(tagwithconcept), [ h4(['Tags with a GTAA concept (',TagWithConceptCount,')']) ]), div(id(concepts), [ h4(['GTAA concepts (',ConceptCount,')']) ]), div(id(onderwerpen), [ h4(['GTAA onderwerpen (',OnderwerpenCount,')']), ul(\html_concepts(Onderwerpen)) ]), div(id(classifications), [ h4(['GTAA classifications (',ClassCount,')']), ul(\html_classes(Classes)) ]) ]) ]) ]). html_tags([]) --> !. html_tags([Score0-Tag|T]) --> { Score is round(Score0) }, html(li([Tag, ' (',Score,')' ])), html_tags(T). html_concepts([]) --> !. html_concepts([C|T]) --> { c(C, Concept, Score0), rdf_display_label(Concept, Label), Score is round(Score0) }, html(li([Label, ' (',Score,')', div(Concept)])), html_concepts(T). c(Score-Concept, Concept, Score) :- !. c(Concept, Concept, 1). html_classes([]) --> !. html_classes([Class-Concepts|T]) --> { rdf_display_label(Class, Label), length(Concepts, Count) }, html(li([Label, ' (',Count,')', %div(Class), ul(\html_concepts(Concepts)) ])), html_classes(T). html_scores([]) --> !. html_scores([Score0|T]) --> { Score is round(Score0) }, html([Score, ' ']), html_scores(T). tags_with_gtaa_concepts([], []). tags_with_gtaa_concepts([Score-Tag|As], [Score-Tag|Rest]) :- rdf_has(Concept,rdfs:label,literal(exact(Tag),_)), rdf(Concept,skos:inScheme,gtaa:'GTAA'), !, tags_with_gtaa_concepts(As, Rest). tags_with_gtaa_concepts([_|As], Rest) :- tags_with_gtaa_concepts(As, Rest). gtaa_concepts(Tags, Scheme, Concepts) :- gtaa_concepts_(Tags, Scheme, Concepts0), keysort(Concepts0, Concepts1), reverse(Concepts1, Concepts). %group_pairs_by_key(Concepts1, Concepts). gtaa_concepts_([], _, []). gtaa_concepts_([Score-Tag|As], Scheme, [Score-Concept|Rest]) :- tag_concept(stem(0.8), Tag, Concept), %snowball(dutch, Tag, Stem), %rdf_has(Concept,rdfs:label,literal(prefix(Stem),L)), %literal_text(L,Lit), %atom_length(Lit,LN), %atom_length(Tag,TN), %Diff is abs(LN-TN), %Diff < 5, rdf(Concept,skos:inScheme, Scheme), !, gtaa_concepts_(As, Scheme, Rest). gtaa_concepts_([_|As], Scheme, Rest) :- gtaa_concepts_(As, Scheme, Rest). gtaa_classifications(Concepts, Classes) :- findall(Class-(Score-C), ( member(Score-C,Concepts), gtaa_class(C, Class) ), Classes). gtaa_class(C, Class) :- rdf_reachable(C, skos:broader, Class), rdf(Class, skos:inScheme, gtaa:'Classification'), \+ rdf(Class,skos:broader,_). extend_classification :- Classes = [class(gtaa:'24825','01L'), class(gtaa:'24831','02M'), class(gtaa:'24838','03B'), class(gtaa:'24846','04R'), class(gtaa:'24851','05E'), class(gtaa:'24858','06G'), class(gtaa:'24863','07O'), class(gtaa:'24868','08W'), class(gtaa:'24872','09T'), class(gtaa:'24880','10V'), class(gtaa:'24885','11C'), class(gtaa:'24891','12K'), class(gtaa:'24897','13S'), class(gtaa:'24901','14N'), class(gtaa:'24908','15A') ], rdf_global_term(Classes, Classes1), rdf_transaction(extend_classification(Classes1)). extend_classification([]). extend_classification([class(Class,Label)|Cs]) :- ( rdf(C, skos:prefLabel, literal(prefix(Label),_)), C \== Class, ( rdf(C,skos:broader,Class) -> true ; rdf_assert(C,skos:broader,Class, gtaa_classification) ), fail ; true ), extend_classification(Cs). user_table(Target, User) :- user_annotations(Target, User, gtaa:'Persoonsnamen', Personen), user_annotations(Target, User, gtaa:'GeografischeNamen', Places), user_annotations(Target, User, gtaa:'OnderwerpenBenG', Onderwerpen), concepts_with_tag(Personen, Target, PTags), concepts_with_tag(Places, Target, PlaceTags), concepts_with_tag(Onderwerpen, Target, OTags), length(Personen, PN), length(Places, PlaceN), length(Onderwerpen, ON), length(PTags, PTN), length(PlaceTags, PlaceTN), length(OTags, OTN), format('person ~w ~w~nplace ~w ~w~nsubject ~w ~w~n', [PN,PTN,PlaceN,PlaceTN,ON,OTN]), format_concepts(Onderwerpen, OTags). format_concepts([], _). format_concepts([C-L|Cs], Tags) :- ( member(C-Tag, Tags) -> format('~w :: ~w~n',[L,Tag]) ; format('~w~n',[L]) ), format_concepts(Cs, Tags). user_annotations(Target, User, Scheme, As) :- findall(C, user_annotation(Target, User, Scheme, C), As). user_annotation(Target, User, Scheme, C-L) :- rdf(A,oac:hasTarget,Target), rdf(A,oac:hasBody,C), rdf(C,skos:inScheme,Scheme), rdf(A,dcterms:creator,User), rdf_display_label(C,L). concepts_with_tag([], _, []). concepts_with_tag([C-_|Cs], Target, [C-Tag|Rest]) :- gtaa_concept_with_tag(Target, C, Tag), !, concepts_with_tag(Cs, Target, Rest). concepts_with_tag([_C|Cs], Target, Rest) :- concepts_with_tag(Cs, Target, Rest). gtaa_concept_with_tag(Target, C0, Tag) :- rel_concept(C0, C), rdf_has(C, rdfs:label, Lit), literal_text(Lit, Txt), snowball(dutch, Txt, Stem), rdf(Target, pprime:hasAnnotation, E), tag_match(E, Txt, Stem, Tag). tag_match(E, Txt, _, Tag) :- rdf(E, rdf:value, literal(exact(Txt),Tag)), !. tag_match(E, _, Stem, Tag) :- rdf(E, rdf:value, literal(exact(Stem), Tag)). rel_concept(C1,C2) :- rdf_reachable(C1,skos:related,C2,2,_). rel_concept(C1,C2) :- rdf_reachable(C1,skos:broader,C2). rel_concept(C,C).