:- module(reconcile, [reconcile/3, % +Query, +Max, -Hits reconcile/5, % +Query, +Max, +Type, +Properties, -Hits flush_reconcile_cache/0 ]). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_parameters)). :- use_module(library(http/http_path)). :- use_module(library(http/http_json)). :- 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(find_resource)). :- use_module(library(yaz_util)). /** Reconciliation: Linking tags to concepts from vocabularies @author Michiel Hildebrand */ :- http_handler(api(reconcile), http_reconcile, []). :- http_handler(yaz(savereconcile), http_save_reconcile, []). :- dynamic reconcile_cache/2. flush_reconcile_cache :- retractall(reconcile_cache(_,_)). %% http_reconcile(+Request) % % Handler to find reconciliations. % Based on % http://code.google.com/p/google-refine/wiki/ReconciliationService % API % % Returns a json object. http_reconcile(Request) :- http_parameters(Request, [ query(Query, [json, optional(true), description('a string to search for') ]), queries(Queries, [json, optional(true), description('a json object of the form {q1:{query:STRING}, ...}')]), limit(Limit, [number, default(3), description('max number of results')]), type(Type, [default([]), description('filter by type')]), properties(Properties, [default([]), description('other filters')]), callback(Callback, [optional(true), description('callback function for JSONP results') ]) ]), ( nonvar(Queries), Queries = json(QueryList) -> reconcile_list(QueryList, Limit, Type, Properties, Results), reply(Callback, json(Results)) ; atom(Query) -> reconcile(Query, Limit, Type, Properties, Hits), hits_to_json_results(Hits, Results), reply(Callback, json([result=Results])) ; Query = json(Options), option(query(Q), Options), option(limit(L), Options, Limit), option(type(T), Options, Type), option(properties(Ps), Options, Properties) -> reconcile(Q, L, T, Ps, Hits), hits_to_json_results(Hits, Results), reply(Callback, json([result=Results])) ; reply(Callback, json([])) ). reply(Callback, JSON) :- ( var(Callback) -> reply_json(JSON) ; format('Content-type: application/jsonp~n~n'), format('~w (', Callback), json_write(current_output, JSON), format(')') ). %% reconcile_list(+QueryPairs:key-query, +Limit, +Type, %% +Properties, -Results:JSON) % % Results is a list of pairs with for every key in QueryPairs a % list of hits matching query. reconcile_list([], _, _, _, []). reconcile_list([Key=json(Obj)|Ts], Max, Type, Properties, [Key=json([result=Results])|Rs]) :- memberchk(query=Query, Obj), reconcile(Query, Max, Type, Properties, Hits), hits_to_json_results(Hits, Results), reconcile_list(Ts, Max, Type, Properties, Rs). %% reconcile(+Query, +MaxResults, +Type, +Properties, %% -Concept:hit(score,uri,property,label)) % % Reconcile a QueryString to a set of candidate concepts reconcile(Query, Max, Hits) :- reconcile(Query, Max, _, [], Hits). reconcile(Query, Max, Type, Properties, Hits) :- reconcile_cache(Query, Hits0), !, reconcile_filter(Hits0, Max, Type, Properties, Hits). reconcile(Query, Max, Type, Properties, Hits) :- label_list(LabelList), find_resource_by_name(Query, Hits0, [attributes(LabelList),match(case),distance(true)]), assert(reconcile_cache(Query, Hits0)), reconcile_filter(Hits0, Max, Type, Properties, Hits). reconcile_filter(Hits, Max, Type, Properties, Filtered) :- ( ( Type = [] ; var(Type) ), ( Properties = [] ; var(Properties) ) -> list_limit(Hits, Max, Filtered, _) ; filter_hits(Hits, Max, Type, Properties, Filtered) ). label_list(LabelList) :- rdf_equal(rdfs:label, Label), rdf_equal(skos:prefLabel, PrefLabel), rdf_equal(cornetto:synonym, Syn), LabelList = [PrefLabel-0, Syn-0, Label-1 ]. %% filter_hits(+Hits, +Limit, +Types, +Properties, -Filtered) % % Limit Hits to Limit number that succeed for the Types and % Properties filters. filter_hits(_, 0, _, _, []) :- !. filter_hits([], _, _, _, []) :- !. filter_hits([H|T], N, Type, Properties, Results) :- H = hit(_,R,_,_), ( type_filter(Type, R), property_filter(Properties, R) -> Results = [H|Rest], N1 is N - 1 ; Results = Rest, N1 = N ), filter_hits(T, N1, Type, Properties, Rest). type_filter([], _) :- !. type_filter(Class, R) :- atom(Class), !, rdfs_individual_of(R, Class). type_filter(Types, R) :- type_filter_(Types, R). type_filter_([Type|Ts], R) :- ( rdfs_individual_of(R, Type) -> true ; type_filter_(Ts, R) ). property_filter([], _). property_filter([json([P=V])|Ps], R) :- rdf_has(R, P, V), property_filter(Ps, R). %% hits_to_json_results(+Hits:hit(score,uri,property,label), %% -JSON). % % Create a JSON object of a hit term and add a list of types for % URI. hits_to_json_results([], []). hits_to_json_results([Hit|Hs], [Result|Rs]) :- Hit = hit(Distance,URI,_Property,Label), type_list(URI, Types), skos_desc(URI, Desc), Result = json([id=URI, name=Label, type=Types, desc=Desc, score=Distance, match=false % we're not certain ]), hits_to_json_results(Hs, Rs). type_list(URI, Types) :- findall(T, concept_type(URI,T), Ts0), sort(Ts0, Ts), resource_json_object(Ts, Types). concept_type(URI, Type) :- rdf(URI, skos:inScheme, 'http://purl.org/vocabularies/cornetto'), rdf(URI, cornetto:hasHyperonym, Type), !. concept_type(URI, Scheme) :- rdf(URI, skos:inScheme, gtaa:'GTAA'), !, rdf(URI, skos:inScheme, Scheme), \+ rdf_equal(Scheme, gtaa:'GTAA'). concept_type(URI, Type) :- rdf(URI, rdf:type, Type). skos_desc(URI, Desc) :- ( rdf_has(URI, skos:scopeNote, Desc0) -> literal_text(Desc0, Desc) ; rdf_has(URI, rdfs:comment, Desc0) -> literal_text(Desc0, Desc) ; Desc = '' ). resource_json_object([], []). resource_json_object([R|Rs], [JSONObj|Os]) :- JSONObj = json([id(R), name(Label)]), display_label(R, Label), resource_json_object(Rs, Os). %% http_save_reconcile(+Request) % % Handler for reconsiliation of tags by URIs. % Returns a json reply when all parameters are valid. http_save_reconcile(Request) :- http_in_session(SessionID), logged_on(User, SessionID), http_parameters(Request, [ entry(TagEntry, [description('URI of tagentry event')]), uri(URI, [description('URI of resource tag is reconciled with')]) ]), valid_reconcile(TagEntry, URI, User, Tag, Error), ( nonvar(Error) -> json_reply_error(Error) ; reconcile_event_uri(TagEntry, ReconcileEvent), assert_recon(ReconcileEvent, TagEntry, URI, User), json_reply_recon(ReconcileEvent, Tag, URI, User) ). valid_reconcile(TagEntry, _URI, _User, Tag, Error) :- ( \+ rdf(TagEntry, rdf:type, pprime:'TagEntry') -> concat_atom(['entry ', TagEntry, ' does not exist'], Error) ; rdf(TagEntry, sem:involves, TagTerm), display_label(TagTerm, Tag) ). assert_recon(ReconcileEvent, TagEntry, URI, User) :- rdf_assert(ReconcileEvent, rdf:type, pprime:'ReconcileEvent', recon), rdf_assert(ReconcileEvent, pprime:reconciles, TagEntry, recon), rdf_assert(ReconcileEvent, pprime:reconcilesWith, URI, recon), rdf_assert(ReconcileEvent, sem:hasActor, User, recon). reconcile_event_uri(TagEntry, ReconcileEventURI) :- % base URI on number of existing reconciliation for TagEntry findall(E, rdf(E, pprime:reconciles, TagEntry), Es), length(Es, Count), concat_atom([TagEntry, 'Reconcile', Count], ReconcileEventURI). json_reply_recon(Entry, Tag, URI, User) :- reply_json(json([success='reconciliation saved', entry=Entry, user=User, tag=Tag, uri=URI ])). json_reply_error(Error) :- reply_json(json([error=Error])). :- use_module(library(http/http_client)). freebase_reconcile(Tags, ReconciledTags) :- freebase_url(URL), freebase_query(Tags, Query), freebase_option_string(Options), www_form_encode(Query, EncQuery), concat_atom([URL, '?queries=', EncQuery, Options], Request), http_get(Request, Reply, []), json_to_prolog(Reply, Results), ReconciledTags = Results. freebase_url('http://api.freebase.com/api/service/search'). freebase_option_string('&limit=3'). freebase_query(Tags, Query) :- freebase_json_query(Tags, JSON), with_output_to(string(Query), json_write(current_output, json(JSON), [])). freebase_json_query([], []). freebase_json_query([Tag|T], [Tag=json([query=Tag])|Rest]) :- freebase_json_query(T, Rest).