% From Research Report AI-1993-03
% Artificial Intelligence Programs
% The University of Georgia

% Copyright 1993 Ulrich Koch

% Requires GULP.

/* File LATIN.GLP */
/* This is the dependency parser.
   There is also a Russian version, which contains mistakes
   (this Latin one is believed to be mistake-free).
   This is not Prolog, this is GULP. */

/*
 * Unification-based dependency grammar
 *
 * This sample parser parses Latin sentences.
 * It considers word order to be totally free.
 */

/*
 * Vocabulary
 */

g_features([phon,cat,subcat,case,num,gen,pers,dep]).

/* The value of dep (if any) is an open list of
   ordered triples.
   The components of each triple are: the dependency type,
   an open list of words (FS's), and the minimal number of
   dependencies (of this type) that must be established.
   The minimal number of dependencies can be 0 or 1. */

word(phon:felis :: cat:noun :: case:nom :: num:sing
 :: gen:masc :: pers:3).
word(phon:felem :: cat:noun :: case:acc :: num:sing
 :: gen:masc :: pers:3).
word(phon:feles :: cat:noun :: case:nom :: num:pl  
 :: gen:masc :: pers:3).
word(phon:feles :: cat:noun :: case:acc :: num:pl  
 :: gen:masc :: pers:3).
word(phon:canis :: cat:noun :: case:nom :: num:sing
 :: gen:masc :: pers:3).
word(phon:canem :: cat:noun :: case:acc :: num:sing
 :: gen:masc :: pers:3).
word(phon:canes :: cat:noun :: case:nom :: num:pl  
 :: gen:masc :: pers:3).
word(phon:canes :: cat:noun :: case:acc :: num:pl  
 :: gen:masc :: pers:3).

word(phon:silva  :: cat:noun :: case:nom :: num:sing
 :: gen:fem :: pers:3).
word(phon:silvam :: cat:noun :: case:acc :: num:sing
 :: gen:fem :: pers:3).
word(phon:silvae :: cat:noun :: case:nom :: num:pl  
 :: gen:fem :: pers:3).
word(phon:silvas :: cat:noun :: case:acc :: num:pl  
 :: gen:fem :: pers:3).

word(phon:agitat  :: cat:verb :: subcat:2 :: num:sing
 :: pers:3 :: dep:[(accobject,_,1)|_]).
word(phon:agitant :: cat:verb :: subcat:2 :: num:pl  
 :: pers:3 :: dep:[(accobject,_,1)|_]).
word(phon:dormit   :: cat:verb :: subcat:1 :: num:sing
 :: pers:3).
word(phon:dormiunt :: cat:verb :: subcat:1 :: num:pl  
 :: pers:3).
word(phon:albus :: cat:adj :: case:nom :: num:sing
 :: gen:masc).
word(phon:album :: cat:adj :: case:acc :: num:sing
 :: gen:masc).
word(phon:albi  :: cat:adj :: case:nom :: num:pl  
 :: gen:masc).
word(phon:albos :: cat:adj :: case:acc :: num:pl  
 :: gen:masc).

word(phon:ater  :: cat:adj :: case:nom :: num:sing
 :: gen:masc).
word(phon:atrum :: cat:adj :: case:acc :: num:sing
 :: gen:masc).
word(phon:atri  :: cat:adj :: case:nom :: num:pl  
 :: gen:masc).
word(phon:atros :: cat:adj :: case:acc :: num:pl  
 :: gen:masc).
word(phon:atra  :: cat:adj :: case:nom :: num:sing
 :: gen:fem).
word(phon:atram :: cat:adj :: case:acc :: num:sing
 :: gen:fem).
word(phon:atrae :: cat:adj :: case:nom :: num:pl  
 :: gen:fem).
word(phon:atras :: cat:adj :: case:acc :: num:pl  
 :: gen:fem).
word(phon:parvus :: cat:adj :: case:nom :: num:sing
 :: gen:masc).
word(phon:parvum :: cat:adj :: case:acc :: num:sing
 :: gen:masc).
word(phon:parvi  :: cat:adj :: case:nom :: num:pl  
 :: gen:masc).
word(phon:parvos :: cat:adj :: case:acc :: num:pl  
 :: gen:masc).

word(phon:magnus :: cat:adj :: case:nom :: num:sing
 :: gen:masc).
word(phon:magnum :: cat:adj :: case:acc :: num:sing
 :: gen:masc).
word(phon:magni  :: cat:adj :: case:nom :: num:pl  
 :: gen:masc).
word(phon:magnos :: cat:adj :: case:acc :: num:pl  
 :: gen:masc).

word(phon:per :: cat:prep :: case:acc :: dep:[(object,_,1)|_]).
word(phon:in  :: cat:prep :: case:acc :: dep:[(object,_,1)|_]).
/*
 * D-rules (initial set, ignoring word order)
 */

/*
 * drule(Head,Dependent,DepType,Max)
 *   Head is also known as 'governor'.
 *   Max is the maximal number of dependencies (of type
 *   DepType) that can be established.
 *   Max can be 1 or infinity.
 */

drule(cat:verb :: pers:P :: num:N,
  cat:noun :: case:nom :: pers:P :: num:N,
  subject, 1).
drule(cat:verb :: subcat:2,
  cat:noun :: case:acc,
  accobject, 1).
drule(cat:verb, /* no constraint on subcat of verb:
                   prepobject is an adjunct */
  cat:prep,
  prepobject, infinity).
drule(cat:noun :: case:C :: num:N :: gen:G,
  cat:adj :: case:C :: num:N :: gen:G,
  modifier, infinity).
drule(cat:prep :: case:C,
  cat:noun :: case:C,
  object, 1).
/*
 * Dependency parsing
 */

parse(InputList,Result) :-
  parse_aux(InputList,[],[],Result),
  check_req_deps_of_list(Result).

/*
 * parse_aux(InputList,PrevWords,HeadList,Result)
 *
 *   where InputList is the list of words (or rather FS)
 *   yet to be examined, PrevWords contains (in reverse order)
 *   the words already examined, HeadList contains one or more
 *   structures built so far, and Result will be the output of
 *   the parsing process.
 */

parse_aux([],_,Result,Result).

parse_aux([Head|Tail],PrevWords,HeadList,Result) :-
     parse_item(Head,PrevWords,HeadList,NewHeadList),
     parse_aux(Tail,[Head|PrevWords],NewHeadList,Result).

     /* Work along InputList calling parse_item for
        each element. */
/*
 * check_req_deps(Word)
 *   checks if all required dependents of Word are present
 */

check_req_deps(Word) :-
  Word = dep:Deps,
  check_num_deps(Deps).

/*
 * check_req_deps_of_list(Words)
 *   for each element of Words, which is a (possibly open)
 *   list, checks if all its required dependents are present
 */

check_req_deps_of_list(Words) :-
  nonvar(Words),
  Words = [Word|Tail],
  check_req_deps(Word),
  check_req_deps_of_list(Tail).

check_req_deps_of_list(Words) :-
  nonvar(Words),
  Words = [].  /* at end of non-open list */

check_req_deps_of_list(Words) :-
  var(Words).  /* at end of open list */
/*
 * check_num_deps(DepList)
 *   for each element of DepList, which is an open list of
 *   triples, checks if the minimal number (0 or 1) of
 *   dependents of the type in question is present
 */

check_num_deps(DepList) :-
  nonvar(DepList),
  DepList = [(DepType,Words,1)|Tail],
  nonvar(Words),    /* there is at least one dependent of
                       this type */
  check_req_deps_of_list(Words),
  check_num_deps(Tail).

check_num_deps(DepList) :-
  nonvar(DepList),
  DepList = [(DepType,Words,0)|Tail],
  check_req_deps_of_list(Words),
  check_num_deps(Tail).

check_num_deps(DepList) :- var(DepList).  /* at end of list */
/*
 * parse_item(Item,PrevWords,HeadList,NewHeadList)
 *
 *   inserts Item into HeadList in the proper place,
 *   giving NewHeadList.
 */

parse_item(Item,[],[],[Item]) :- !.
     /* If this is the first word, simply add it to
        HeadList. */

parse_item(Item,PrevWords,HeadList,NewHeadList) :-
     /* First insert Item above as many items as it
        can dominate...*/
     try_inserting_as_head(Item,PrevWords,HeadList,HeadList2),
     /* Then add Item to HeadList...*/
     HeadList3 = [Item|HeadList2],
     /* Then insert Item as dependent of another word
        if possible. */
     try_inserting_as_dependent(Item,PrevWords,HeadList3,
       NewHeadList).
/*
 * try_inserting_as_head(Item,PrevWords,HeadList,NewHeadList)
 *
 *   Search through Headlist and insert Item above one or more
 *   pre-existing items, if possible.
 */

try_inserting_as_head(Item,_,[],[]).
   /* We have recursed all the way down Headlist;
      we may or may not have attached Item above things
      encountered along the way. */

try_inserting_as_head(Item,_,[Head|HeadList],NewHeadList) :-
   /* Insert Item above Head, and remove Head from HeadList. */
      drule(Item,Head,DepType,Max),
      Item = dep:Deps,
      insert_into_deps(Head,Deps,DepType,Max),
      try_inserting_as_head(Item,_,HeadList,NewHeadList).
          /* Recurse down the rest of HeadList. */

try_inserting_as_head(Item,_,[Head|HeadList],
  [Head|NewHeadList]) :-
   /* Can't do it or choose not to do it, so continue without
      doing it. */
     try_inserting_as_head(Item,_,HeadList,NewHeadList).
/*
 * try_inserting_as_dependent(Item,PrevWords,HeadList,
 *                            NewHeadList)
 *
 *   inserts Item as a dependent of an earlier word
 *   if possible.
 */

try_inserting_as_dependent(Item,PrevWords,HeadList,
                           NewHeadList) :-
     member(PrevWord,PrevWords),
     drule(PrevWord,Item,DepType,Max),
     PrevWord = dep:PrevDeps,
     insert_into_deps(Item,PrevDeps,DepType,Max),
     delete_element(Item,HeadList,NewHeadList).

try_inserting_as_dependent(Item,_,HeadList,HeadList).
/*
 * insert_into_deps(Item,Deps,DepType,Max)
 *   Inserts Item into Deps (in the proper place) as
 *   dependent of type DepType iff less than Max
 *   dependencies of this type have already been established.
 *   (Deps is an open list of triples, Max is either 1 or
 *   infinity.)
 */

insert_into_deps(Item,Deps,DepType,_) :-
  var(Deps),   /* open list is empty */
  Deps = [(DepType,[Item|_],0)|_].
  /* insert with 0 required dependents */

insert_into_deps(Item,Deps,DepType,1) :-
  nonvar(Deps),
  Deps = [(DepType,Words,_)|_],
  var(Words),   /* there are no dependents of this type yet */
  Words = [Item|_].

insert_into_deps(Item,Deps,DepType,infinity) :-
  nonvar(Deps),
  Deps = [(DepType,Words,_)|_],
  insert(Item,Words).

insert_into_deps(Item,Deps,DepType,Max) :-
  nonvar(Deps),
  Deps = [(OtherDepType,_,_)|Tail],
  \+ (OtherDepType = DepType),
  insert_into_deps(Item,Tail,DepType,Max).
/*
 * lex_scan(InputString,ScannedList)
 *   Performs lexical scan, replacing each word with its
 *   lexical entry.
 */

lex_scan(InputString,ScannedList) :-
     lex_scan_aux(InputString,_,ScannedList).

lex_scan_aux([],_,[]).

lex_scan_aux([Word|Tail],PrevWord,[ScannedWord|ScannedTail]) :-
     ScannedWord = phon:Word,
     word(ScannedWord),
     lex_scan_aux(Tail,ScannedWord,ScannedTail).


/*
 * Manipulation of open lists (with uninstantiated tails)
 */

/*
 * new_tail(List,Tail)
 *  where List has an uninstantiated tail,
 *  instantiates the tail of List to Tail.
 *  NOTE: The empty open list is _, not [_].
 */

new_tail(Y,X) :- nonvar(Y), Y=[_|Tail], new_tail(Tail,X).
new_tail(X,X).

/*
 * insert(Item,List)
 *  adds Item to the end of List, which is (and
 *  remains) an open list.
 */

insert(Item,List) :- new_tail(List,[Item|_]).
/*
 * Utilities
 */


/*
 * once(Goal)
 *   used instead of Arity/Prolog snips
 */

once(X) :- X, !.


/*
 * delete_element(Element,OldList,NewList)
 *   deletes Element from OldList giving NewList.
 */

delete_element(_,[],[]).

delete_element(Element,[Element|Tail],Tail) :- !.

delete_element(X,[Y|Z],[Y|NewZ]) :-
  \+ (Y = X), delete_element(X,Z,NewZ).
/*
 * display_dependency_tree(HeadList)
 *   Displays a dependency tree in indented form,
 *   including dependency type information.
 *   (HeadList may be open.)
 */

display_dependency_tree(HeadList) :-
     display_dependency_indented(HeadList,none,0).

/*
 * display_dependency_indented(HeadList,DepType,Indent)
 *   Auxiliary predicate for display_dependency_tree/1.
 *   DepType is the dependency type of HeadList's elements.
 *   (A dependency type of 'none' is not printed out.)
 *   Indent is the indentation.
 */

display_dependency_indented(HeadList,_,_) :-
     var(HeadList).  /* at end of open list */

display_dependency_indented(HeadList,_,_) :-
     nonvar(HeadList),
     HeadList = [].  /* at end of non-open list */

display_dependency_indented(HeadList,DepType,N) :-
     nonvar(HeadList),
     HeadList = [Head|Tail],
     nonvar(Head),
     tab(N),
     Head = phon:Hphon,
     write(Hphon),
     display_dep_type(DepType),
     nl,
     Head = dep:Hdeps,
     NewN is N+2,
     display_triple_list_indented(Hdeps,NewN),
     display_dependency_indented(Tail,DepType,N).
/*
 * display_triple_list_indented(Deps,N)
 *   Displays the elements of Deps, which is an open list
 *   of triples.
 */

display_triple_list_indented(Deps,_) :-
     var(Deps).

display_triple_list_indented(Deps,N) :-
     nonvar(Deps),
     Deps = [(DepType,Words,_)|Tail],
     display_dependency_indented(Words,DepType,N),
     display_triple_list_indented(Tail,N).

/*
 * display_dep_type(DepType)
 */

display_dep_type(none) :- !.

display_dep_type(DepType) :- write(' '), write(DepType).


/*
 * exhibit(HeadList)
 *   Normal way of displaying a list of feature structures.
 */

exhibit(X) :- var(X), !, write(X), nl.

exhibit([]) :- !,nl.

exhibit([Head|Tail]) :- !,nl,exhibit(Head),exhibit(Tail).

exhibit(X) :- g_display(X).
/* Test */

pause :-  nl,
          write('Press Ctrl-Break to quit, any other key'),
          write(' to look for alternatives...'),
          nl,
          get0(_),
          nl.

try(String) :-      /* String is a list of words as atoms */
        lex_scan(String,X),
        write(String),nl,
        once((write('Scanned string: '),nl,exhibit(X),nl,nl)),
        parse(X,Parsed),
        Parsed = [_],   /* we only want unitary parses */
        once((write('Parsed structure: '),nl,
              display_dependency_tree(Parsed))),
        pause,
        fail.

test1 :- try([agitat,canis,per,silvam,felem]).
test2 :- try([canes,agitant,feles]).
test3 :- try([agitat,agitat]).  /* not a sentence */
test4 :- try([agitat,canis,felem]).
test5 :- try([agitat,felem,canis]).
test6 :- try([canis,agitat,felem]).
test7 :- try([canis,felem,agitat]).
test8 :- try([felem,canis,agitat]).
test9 :- try([felem,agitat,canis]).
test10 :- try([agitat,canis,per,felem]).
  /* is rejected */
test11 :- try([agitat,canis,parvus,ater,per,atram,silvam,
               felem,album]).
test12 :- try([dormit,canis]).
test13 :- try([dormit,canis,per,silvam]).
  /* is accepted: the anomaly is semantic rather than
     syntactic */
test14 :- try([dormit,canis,felem]).  /* is rejected */