(Message 7)
From:     HELEN    HPS (on ERCC DEC-10) <Pain@EDXA>
Date:     Wednesday, 16-Jan-85 14:07:26-GMT
To:       ecmi08@2972,Pain@EDXA
Via:      uk.ac.edinburgh.edxa  ; (to uk.ac.edinburgh.emas) 16 Jan 85  14:14:30 gmt
Msg ID:   <132001-455-241@EDXA>

--------
/* 	GENERAL-PURPOSE ACTIVE CHART PARSER		*/

/*  Independent of grammatical formalism used, although the formalism */
/*  will have to have some general resemblance to a phrase-structure */
/*  grammar for a chart to work at all. The phrase-structure grammar */
/*  terms "rule", "LHS", "RHS" have been used here for simplicity,  */
/*  but they should be interpreted fairly abstractly.			*/

/*  All the external interfaces are in terms of 3 data-types:		*/
/*		surface words						*/
/*		syntactic categories					*/
/*		edge-labels						*/
/*		syntactic structures					*/
/*		requirements (RHSs of rules)				*/

/*  An edge-label is a functor with 3 components:			*/
/*									*/

/*	label(<structure>, <category>, <requirements>)			*/
/*									*/

/* The interface to the dictionary is via the procedure			*/
/*									*/
/*	word_to_label(<surface word>, <edge-label>)			*/
/*									*/
/*  which performs lexical look-up and formats the answer as a label	*/

/* The interface to the grammar is via the procedures:			*/
/*									*/
/*	rules_with_this_LHS(<category>, <list-of-labels>)		*/
/*	rules_with_this_RHS(<category>, <list-of-labels>)		*/
/*									*/
/*  which find appropriate rules and format them into labels.		*/

/*  The procedure "initial_category(X)" should return the		*/
/*  top symbol of the grammar.						*/

/*  The user should define a predicate "valid_parse" which the system	*/
/*  will apply to all analyses which span the whole string at the end	*/
/*  of the parsing process. Only those on which this predicate succeeds	*/
/*  will be returned from the function "parse". If "valid_parse" is 	*/
/*  left undefined, all spanning parses will be returned.		*/
/*  (This facility requires Prolog to be run in a way such that		*/
/*  undefined procedures do not cause errors).				*/

/*  The interface to the building of syntactic structures is via the	*/
/*  procedures:								*/
/*	is_empty_structure(<category>).					*/
/*  which tests for a structure being empty,				*/
/*  and									*/
/*	compute_requirements(<old-requirements>, <category>,		*/
/*				<new-requirements>).			*/
/*  which, from previous "requirements" of active edge, and "category"	*/
/*  of the inactive edge, computes the "requirements" of the new edge.	*/
/*  Also,								*/
/*	combine_structures(<structure1>, <structure2>, <structure3>).	*/
/*  builds syntactic results (roughly, attaches 2 to 1 as daughter).	*/
/*									*/
/*  (Combining two edges (Fundamental Rule) needs these to be defined).	*/

/*  The user may vary the strategies or edge-policies using:		*/
/*									*/
/*		set_strategy(<strategy-name>).				*/
/*		set_policy(<policy-name>).				*/

/* The actual chart edges are held in the ordinary clause database	*/
/* for easy access. The functor is edge/3.				*/

/* The main external top-level interface is the routine "parse" which */
/* takes a list of surface words and returns a list of valid parses.  */

/* No printing routines are provided - this is specific to the structures */
/* being built, which is another issue which depends on the formalism.	*/

parse(Wordlist, Listofparses):-
	/* Top-level routine - takes ordinary list of words and */
	/* returns list of all valid parses.			*/
	current_strategy(Strategy),	/* Find out what current strategy */
	current_policy(Policy),		/* and policy are.		*/
	initialise_chart(Wordlist, Policy,Agenda),	/* Preliminary setting up */
	/* Now invoke main recursive function, with a null "agenda" and */
	/* a vertex-number of 1. Result returned is total vertex count */
	parse_onwards(Policy, Strategy, Agenda, Wordlist, 1, Noofvertices),
	/* And read the valid parses off the chart.			*/
	extract_parses(Noofvertices, Listofparses).

initialise_chart(Wordlist, Policy, Agenda):-
	/* The chart is held in the ordinary clause database, as a */
	/* set of assertions "edge(<label>, <left-vertex>, <right-vertex>)"*/
	/* so all that is needed is to clear any old assertions of this form.*/
	retractall(edge(_, _, _)),
	assertz(edge(dummy, 0,0)), /* To avoid "edge" being an undefined */
			 	   /* predicate at start of a parse.	*/
	/* (The list of words is passed in case this is ever needed in */
	/* subsequent revisions to this definition.)			*/
	any_initial_edges(Policy, Agenda).

any_initial_edges(top-down, Agenda):-
	initial_category(S),
	add_edges_to_expand(1, S, [], Agenda).

any_initial_edges(bottom-up, []).

set_strategy(Strategy_name):-
	/* A procedure the user can use to set up strategies.	*/
	/* The strategy indicator is held in the database.	*/
	/* First, check validity and standardise the name.	*/
	valid_strategy(Strategy_name, Strategy),
	retractall(current_strategy(_)),
	assertz(current_strategy(Strategy)),
	write('Strategy set to '), write(Strategy),
	!.			/* Only one way to do this. */


set_strategy(Strategy_name):-
	/* This clause for when validity check fails. */
	message('Invalid name for strategy').

set_policy(Policy_name):-
	/* A procedure the user can use to set up strategies.	*/
	/* The policy indicator is held in the database.	*/
	valid_policy(Policy_name, Policy),
	retractall(current_policy(_)),
	assertz(current_policy(Policy)),
	write('Policy set to '), write(Policy),
	!.

set_policy(Policy_name):-
	/* This clause for when validity check fails. */
	message('Invalid name for policy').

valid_strategy(Name, Strategy):-
	check_valid(Name, [d, df, depth-first], depth-first, Strategy);
	check_valid(Name, [b, bf, breadth-first], breadth-first, Strategy),
	!.


valid_policy(Name, Policy):-
	check_valid(Name, [t, td, top-down], top-down, Policy);
	check_valid(Name, [b, bu, bottom-up], bottom-up, Policy),
	!.

check_valid(Name, Listofnames, Standardname, Standardname):-
	member(Name, Listofnames).

/*	Default settings for strategy and policy.	*/

current_strategy(depth-first).

current_policy(top-down).


/*	Main parsing function.				*/

parse_onwards(_, _, [], [], Vertexcount, Vertexcount).
	/* Normal terminating case - no words left, and nothing on agenda.*/

parse_onwards(Policy, Strategy, [], [Word|Rest], Vertexcount, Vertexmax):-
	/* When nothing to do on agenda, take in a new word.	*/
	!,
	use_one_word(Word, Vertexcount, Newvcount, [], Newagenda),
	parse_onwards(Policy, Strategy, Newagenda, Rest, Newvcount, Vertexmax).

parse_onwards(Policy, Strategy, Agenda, Words, Vertexcount, Vertexmax):-
	/* Wholly general case - take job from agenda and build it in chart. */
	get_job_off_agenda(Strategy, Agenda, Agenda2, Job),
	build_edge(Policy, Job, Agenda2, Newagenda),
	parse_onwards(Policy, Strategy, Newagenda, Words,Vertexcount,Vertexmax).


use_one_word(Word, Vcount, Newvcount, Agenda, Newagenda):-
	/* Consume one input word and put an edge-job for it on the agenda. */
	word_to_label(Word, Edgelabel),	/* Look up word and make lexical label. */
	Newvcount is Vcount+1,		/* Extend chart by one vertex. */
	make_edge(Edgelabel, Vcount, Newvcount, Edge),
	add_to_agenda(Edge, Agenda, Newagenda).

make_edge(Label, Leftend, Rightend, edge(Label,Leftend, Rightend)).


add_to_agenda(Edge, Agenda, [Edge|Agenda]).


get_job_off_agenda(depth-first, [Job|Rest], Rest, Job).
	/* Depth-first - run agenda like a stack, take off from front. */

get_job_off_agenda(breadth-first, Agenda, Newagenda, Job):-
	/* Breadth-first - run agenda like a queue, take off from end. */
	remove_from_end(Agenda, Newagenda, Job).

remove_from_end([Result], [], Result):-
	!.

remove_from_end([X|L], [X|L2], Result):-
	remove_from_end(L1, L2, Result).

build_edge(Policy,
	      edge(Label, Vertex, Vertex),
	   Agenda,
	   Agenda):-
	/* Strictly, the way to avoid left-recursion is to have the 	*/
	/* procedures "no_empty_active_edges...." (see below) check	*/
	/* the Agenda as well as the actual chart. That is tedious, so	*/
	/* the short-cut here is to skip edge-building where a replica	*/
	/* exists in the chart already.					*/
	/* This is sufficient to stop endless recursing. The other	*/
	/* (redundant) checks in "enact_policy"  reduce the number of 	*/
	/* unnecessary edges which get on to the agenda, for more	*/
	/* efficiency - this one here is the essential one.		*/
	edge(Label, Vertex, Vertex),
	/* Could probably be generalised to a check for ANY edge, not	*/
	/* just those where left end = right end.			*/
	!.

build_edge(Policy, Edge, Agenda, Newagenda):-
	/* Putting an edge into the actual chart has three stages. */
	/* Do fundamental rule*/
	fundamental_rule(Edge, Agenda, Agenda2),
	/* Do active-edge policy				*/
	enact_policy(Policy, Edge, Agenda2, Newagenda),
	/* Put edge in database.*/
	assertz(Edge).

fundamental_rule(edge(Label, Leftend, Rightend), Agenda, Newagenda):-
	/* The traditional Fundamental Rule of chart parsing - */
	/* if an active and an inactive edge have collided,	*/
	/* add appropriate edges computed from the two edges.	*/
	active(Label),	/* If the one being built is active, */
	!,		/* Only two real cases - active or inactive. */
	/* Extract all inactive edges whose LEFT end is same as this RIGHT end*/
	find_edges(edge(Alabel, Rightend,_ ), inactive(Alabel), Listofedges),
	formalledges(edge(Label, Leftend, Rightend), Listofedges,
							Agenda, Newagenda).


fundamental_rule(edge(Label, Leftend, Rightend), Agenda, Newagenda):-
	/* The traditional Fundamental Rule of chart parsing - */
	/* if an active and an inactive edge have collided,	*/
	/* add appropriate edges computed from the two edges.	*/
	inactive(Label),	/* If the one being built is inactive, */
	!,		/* Only two real cases - active or inactive. */
	/* Extract all active edges whose RIGHT end is same as this LEFT end*/
	find_edges(edge(Alabel, _, Leftend ), active(Alabel), Listofedges),
	formalledges(edge(Label, Leftend, Rightend), Listofedges,
							Agenda, Newagenda).

find_edges(Edgepattern, Testonedges, Listofedges):-
	findall(Edgepattern, (Edgepattern, Testonedges), Listofedges).

formalledges(Edge, [], Agenda, Agenda).

formalledges(Edge1, [Edge2| Rest], Agenda, Newagenda):-
	combine_edges(Edge1, Edge2, Newedge),
	!,
	add_to_agenda(Newedge, Agenda, Agenda2),
	formalledges(Edge1, Rest, Agenda2, Newagenda).

formalledges(Edge1, [Edge2|Rest], Agenda, Newagenda):-
	/* If these aren't combinable, move on to rest . */
	formalledges(Edge1, Rest, Agenda, Newagenda).

combine_edges(Edge1, Edge2, Edge3):-
	can_combine(Edge1, Edge2, EdgeA, EdgeI),
	form_new_edge(EdgeA, EdgeI, Edge3).

can_combine(Edge1, Edge2, Edge1, Edge2):-
	active(Edge1),
	inactive(Edge2),
	mergeable(Edge1, Edge2).

can_combine(Edge1, Edge2, Edge2, Edge1):-
	active(Edge2),
	inactive(Edge1),
	mergeable(Edge2, Edge1).

mergeable(edge(Label1,_,_), edge(Label2, _, _)):-
	extension_requirement(Label1, Category),
	overall_category(Label2, Category).

form_new_edge(edge(
		  label(Structure1, Category1, Requirements1),
		  Left1, Right1),
	      edge(
		  label(Structure2, Category2, []),
		  Left2, Right2),
	      edge(label(Structure3, Category1, Requirements3),
		  Left1, Right2)):-

	compute_requirements(Requirements1, Category2, Requirements3),
	combine_structures(Structure1, Structure2, Structure3).


	

enact_policy(top-down, edge(Label,Leftend, Rightend), Agenda, Newagenda):-
	/* For each of the two possible policies, there are different */
	/* consequences of putting in an edge.				*/
	active(Label),			/* Only applicable to active edges.*/
	extension_requirement(Label, Category),	/* What does this edge seek ? */
	expandable(Category),		/* Is this rule-expandable? */
	no_empty_active_edges_expanding(Rightend, Category),
	/* Left-recursion avoidance.*/
	add_edges_to_expand(Rightend, Category, Agenda, Newagenda),
	!.				/* Don't try it any other way! */


enact_policy(bottom-up, edge(Label,Leftend, Rightend), Agenda, Newagenda):-
	/* For each of the two possible policies, there are different */
	/* consequences of putting in an edge.				*/
	inactive(Label),		/* Only applicable to inactive edges.*/
	overall_category(Label, Category),/* What does this edge represent ? */
	no_empty_active_edges_using(Leftend, Category),
	/* Left-recursion avoidance.*/
	add_edges_to_use(Leftend, Category, Agenda, Newagenda),
	!.				/* Don't try it any other way! */

enact_policy(_, _, Agenda, Agenda).	/* If no ramifications via the above.*/

/* For convenience, "active" and "inactive" are polymorphic - can be applied */
/* to a label or an edge. The result for an edge is that of its label. */

inactive(edge(L, _, _)):-	inactive(L).
active(edge(L,_,_)):-		active(L).

inactive(label(Structure, Category, [])).
	/* A label is "inactive" if it is no longer seeking constituents.*/

active(Label):-
	/* A label is "active" if and only if it is not inactive. */
	!,not(inactive(Label)).

empty(label(Structure, _, _)):-
	/* an "empty" edge is one with no structure yet built. */
	/* exact representation user-definable.		*/
	is_empty_structure(Structure).

extension_requirement(label(_, _, [Firstsymbol|Rest]), Firstsymbol).

overall_category(label(_, Category, _), Category).

expandable(Category):-
	rules_with_this_LHS(Category, Rulelist),
	Rulelist\== [].

no_empty_active_edges_expanding(Vertex, Category):-
	not(some_empty_active_edges_expanding(Vertex,Category)).

some_empty_active_edges_expanding(Vertex,Category):-
	edge(Label, Vertex , Vertex),
	empty(Label),
	active(Label),
	overall_category(Label, Category),
	!.

no_empty_active_edges_using(Vertex, Category):-
	not(some_empty_active_edges_using(Vertex,Category)).

some_empty_active_edges_using(Vertex,Category):-
	edge(Label, Vertex , Vertex),
	empty(Label),
	active(Label),
	extension_requirement(Label, Category),
	!.


add_edges_to_expand(Vertex, Category, Agenda, Newagenda):-
	rules_with_this_LHS(Category, Labellist),/* Result in form of labels.*/
	add_all_edges(Labellist, Vertex, Agenda, Newagenda).

add_edges_to_use(Vertex, Category, Agenda, Newagenda):-
	rules_with_this_RHS(Category, Labellist),/* Result in form of labels.*/
	add_all_edges(Labellist, Vertex, Agenda, Newagenda).

add_all_edges([], V, Agenda, Agenda).	/* Base case */

add_all_edges([Label | Morelabels], Vertex, Agenda, Newagenda):-
	add_to_agenda(edge(Label, Vertex, Vertex), Agenda, Agenda2),
	add_all_edges(Morelabels, Vertex, Agenda2, Newagenda).


extract_parses(Vertexmax, Listofparses):-
	/* Collect all structures which span the whole sentence, and */
	/* have inactive edges, and are valid as entities.	*/
	findall(Structure,		/* All structures such that...*/
	( edge(label(Structure,_,[]),1, Vertexmax),	/* they span,and*/
	  good_parse(Structure)),	/* ...this is also true. */
	Listofparses).

good_parse(S):-
	valid_parse(S),		/* User definable, for filtering analyses.*/
	!.
good_parse(_).			/* Not fussy otherwise.			 */

?-unknown(_, 'fail').		/* Necessary for allowing user to omit to */
				/* define "valid_parse".		  */

findall(X, P, L):-		/* For C-Prolog compatibility - a version of */
	bagof(X,P,L), !.	/* bagof that doesn't fail if there are none,*/
findall(X,P, []):- !.		/* but returns an empty list.		*/

--------