:- module(create_name_lexicon,
[load_speech_forms_of_words/1,
create_name_lexicon/2,
create_name_lexicon/3]
).
%======================================================================
:- use_module(library(lists)).
:- use_module(library(system)).
:- use_module('$REGULUS/PrologLib/utilities').
:- use_module('$REGULUS/Prolog/regulus_declarations').
%======================================================================
create_name_lexicon(InFile, OutFile) :-
create_name_lexicon(InFile, OutFile, regulus(english)).
create_name_lexicon(InFile, OutFile, RuleType) :-
absolute_file_name(InFile, AbsInFile),
absolute_file_name(OutFile, AbsOutFile),
prolog_file_to_list(AbsInFile, InList),
length(InList, InN),
format('~N~n--- Read database file (~d records) ~w~n', [InN, AbsInFile]),
findall(Entry,
extract_lexicon_entry_from_list(InList, Entry, RuleType),
Entries),
sort(Entries, OutList),
length(OutList, OutN),
list_to_prolog_file(OutList, AbsOutFile),
format('~N~n--- Written lexicon file (~d records) ~w~n', [OutN, AbsOutFile]),
!.
extract_lexicon_entry_from_list(List, Entry, RuleType) :-
member(Record, List),
extract_lexicon_entry_from_db_record(Record, Entry, RuleType).
extract_lexicon_entry_from_db_record(Record, Entry, RuleType) :-
extract_place_name_entry_from_db_record(Record, Entry, RuleType).
extract_lexicon_entry_from_db_record(Record, Entry, RuleType) :-
extract_person_name_entry_from_db_record(Record, Entry, RuleType).
extract_lexicon_entry_from_db_record(Record, Entry, RuleType) :-
extract_affiliation_entry_from_db_record(Record, Entry, RuleType).
extract_lexicon_entry_from_db_record(Record, Entry, RuleType) :-
extract_phone_number_entry_from_db_record(Record, Entry, RuleType).
extract_lexicon_entry_from_db_record(Record, Entry, RuleType) :-
extract_email_address_entry_from_db_record(Record, Entry, RuleType).
/*
Place names:
person(pierrette_bouillon, pierrette, bouillon, geneva, "+41 22 379 8679", "Pierrette.Bouillon@issco.unige.ch").
location(nikos_room_1, 'Nikos\'s room', switzerland, geneva, geneva_university).
location(saint_margarets_road, 'Saint Margarets Road', england, cambridge, null).
@place_name(geneva, geneva).
@place_name((geneva, university), geneva_university).
*/
extract_place_name_entry_from_db_record(Record, Entry, RuleType) :-
Record = person(_ID, _FirstName, _LastName, Location, _Phone, _Email),
surface_form_from_semantic_value(Location, LocationSurface),
( RuleType = regulus(_Lang) ->
Entry = @place_name(LocationSurface, Location)
;
comma_list_to_list(LocationSurface, LocationSurfaceList),
Entry = ( place_name(Location) --> LocationSurfaceList )
).
extract_place_name_entry_from_db_record(Record, Entry, RuleType) :-
Record = location(_ID, RoomID, Country, City, Organisation),
member(Location, [RoomID, Country, City, Organisation]),
surface_form_from_semantic_value(Location, LocationSurface),
( RuleType = regulus(_Lang) ->
Entry = @place_name(LocationSurface, Location)
;
comma_list_to_list(LocationSurface, LocationSurfaceList),
Entry = ( place_name(Location) --> LocationSurfaceList )
).
/*
Person names:
person(pierrette_bouillon, pierrette, bouillon, geneva, "+41 22 379 8679", "Pierrette.Bouillon@issco.unige.ch").
@person_name((pierrette, bouillon), pierrette_bouillon).
@person_name(pierrette, pierrette).
@person_name(bouillon, bouillon).
*/
% "pierrette" or "bouillon"
extract_person_name_entry_from_db_record(Record, Entry, RuleType) :-
Record = person(_ID, FirstName, LastName, _Location, _Phone, _Email),
member(Name, [FirstName, LastName]),
surface_form_from_semantic_value(Name, NameSurface),
( RuleType = regulus(_Lang) ->
Entry = @person_name(NameSurface, Name)
;
comma_list_to_list(NameSurface, NameSurfaceList),
Entry = ( person_name(Name) --> NameSurfaceList )
).
% "yukie san" or "nakao san"
extract_person_name_entry_from_db_record(Record, Entry, RuleType) :-
RuleType = regulus(japanese),
Record = person(_ID, FirstName, LastName, _Location, _Phone, _Email),
join_with_underscore([FirstName, san], FirstNameSan),
join_with_underscore([LastName, san], LastNameSan),
( [SemName, SynName] = [FirstName, FirstNameSan]
;
[SemName, SynName] = [LastName, LastNameSan]
),
surface_form_from_semantic_value(SynName, NameSurface),
Entry = @person_name(NameSurface, SemName).
% "pierrette bouillon" or "yukie nakao"
extract_person_name_entry_from_db_record(Record, Entry, RuleType) :-
Record = person(ID, FirstName, LastName, _Location, _Phone, _Email),
join_with_underscore([FirstName, LastName], Name),
surface_form_from_semantic_value(Name, NameSurface),
( RuleType = regulus(_Lang) ->
Entry = @person_name(NameSurface, ID)
;
comma_list_to_list(NameSurface, NameSurfaceList),
Entry = ( person_name(Name) --> NameSurfaceList )
).
% "yukie san" or "nakao san"
extract_person_name_entry_from_db_record(Record, Entry, RuleType) :-
RuleType = regulus(japanese),
Record = person(ID, FirstName, LastName, _Location, _Phone, _Email),
join_with_underscore([LastName, FirstName], Name),
surface_form_from_semantic_value(Name, NameSurface),
( RuleType = regulus(_Lang) ->
Entry = @person_name(NameSurface, ID)
;
comma_list_to_list(NameSurface, NameSurfaceList),
Entry = ( person_name(Name) --> NameSurfaceList )
).
% "nakao yukie san"
extract_person_name_entry_from_db_record(Record, Entry, RuleType) :-
RuleType = regulus(japanese),
Record = person(ID, FirstName, LastName, _Location, _Phone, _Email),
join_with_underscore([LastName, FirstName], Name),
join_with_underscore([Name, san], NameSan),
surface_form_from_semantic_value(NameSan, NameSurface),
Entry = @person_name(NameSurface, ID).
% "yukie nakao san"
extract_person_name_entry_from_db_record(Record, Entry, RuleType) :-
RuleType = regulus(japanese),
Record = person(ID, FirstName, LastName, _Location, _Phone, _Email),
join_with_underscore([FirstName, LastName], Name),
join_with_underscore([Name, san], NameSan),
surface_form_from_semantic_value(NameSan, NameSurface),
Entry = @person_name(NameSurface, ID).
extract_affiliation_entry_from_db_record(Record, Entry, prolog) :-
Record = person(_ID, _FirstName, _LastName, Affiliation, _Phone, _Email),
surface_form_from_semantic_value(Affiliation, AffiliationSurface),
comma_list_to_list(AffiliationSurface, AffiliationSurfaceList),
Entry = ( affiliation(Affiliation) --> AffiliationSurfaceList ).
extract_phone_number_entry_from_db_record(Record, Entry, prolog) :-
Record = person(_ID, _FirstName, _LastName, _Affiliation, PhoneString, _Email),
atom_codes(Phone, PhoneString),
surface_form_from_semantic_value(Phone, PhoneSurface),
comma_list_to_list(PhoneSurface, PhoneSurfaceList),
Entry = ( phone_number(Phone) --> PhoneSurfaceList ).
extract_email_address_entry_from_db_record(Record, Entry, prolog) :-
Record = person(_ID, _FirstName, _LastName, _Affiliation, _Phone, EmailString),
atom_codes(Email, EmailString),
surface_form_from_semantic_value(Email, EmailSurface),
comma_list_to_list(EmailSurface, EmailSurfaceList),
Entry = ( email_address(Email) --> EmailSurfaceList ).
:- dynamic speech_form_of_word/2.
load_speech_forms_of_words(File) :-
safe_absolute_file_name(File, AbsFile),
prolog_file_to_list(AbsFile, List),
length(List, N),
format('~N--- Read file (~d entries) ~w~n', [N, AbsFile]),
load_speech_forms_of_words1(List),
!.
load_speech_forms_of_words1([]).
load_speech_forms_of_words1([F | R]) :-
load_speech_forms_of_word(F),
!,
load_speech_forms_of_words1(R).
load_speech_forms_of_word(speech_form_of_word(Text, Speech)) :-
assertz(speech_form_of_word(Text, Speech)),
!.
load_speech_forms_of_word(Other) :-
format('~N*** Warning: bad entry in speech_form_of_word file "~w", item discarded~n', [Other]).
%surface_form_from_semantic_value(SemValue, _Surface) :-
% atom_chars(SemValue, SemValueChars),
% member(0' , SemValueChars),
% !,
% format('~N*** Warning: space char in semantic value "~w", item discarded~n', [SemValue]),
% fail.
surface_form_from_semantic_value(SemValue, Surface) :-
SemValue \== null,
split_atom_into_words(SemValue, 0'_, SemValueComponentsList),
add_speech_forms_of_words(SemValueComponentsList, SemValueComponentsList1),
list_to_comma_list(SemValueComponentsList1, Surface).
add_speech_forms_of_words([], []).
add_speech_forms_of_words([F | R], [F1 | R1]) :-
( speech_form_of_word(F, SpeechF) ->
F1 = @st(SpeechF, F)
;
otherwise ->
F1 = F
),
!,
add_speech_forms_of_words(R, R1).