Definite Clause Grammars Examples

A simple example of parsing using DCG

sentence --> noun_phrase, verb_phrase.
noun_phrase --> determiner, noun.
verb_phrase --> verb, noun_phrase.
verb_phrase --> verb, sentence.

determiner --> [the].
determiner --> [a].
noun --> [cat].
noun --> [mouse].
verb --> [scares].
verb --> [hates].

?-sentence([the,cat,scares,the,mouse],[]).
Notice that the nonterminal symbol 'sentence' has no arguments when used in a DCG rule, but it is called with two arguments when used for parsing. The two arguments are: the sentence to be parsed, and an empty list. Wen DCG rules are translated from DCG to regular Prolog two arguments are added to each of the nonterminal symbols. This explains why they need to be called with two extra arguments.

Parsing with grammatical agreement (singular/plural)

% The argument Number is the number of the subject and main verb.
% It is instantiated to 'singular' or 'plural'. 

sentence(Number) --> noun_phrase(Number), verb_phrase(Number).
noun_phrase(Number) --> determiner(Number), noun(Number).
verb_phrase(Number) --> verb(Number), noun_phrase(_).

determiner(singular) --> [a].
determiner(_)        --> [the].
determiner(plural)   --> [].
noun(singular) --> [cat];[man];[mouse].
noun(plural)   --> [cats];[men];[mice].
verb(singular) --> [scares];[hates].
verb(plural)   --> [scare];[hate].

?-sentence(plural,[men,hate,mice],[]).
?-sentence(_,[the,men,hate,mice],[]).
?-sentence(_,[the,mice,scare,the,man],[]).

Including morphology in parsing

% From the book PROLOG PROGRAMMING IN DEPTH
% by Michael A. Covington, Donald Nute, and Andre Vellino
% (Prentice Hall, 1997). Copyright 1997 Prentice-Hall, Inc.
% For educational use only

sentence --> noun_phrase(N), verb_phrase(N).
noun_phrase(N) --> determiner(N), noun(N).
verb_phrase(N) --> verb(N), noun_phrase(_).
verb_phrase(N) --> verb(N), sentence.

determiner(singular) --> [a].
determiner(_)        --> [the].
determiner(plural)   --> [].
noun(N) --> [X], { morph(noun(N),X) }.
verb(N) --> [X], { morph(verb(N),X) }.

% morph(-Type,+Word)
%  succeeds if Word is a word-form of the specified type.

morph(noun(singular),dog).       % Singular nouns
morph(noun(singular),cat).
morph(noun(singular),boy).
morph(noun(singular),girl).
morph(noun(singular),child).

morph(noun(plural),children).    % Irregular plural nouns

morph(noun(plural),X) :-         % Rule for regular plural nouns
     remove_s(X,Y),
     morph(noun(singular),Y).

morph(verb(plural),chase).       % Plural verbs
morph(verb(plural),see).
morph(verb(plural),say).
morph(verb(plural),believe).

morph(verb(singular),X) :-       % Rule for singular verbs
     remove_s(X,Y),
     morph(verb(plural),Y).

% remove_s(+X,-X1) [lifted from TEMPLATE.PL]
%  removes final S from X giving X1,
%  or fails if X does not end in S.

remove_s(X,X1) :-
     name(X,XList),
     remove_s_list(XList,X1List),
     name(X1,X1List).

remove_s_list("s",[]).

remove_s_list([Head|Tail],[Head|NewTail]) :-
     remove_s_list(Tail,NewTail).

Parsing and constructing the parse tree

/* this generates a parse tree for a simple English grammar */

sentence(sentence(X,Y)) -->
   noun_phrase(X), verb_phrase(Y).

noun_phrase(noun_phrase(X,Y)) -->
   determiner(X), noun(Y).

verb_phrase(verb_phrase(X,Y)) -->
   verb(X), noun_phrase(Y).

determiner(determiner(the)) --> [the].
determiner(determiner(a)) --> [a].
noun(noun(mouse)) --> [mouse].
noun(noun(cat)) --> [cat].
verb(verb(hate)) --> [hated].
verb(verb(scare)) --> [scared].

?-sentence(Parsetree,[the.mouse,hated,the,cat],[]).
/* this is a more complex grammar, which also checks for singular/plural
   and returns the parse tree.
   From Pereira and Warren paper, AI journal, 1980 */

sentence(s(NP,VP)) --> 
	noun_phrase(N, NP), verb_phrase(N,VP).
noun_phrase(N,np(Det,Noun,Rel)) --> 
	determiner(N, Det), noun(N,Noun), rel_clause(N,Rel).
noun_phrase(singular,np(Name)) --> 
	name(Name).
verb_phrase(N,vp(TV,NP)) --> 
	trans_verb(N,TV), noun_phrase(_,NP).
verb_phrase(N,vp(IV)) --> 
	intrans_verb(N,IV).
rel_clause(N,rel(that,VP)) --> 
	[that],verb_phrase(N,VP).
rel_clause(_,rel(nil)) --> [].
determiner(N,det(W)) --> [W],{is_determiner(W,N)}.
determiner(plural,det(nil)) --> [].

noun(N,n(Root)) --> [W],{is_noun(W,N,Root)}.
name(name(W)) --> [W],{is_name(W)}.
trans_verb(N,tv(Root)) --> [W],{is_trans(W,N,Root)}.
intrans_verb(N,iv(Root)) --> [W],{is_intrans(W,N,Root)}.

is_determiner(every,singular).
is_determiner(all,plural).
is_noun(man,singular,man).
is_noun(men,plural,men).
is_name(mary).
is_trans(likes,singular,like).
is_trans(like,plural,like).
is_intrans(live,plural,live).

/* examples */
/*
?- sentence(S,[all,men,live],[]).
?- sentence(S,[every,man,likes,mary],[]).
?- sentence(S,[every,man,likes,mary],[]).
*/

Semantic Interpretation

/* from Bratko chapter 17 page 455.
   This comes from Pereira and Warren paper, AI journal, 1980 */

/* this is to define infix operators  and their argument precedence 
   x represents an argument whose precedence is strictly lower than that
   of the operator. y represents an argument whose precedence is lower 
   or equal than that of the operator. */
:- op(100,xfy,and).
:- op(150,xfx,'=>').

/* when using sentence we need to pass 3 arguments, 
   the first will match S in the head of the DGC clause
   the second is the list containing the words in the sentence
   the third is the empty list.
   Example:
     sentence(Meaning, [every,man,that,paints,likes,monet],[]) */

sentence(S) --> 
	noun_phrase(X,Assn,S), verb_phrase(X,Assn).
noun_phrase(X,Assn,S) --> 
	determiner(X,Prop12,Assn,S),noun(X,Prop1),rel_clause(X,Prop1,Prop12).
noun_phrase(X,Assn,Assn) --> 
	proper_noun(X).
verb_phrase(X,Assn) --> 
	trans_verb(X,Y,Assn1),noun_phrase(Y,Assn1,Assn).
verb_phrase(X,Assn) --> 
	intrans_verb(X,Assn).
rel_clause(X,Prop1,Prop1 and Prop2) --> 
	[that],verb_phrase(X,Prop2).
rel_clause(_,Prop1,Prop1) --> [].

determiner(X,Prop,Assn,all(X,(Prop => Assn))) --> [every].
determiner(X,Prop,Assn,exists(X,Prop and Assn)) --> [a].

noun(X,man(X)) --> [man].
noun(X,woman(X)) --> [woman].
proper_noun(john) --> [john].
proper_noun(annie) --> [annie].
proper_noun(monet) --> [monet].
trans_verb(X,Y,like(X,Y)) --> [likes].
trans_verb(X,Y,admire(X,Y)) --> [admires].
intrans_verb(X,paint(X)) --> [paints].

/* examples */
/*
?- sentence(S,[every,man,that,paints,likes,monet],[]).
?- sentence(S,[a,woman,that,admires,john,paints],[]).
?- sentence(S,[every,woman,that,likes,a,man,that,admires,monet,paints],[]).
?- sentence(S,[john,likes,annie],[]).
?- sentence(S,[annie,likes,a,man,that,admires,monet],[]).
*/