% Earley-Parser
% Simon Clematide "Programmiertechniken in der Computerlinguistik II" Sommer 2005
% Unterlagen dazu im Skript


% ======================================================
% earley.pl
%
% Chart Parser mit Earley-Algorithmus
% Version ohne Debugging-Information
%
% ACHTUNG
% -------
% Dieses Programm ist nicht vollstaendig:
% - Tilgungsregeln funktionieren nicht
% - Kantensubsumption wird nicht gemacht
%
% Beispielanfrage:
% ?- parse(s, [the,cat,sings]).
%
% Programmkode orientiert sich grob an [Covington, 1994]
% ======================================================

% ------------------------------------------------------------
% Syntaxregeln
% ------------------------------------------------------------

% rule(s,  [np, vp]).             % S --> NP VP
% rule(np, [np, conj, np]).		% NP --> NP Conj NP
% rule(np, [det, n]).             % NP --> Det N
% rule(vp, [v]).                  % VP --> V
% rule(vp, [v, np]).              % VP --> V NP


% ------------------------------------------------------------
% Lexikon
% ------------------------------------------------------------

% word(det,     the).
% word(det,     a).
% word(n,       dog).
% word(n,       cat).
% word(v,       sings).
% word(v,       chases).
% word(v,       sees).
% word(conj,    and).
% word(conj,    or).


% Kantenrepraesentation
% -----------------------
% Aktive und Passive Kanten werden als Prolog-Fakten assertiert.
% facts edge/5. They have the following form:
%
% edge(From, To, Category, Found, ToFind)
% From:      Startposition der Kante
% To:        Endposition der Kante
% Category:  Syntaktische Kategorie der Kante
% Found:     Liste der erkannten Kategorien (d.i. Teil vor dem Punkt),
%            in umgekehrter Reihenfolge
% ToFind:    Liste der Kategorien, die noch erkannt werden muessen
%            damit die Hauptkategorie erkannt ist (d.i. Teil nach dem 
%            Punkt)
%
% Beipiele (= Kanten fuer "the cat sings" nach Parse-Vorgang)
% -----------------------------------------------
% edge(1, 1, s,   [], [np, vp]).       % <1,1> S --> . NP VP
% edge(1, 1, np,  [], [np, conj, np]). % <1,1> NP --> . NP Conj NP
% edge(1, 1, np,  [], [det, n]).       % <1,1> NP --> . Det N
% edge(1, 2, det, [the], []).          % <1,2> Det --> the .
% edge(1, 2, np,  [det], [n]).         % <1,2> NP --> Det . N
% edge(2, 3, n,   [cat], []).          % <2,3> N --> cat .
% edge(1, 3, np,  [n, det], []).       % <1,3> NP --> Det N .
% edge(1, 3, np,  [np], [conj, np]).   % <1,3> NP --> NP . Conj NP
% edge(1, 3, s,   [np], [vp]).         % <1,3> S --> NP . VP
% edge(3, 3, vp,  [], [v]).            % <3,3> VP --> . V
% edge(3, 3, vp,  [], [v, np]).        % <3,3> VP --> . V NP
% edge(3, 4, v,   [sings], []).        % <3,4> V --> sings .
% edge(3, 4, vp,  [v], [np]).          % <3,4> VP --> V . NP
% edge(3, 4, vp,  [v], []).            % <3,4> VP --> V .
% edge(1, 4, s,   [vp, np], []).       % <1,4> S --> NP VP .

:- dynamic edge/5.

% parse(+Term, +Liste)
parse(C, S) :-
	retractall(edge(_,_,_,_,_)),
	init(C),
	process(S, 1, LastPos),
	edge(1, LastPos, C, _, []).

% init(+Category)
% Initialisiert die Chart mit dem gesuchten Grammatiksymbol.
init(C) :-
	foreach(
		rule(C, RHS),
		store(edge(1,1,C,[],RHS))
	).
	
% process(+Liste, +From, ?Last)
% Verarbeitet die Eingabekette ab Position From und instantiiert Last
% mit der letzten Endposition der Eingabekette.
process([], LastPos, LastPos).
process([Word|Words], Pos, LastPos) :-
	predictor(Pos),
	scanner(Word, Pos, NextPos),
	completer(NextPos),
	process(Words, NextPos, LastPos). 


% ------------------------------------------------------------
% predictor(+Position)
% ------------------------------------------------------------
% Fuer jede aktive Konstituente, die nach Position kommt, sage
% mit predict/2 neue aktive Kanten fuer die aktive Konstituente
% voraus.
%
% Beispiel:
% =========
% Angenommen <1,3> s --> np . vp ist in der Chart, und
% predictor(3) ist aufgerufen. Das fuehrt zum Aufruf predict(vp, 3),
% was wiederum die Kanten <3,3> vp --> . v und <3,3> vp --> . v np
% in die Chart einfuegt.

predictor(To) :-
	foreach(
		edge(_, To, _, _, [Active|_]),
		predict(Active, To)
	).


% ------------------------------------------------------------
% predict(+Nonterminal, +Position)
% ------------------------------------------------------------
% Hilfspraedikat fuer predictor/1.
% Beispiel:
% =========
% Folgende Grammatikregeln angenommen: 
%     rule(s,[np,vp]). rule(np,[det,n]).
% Beim Aufruf predict(s, 1) werden die folgenden Kanten assertiert:
% <1,1> s  --> . np vp
% <1,1> np --> . det n

predict(C, Pos) :-
	rule(C, [Active2|Rest]),
	store(edge(Pos,Pos,C,[],[Active2|Rest])),
	predict(Active2, Pos),
	fail.
predict(_, _).


% ------------------------------------------------------------
% scanner(+Word, +Position, -NextPosition)
% ------------------------------------------------------------
% Schlaegt ein Wort im Lexikon nach. Fuer jede Lesart wird die
% entsprechende Kategorie als passive Kante assertiert.

scanner(Word, From, To) :-
	To is From + 1,
	foreach(
		word(Cat, Word),
		store(edge(From,To,Cat,[Word],[]))
	).


% ------------------------------------------------------------
% completer(+Position)
% ------------------------------------------------------------
% Fuer jede passive Kante, die in Position endet, werden alle 
% moeglichen uebergeordneten Konstituenten vervollstaendigt.

completer(K) :-
	foreach(
		edge(J, K, Passive, _, []),
		complete(J, K, Passive)
	).


% ------------------------------------------------------------
% complete(+InactiveStart, +InactiveEnd, +InactiveCategory)
% ------------------------------------------------------------
% Anwendung der Fundamentalregel des Aktive-Chart-Parsing. 
% Seien A und B Nicht-Terminale und alpha, beta, gamma beliebige
% Folgen von Grammatik-Symbolen (auch leere):
%
% Falls die aktive Kante <i,j> A --> alpha . B gamma
% und die passive Kante <j,k> B --> beta . in der Chart sind,
% dann fuege die neue Kante <i,k> A --> alpha B . gamma ein.
% Falls die neue Kante passiv ist, wende die Fundamentalregel
% noch auf sie selbst an.

complete(J, K, B) :-
	edge(I, J, A, Aphla, [B|Gamma]),
	store(edge(I,K,A,[B|Aphla],Gamma)),
	Gamma == [],
	complete(I, K, A),
	fail.
complete(_, _, _).


% ------------------------------------------------------------
% store(+Edge)
% ------------------------------------------------------------
% Kanten werden eingefuegt, falls keine aehnliche Kante sich 
% schon in der Chart befindet. Praeziser muss man sagen:
% Eine Kante wird eingefuegt, falls sie nicht von einer Kante
% in der Chart subsumiert wird.
% Diese Implementation, die statt Subsumption Prolog-Unifikation
% verwendet, kann bei komplexen Grammatiksymbolen zu Problemen
% fuehren.
store(Edge) :-
	\+ call(Edge),
	asserta(Edge).


% ------------------------------------------------------------
% foreach(+GoalA, +GoalB)
% ------------------------------------------------------------
% A wird so oft ausgefuehrt, wie B gelingt.

foreach(B, A) :-
	call(B),
	once(A),
	fail.
foreach(_, _).


% ------------------------------------------------------------
% once(+Goal)
% ------------------------------------------------------------
% Laesst Ziel hoechstens einmal gelingen.
% In neueren SICStus Prologs schon eingebaut. (Kann 
% einkommentiert werden.)
/*once(Goal) :-
	call(Goal),
	!.
*/