Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(resolve, Daniel@0: [ agent_uri/3 Daniel@0: ]). Daniel@0: Daniel@0: /** Tools for resolving named entities to URIs Daniel@0: Daniel@0: NEW RESOLUTION RESOLUTION Daniel@0: Start from the facts. Resolve entities in the background Daniel@0: 1. Introduce nodes tagged 'unresolved' Daniel@0: 2. Attach facts to nodes. Daniel@0: 3. Resolve later Daniel@0: Daniel@0: */ Daniel@0: :- use_module(library(memo)). Daniel@0: :- use_module(library(musicbrainz)). Daniel@0: :- use_module(library(sparkle)). Daniel@0: :- use_module(library(listutils)). Daniel@0: :- use_module(library(readutil)). Daniel@0: :- use_module(library(dcg_core)). Daniel@0: Daniel@0: :- persistent_memo composer_uri(+composer:atomic,-uri:atom). Daniel@0: Daniel@0: :- initialization memo_attach(memo(resolve),[]). Daniel@0: Daniel@0: Daniel@0: agent_uri(composer,Name,URI) :- ground(URI), !, browse(composer_uri(Name,URI)). Daniel@0: agent_uri(composer,Name,URI) :- Daniel@0: memo(composer_uri(Name,URI),_-Status), Daniel@0: ( Status=ok -> true Daniel@0: ; Status=fail -> clear_all(composer_uri(Name,_)), fail Daniel@0: ; Status=ex(Ex) -> clear_all(composer_uri(Name,_)), throw(Ex) Daniel@0: ). Daniel@0: Daniel@0: composer_uri(Name,URI) :- Daniel@0: member(Source,[mb,dbp]), Daniel@0: source_composer_uri(Source,Name,URI). Daniel@0: Daniel@0: source_composer_uri(mb,Name,URI) :- Daniel@0: format("Searching Musicbrainz for composer '~w'...\n",[Name]), Daniel@0: mb_lazy_query(artist,search([Name,type:person]),[],Matches), Daniel@0: take_while(score_at_least(98),Matches,TopMatches), Daniel@0: process_matches(TopMatches,Matches,URI). Daniel@0: Daniel@0: source_composer_uri(dbp,SearchName,URI) :- Daniel@0: format("Searching DBPedia for '~w'...\n",[SearchName]), Daniel@0: catch( Daniel@0: ( (dbp ?? rdf(URI,rdf:type,foaf:'Person'), rdf(URI,foaf:name,Name), filter(regex(SearchName,Name))), Daniel@0: format("\nFound '~w'...\n",[URI]), Daniel@0: findall(Class,(dbp ?? rdf(URI,rdf:type,Class)),Classes), Daniel@0: format("\nMember of these classes: ~p\n",[Classes]), Daniel@0: format("\nIs this the right one? [y=yes/n=no/a=abort]",[]), flush_output, Daniel@0: get_key_char(Char), nl, Daniel@0: (Char='a' -> throw(lookup_aborted); Char='y') Daniel@0: ), lookup_aborted, fail). Daniel@0: Daniel@0: process_matches([E],_,URI) :- Daniel@0: mb_facet(E,score(Score)), Daniel@0: format("\nMatch (score=~d):\n\n",[Score]), Daniel@0: forall(mb_facet(E,Facet),writeln(Facet)), nl, Daniel@0: mb_uri(E,URI). Daniel@0: Daniel@0: process_matches([],Matches,URI) :- user_scan(Matches,URI). Daniel@0: process_matches(Top,Matches,URI) :- Daniel@0: length(Top,N), N>1, Daniel@0: format("Found ~d matches: \n",[N]), Daniel@0: nl, seqmap(print_match,Top,0,_), Daniel@0: once((repeat, Daniel@0: format("Enter the number of the correct item, or 0 for none of the above: ",[]), flush_output, Daniel@0: read(K), number(K), Daniel@0: % read_line_to_codes(user_input,Codes), Daniel@0: % number_codes(K,Codes), Daniel@0: between(0,N,K) Daniel@0: )), Daniel@0: ( nth1(K,Top,E) -> mb_uri(E,URI) Daniel@0: ; append(Top,Tail,Matches), Daniel@0: process_matches([],Tail,URI) Daniel@0: ). Daniel@0: Daniel@0: print_match(E,I,J) :- Daniel@0: succ(I,J), Daniel@0: format('~` t~d~2+. ~p\n',[J,E]), Daniel@0: forall(mb_facet(E,Facet),format(" ~p\n",[Facet])), Daniel@0: nl. Daniel@0: Daniel@0: user_scan([E|Es],URI) :- Daniel@0: nl, forall(mb_facet(E,Facet),format(" ~p\n",[Facet])), Daniel@0: format("Is this the right one? [y=yes/n=no/a=abort/t=new search term]",[]), flush_output, Daniel@0: get_key_char(Char), nl, Daniel@0: ( Char=y -> mb_uri(E,URI) Daniel@0: ; Char=n -> user_scan(Es,URI) Daniel@0: ; Char=a -> fail Daniel@0: ; Char=t -> nl, read_line_to_string(user_input,Name), source_composer_uri(mb,Name,URI) Daniel@0: ). Daniel@0: Daniel@0: Daniel@0: score_at_least(Thresh,Element) :- mb_facet(Element,score(S)), S>=Thresh. Daniel@0: Daniel@0: % :- volatile_memo work_uri(+terms:list(ground),-uri:atom). Daniel@0: % work_uri(Terms,URI) :- Daniel@0: % file_work_terms(File,WorkTerms,[]), Daniel@0: % file_composer_terms(File,ComposerTerms,[]), Daniel@0: % mb_search(work,[phrase(WorkTerms),artist:phrase(ComposerTerms)],Score,E), Daniel@0: % sleep(0.05), Daniel@0: % format("Match (score=~d):\n",[Score]), Daniel@0: % forall(mb_facet(E,Facet),writeln(Facet)), Daniel@0: % ( Score>98 Daniel@0: % -> mb_uri(E,URI) Daniel@0: % ; format("Is this the right one? [y/n/a]",[]), flush_output, Daniel@0: % get_key_char(Char), Daniel@0: % (Char='a' -> throw(lookup_aborted(work))), Daniel@0: % Char='y' Daniel@0: % ). Daniel@0: Daniel@0: Daniel@0: get_key_char(Char) :- get_single_char(Code), char_code(Char,Code).