Examples of Lexical Choice Procedures

Where does the input come from?

Once we have this data, we need to reformat it (simply put it in a syntax that is convenient for further processing). The following code can be used in the specific case of the Gazdar and Mellish's planner. Similar code needs to be written for different applications.

(load "~elhadad/didactica/nlg/gazdar/loader")
(lib 'plan)

;; Stage 1: syntax
;; Turn (request sue alan (request alan ann (move ann outside inside)))
;; into:
;; ((semr ((pred ((type request)))
;;         (args ((asker ((name sue)))
;;                (askee ((name ann)))
;;                (action ((pred ((type move)))
;;                         (args ((agent ((name ann)))
;;                                (from  ((name outside)))
;;                                (to    ((name inside))))))))))))
;;
;; Stage 2: lexical choice
;; 

;; ============================================================
;; PLAN-TO-FD
;; ============================================================
;; 
;; Examples:
;; (move a f t)
;; -->
;; ((semr ((pred move)
;;         (args ((agent ((name a)))
;;                (from ((name f)))
;;                (to ((name i))))))))
;;
;; (request sue alan (move alan outside inside))
;; -->
;; ((semr ((pred request)
;;         (args ((asker ((name sue)))
;;                (askee ((name alan)))
;;                (action ((pred move)
;;                         (args ((agent ((name alan)))
;;                                (from ((name outside)))
;;                                (to ((name inside))))))))))))
;;
;; To make general, work on the predicate and use a syntax table that gives
;; us the following information:
;; PREDICATE-NAME ARITY 
;; PRED-ARG1 NAME TYPE (type can be :action or :entity)
;;
;;
;; Just wraps the result in the semr level to make compatible with the
;; lexical chooser's expectations.
;;
(defun plan-to-fd (p)
  "Get a formula from the planner and turn it into an FD syntax."
  (let ((semrep (plan-to-fd1 p)))
    (if semrep
	`((semr ,semrep)))))

;; Main function - lookup syntax table
(defun plan-to-fd1 (p)
  (let* ((pred (car p)))
    (if (pred-check p)
	`((pred ,pred)
	  (args ,(loop for arg from 1 to (pred-arity pred)
		       collect (pred-map-to-fd (pred-name pred arg) 
					       (pred-type pred arg)
					       (nth arg p)))))
      (error "Unknown predicate or bad arity: ~s" p))))


;; Map a plan value to a pair representation (name fd)
(defun pred-map-to-fd (name type value)
  (cond ((eq type :entity)
	 `(,name ((name ,value))))
	((eq type :action)
	 `(,name ,(plan-to-fd1 value)))
	(t (error "Unknown argument type: ~s" type))))


;; ============================================================
;; Predicate syntax definition:
;; (def-pred move (from :entity) (to :entity))
;; (def-pred request (asker :entity) (askee :entity) (action :action))
;; Default is entity
;; (def-pred move from to)
;; ============================================================
;;

(defvar *plan-predicates* (make-hash-table)
  "Hash table predicate-name / syntax")

(defmacro def-pred (name &rest args)
  `(multiple-value-bind (old found) (gethash ',name *plan-predicates*)
     (declare (ignore old))
     (when found
       (format t "Redefining predicate ~s~%" ',name))
     ;; Store predicate's name and arity
     ;; For each arg, store position, type and name.
     (setf (gethash ',name *plan-predicates*) 
	   ',(predicate-normalize args))))

(defun predicate-normalize (args)
  (let ((args (mapcar #'(lambda (arg)
			  (if (consp arg) arg `(,arg :entity)))
		      args)))
    `(,(length args) ,@args)))

(defun predicate-arity (l)
  (first l))

;; Get a pair (name type) for argument number n (starting at 1)
(defun predicate-arg (l n)
  (nth n l))

;; Check that predicate is defined and is used with proper arity.
(defun pred-check (p)
  (unless (consp p)
    (error "Plan formula must be a list of the form (pred . args): ~s" p))
  (multiple-value-bind (synt found) (gethash (car p) *plan-predicates*)
    (if found
      (let ((arity (predicate-arity synt)))
	(= (length p) (1+ arity))))))

(defun pred-arity (pred)
  (multiple-value-bind (synt found) (gethash pred *plan-predicates*)
    (if found
	(predicate-arity synt))))
  

(defun pred-name (pred n)
  (multiple-value-bind (synt found) (gethash pred *plan-predicates*)
    (if found
	(car (predicate-arg synt n)))))


(defun pred-type (pred n)
  (multiple-value-bind (synt found) (gethash pred *plan-predicates*)
    (if found
	(second (predicate-arg synt n)))))


  
;;
;; SYNTAX TABLE
;;
(def-pred request asker askee (action :action))
(def-pred move agent from to)
(def-pred can_do agent (action :action))
(def-pred want agent (action :action))
(def-pred believe agent (action :action))
(def-pred at agent location)
(def-pred inform informer informee (proposition :action))
(def-pred inform_ref informer informee (predicate :action))
(def-pred knows_ref knower (predicate :action))
(def-pred convince influence influenced (proposition :action))

What should the output be?

;; 3 people - Sue <--> Alan <--> Ann
;; Sue wants to know the combination
;; Ann knows the combination
;; 
;; Desired speech act:
;; Sue to Alan:  "Ask Ann what is the combination."
;;
(setf infrules 
  '(((CHANNEL SUE ALAN)) ((CHANNEL ALAN SUE)) ((CHANNEL ALAN ANN))
    ((CHANNEL ANN ALAN)) ((KNOWS_REF ANN COMBINATION))))

;; (plan 'sue '((knows_ref sue combination)))

;; This gives us:
;; ((request sue alan (request alan ann (inform_ref ann alan combination)))...)


;; How to map to an input to SURGE?
;;

(def-test r1
  "Ask Ann what is the combination."
  ((cat clause)
   (mood imperative)
   (proc ((lex "ask") (type lexical)
	  (subcat ((1 {^3 lex-roles asker})
		   (2 {^3 lex-roles askee})
		   (3 {^3 lex-roles question})
		   (1 ((cat np)))
		   (2 ((cat np)))
		   (3 ((cat clause) (mood wh)))))))
   (lex-roles
    ((asker ((cat trivial-proper) (lex "Alan") (index alan)))
     (askee ((cat trivial-proper) (lex "Ann") (index ann)))
     (question ((cat clause)
		(proc ((type ascriptive) (mode equative)))
		(scope {^ partic identified})
		(partic ((identifier ((cat common)
				      (definite yes)
				      (lex "combination")))))))))))


;; 3 people - Sue <--> Alan <--> Ann
;; Ann is outside.
;; Sue wants Ann to come inside.
;; 
;; Desired speech act:
;; Sue to Alan:  "Ask Ann to come inside."
;;
(setf infrules 
  '(((CHANNEL SUE ALAN)) ((CHANNEL ALAN SUE)) ((CHANNEL ALAN ANN))
    ((CHANNEL ANN ALAN)) ((AT ANN OUTSIDE))))

;; (plan 'sue '((at ann inside)))

;; This gives us:
;; (REQUEST SUE ALAN (REQUEST ALAN ANN (MOVE ANN OUTSIDE INSIDE))) ...
;;

;; Questions: how to get "Ask Ann to come inside."
(def-test r2
  "Ask Ann to come inside."
  ((cat clause)
   (mood imperative)
   (proc ((lex "ask") (type lexical)
	  (subcat ((1 {^3 lex-roles asker})
		   (2 {^3 lex-roles askee})
		   (3 {^3 lex-roles question})
		   (1 ((cat np)))
		   (2 ((cat np)))
		   (3 ((cat clause) (mood to-infinitive)))))))
   (lex-roles
    ((asker ((cat trivial-proper) (lex "Alan") (index ((name alan)))))
     (askee ((cat trivial-proper) (lex "Ann") (index ((name ann)))))
     (question ((cat clause)
		(proc ((type material) (lex "come") (effective no)))
		(controlled {^ partic agent})
		(partic ((agent ((index ((name ann)))))))
		(pred-modif ((destination ((cat adv) 
					   (lex "inside")))))))))))

How do we map from input to output?

1. We use a different cset to control recursion. This allows the lexical chooser to indicate for each node how to go down to the next level. Use the lex-cset feature for this.
2. We assume the syntactic input can be built compositionally from the semantic input. More on this assumption later.
3. To start, we will only consider one-on-one mappings.
4. Even simpler, we will consider mappings of leaves first: entities onto NPs.

((here-now ((speaker entity) (addressee entity) (location entity))))

(defun lexicalize (semr &key (trace :current) (here-now nil))
  (cond ((eq trace :full) (trace-on) (trace-enable-all (lex)))
	((eq trace t) (trace-on) (trace-disable-all (lex))))
  (filter-flags (uni-fd (append semr
				`((here-now ,here-now)))
			:grammar (lex)
			:limit 2000
			:cset-attribute 'lex-cset
			:cat-attribute 'lex-cat)))


(defun say (semr &key (trace-lex :current) (trace-gr :current) here-now)
  (let ((fd (lexicalize (plan-to-fd semr) 
			:trace trace-lex :here-now here-now)))
    (pprint fd)
    (terpri)
    (cond ((eq fd :fail) fd)
	  (t 
	   (cond ((eq trace-gr :full) (trace-on) (trace-enable-all (gr)))
		 ((eq trace-gr t) (trace-on) (trace-disable-all (gr)))
		 (t (trace-off)))
	   (uni fd 
		:grammar (gr)
		:limit 2000
		:cset-attribute 'cset
		:cat-attribute 'cat)))))

This only illustrates compositionality: build the syntactic structure by traversing top-down the semantic tree and relying on each semantic head to direct us downward (sort of semantic-head driven generation).

(def-grammar lex ()
  (trace-bp)                       ;; Set trace level as desired
  (setf *any-at-unification* nil)  ;; make sure any is active
  (clear-bk-class)                 ;; Reset all bk-class definitions
  (reset-typed-features)           ;; Reset all type definitions
  (reset-surge-types)              ;; Use surge's types

  ;; Define the lex-cset attribute
  (define-procedural-type 'lex-cset 'unify-cset :syntax 'check-cset)

  ;; Any type definitions
  ;; (define-feature-type parent (child1 ...))

  ;; Any bk-class specifications needed
  ;; (define-bk-class path-spec class)

  '((alt top-lex (:demo "lexicalize") (:index cat)
      (
       ;; i. toplevel constituents:
       ;; -------------------------
       ;; i.1 clause
       ;; i.2 np

       ((cat clause)
	(semr ((pred given)))
	(:! lex-clause))

       ((cat np)
	(semr ((name given)))
	(:! lex-np))

       ((cat adv)
	(semr ((name given)))
	(:! lex-adv))))))

	       

(def-alt lex-clause (:index (semr pred))
  (((semr ((pred move)))
    ;; In all cases proc is a material / effective no
    ;; and agent is mapped to the semr/agent
    (proc ((type material) (effective no)))
    (partic ((agent ((semr {^3 semr args agent})))))
    ;; First approx: no indexicality MOVE --> AGENT MOVE FROM TO
    (proc ((lex "move")))
    (pred-modif ((destination ((cat pp) (np ((semr {^4 semr args to})))))
		 (origin ((cat pp) (np ((semr {^4 semr args from})))))))
    (lex-cset ({^ pred-modif destination np} {^ pred-modif origin np}
	       {^ partic agent})))
   
   ((semr ((pred request)))
    (proc ((type lexical) (lex "ask")
	   (subcat ((1 {^3 lex-roles asker})
		    (2 {^3 lex-roles askee})
		    (3 {^3 lex-roles question})
		    (1 ((cat np)))
		    (2 ((cat np)))
		    (3 ((cat clause) (mood to-infinitive)))))))
    (lex-roles ((asker ((semr {^3 semr args asker})))
		(askee ((semr {^3 semr args askee})))
		(question ((semr {^3 semr args action})))))
    (lex-cset ({^ lex-roles asker} {^ lex-roles askee} 
               {^ lex-roles question})))))



(def-alt lex-np (:index (semr name))
  (((semr ((name alan)))
    (cat trivial-proper)
    (lex "Alan"))
   ((semr ((name sue)))
    (cat trivial-proper)
    (lex "Sue"))
   ((semr ((name ann)))
    (cat trivial-proper)
    (lex "Ann")) 
   ((semr ((name inside)))
    (lex "inside"))
   ((semr ((name outside)))
    (lex "outside"))
   ((semr ((name combination)))
    (cat common)
    (definite yes)
    (lex "combination"))))


(def-alt lex-adv (:index (semr name))
  (((semr ((name inside)))
    (lex "inside"))
   ((semr ((name outside)))
    (lex "outside"))))

VERSION 2: With indexicality, no speech-act analysis

(def-alt lex-clause (:index (semr pred))
  (((semr ((pred move)))
    ;; In all cases proc is a material / effective no
    ;; and agent is mapped to the semr/agent
    (proc ((type material) (effective no)))
    (partic ((agent ((semr {^3 semr args agent})))))
    ;; indexicality alternation: where is the speaker? {here-now location}
    (alt go-come
      ((({here-now location} given)
	(semr ((args ((to {here-now location})))))
	(proc ((lex "come")))
	;; Question: when can the FROM argument be omitted?
	(pred-modif ((origin ((cat pp) (np ((semr {^4 semr args from})))))))
	(lex-cset ({^ pred-modif origin np} {^ partic agent})))
       (({here-now location} given)
	(semr ((args ((from {here-now location})))))
	(proc ((lex "go")))
	(pred-modif 
	 ((destination ((cat pp) (np ((semr {^4 semr args to})))))))
	(lex-cset ({^ pred-modif destination np} {^ partic agent})))
       ;; Catch-all: AGENT GO FROM TO
       ((proc ((lex "go")))
	(pred-modif 
	 ((destination ((cat pp) (np ((semr {^4 semr args to})))))
	  (origin ((cat pp) (np ((semr {^4 semr args from})))))))
	(lex-cset ({^ pred-modif destination np} {^ pred-modif origin np}
		   {^ partic agent}))))))
	
   ((semr ((pred request)))
    (proc ((type lexical) (lex "ask")
	   (subcat ((1 {^3 lex-roles asker})
		    (2 {^3 lex-roles askee})
		    (3 {^3 lex-roles question})
		    (1 ((cat np)))
		    (2 ((cat np)))
		    (3 ((cat clause) (mood to-infinitive)))))))
    (lex-roles ((asker ((semr {^3 semr args asker})))
		(askee ((semr {^3 semr args askee})))
		(question ((semr {^3 semr args action})))))
    (lex-cset ({^ lex-roles asker} {^ lex-roles askee} 
               {^ lex-roles question})))))



;; INDEXICALITY: I/YOU/rest
(def-alt lex-np (:index (semr name))
  ((({here-now speaker} given)
    (semr {here-now speaker})
    (cat personal-pronoun)
    (person first)
    (number singular))
   (({here-now addressee} given)
    (semr {here-now addressee})
    (cat personal-pronoun)
    (person second)
    (number singular))
   ((semr ((name alan)))
    (cat trivial-proper)
    (lex "Alan"))
   ((semr ((name sue)))
    (cat trivial-proper)
    (lex "Sue"))
   ((semr ((name ann)))
    (cat trivial-proper)
    (lex "Ann")) 
   ((semr ((name inside)))
    (lex "inside"))
   ((semr ((name outside)))
    (lex "outside"))
   ((semr ((name combination)))
    (cat common)
    (definite yes)
    (lex "combination"))))

;; By playing on the here-now argument, generate from the same PC the
;; following variations:
;; I come from inside.
;; I go outside.
;; I go from inside to outside.
;; You come.
;; You go outside.
;; Alan goes outside.
;; Alan comes.
;; 
;; (say '(move alan inside outside) 
;;     :here-now '((speaker ((name alan)))
;;                 (location ((name inside)))))

VERSION 3: With indexicality and speech-act analysis

(request sue alan (request alan ann (inform_ref ann alan combination)))

• Ask Ann what is the combination. [S=sue A=alan]
• I ask Alan to ask Ann what is the combination.
• Sue asks me to ask Ann what is the combination [S=alan]
• Sue asks me to ask you what is the combination [S=alan A=ann]

(request alan ann (inform_ref ann alan combination))

• What is the combination? [S=alan, A=ann]
• I ask Ann what is the combination. [S=alan]
• Alan asks me what is the combination. [S=ann]
• You ask me what is the combination. [S=ann A=alan]

• Sue asks me to ask you what is the combination [S=alan A=ann]
• What is the combination? [S=alan, A=ann]

(def-alt lex-clause (:index (semr pred))
  (((semr ((pred move)))
    ;; In all cases proc is a material / effective no
    ;; and agent is mapped to the semr/agent
    (proc ((type material) (effective no)))
    (partic ((agent ((semr {^3 semr args agent})))))
    ;; indexicality alternation: where is the speaker? {here-now location}
    (alt go-come
      ((({here-now location} given)
	(semr ((args ((to {here-now location})))))
	(proc ((lex "come")))
	;; Question: when can the FROM argument be omitted?
	(pred-modif ((origin ((cat pp) (np ((semr {^4 semr args from})))))))
	(lex-cset ({^ pred-modif origin np} {^ partic agent})))
       (({here-now location} given)
	(semr ((args ((from {here-now location})))))
	(proc ((lex "go")))
	(pred-modif 
	 ((destination ((cat pp) (np ((semr {^4 semr args to})))))))
	(lex-cset ({^ pred-modif destination np} {^ partic agent})))
       ;; Catch-all: AGENT GO FROM TO
       ((proc ((lex "go")))
	(pred-modif 
	 ((destination ((cat pp) (np ((semr {^4 semr args to})))))
	  (origin ((cat pp) (np ((semr {^4 semr args from})))))))
	(lex-cset ({^ pred-modif destination np} {^ pred-modif origin np}
		   {^ partic agent}))))))
	
   ((semr ((pred request)))
    (alt (((lex-embedded none)
	   ({here-now speaker} given)
	   ({here-now addressee} given)
	   (semr ((args ((asker {here-now speaker})
			 (askee {here-now addressee})))))
	   ;; RECURSE ON THE ACTION ELEMENT:
	   (c ((cat clause)
	       (semr {^2 semr args action})))
	   (lex-cset ({^ c}))
	   (cset ((- {^ c})))
	   (mood imperative)
	   (proc {^ c proc})
	   (alt (:index (proc type))
	     (((proc ((type simple-process)))
	       (partic {^ c partic}))
	      ((proc ((type composite)))
	       (partic {^ c partic}))
	      ((proc ((type lexical)))
	       (lex-roles {^ c lex-roles}))))
	   (pred-modif {^ c pred-modif})
	   (circum {^ c circum}))

	  ;; CATCH ALL
	  ((proc ((type lexical) (lex "ask")
		  (subcat ((1 {^3 lex-roles asker})
			   (2 {^3 lex-roles askee})
			   (3 {^3 lex-roles question})
			   (1 ((cat np)))
			   (2 ((cat np)))
			   (3 ((cat clause) (mood to-infinitive)))))))
	   (lex-roles ((asker ((semr {^3 semr args asker})))
		       (askee ((semr {^3 semr args askee})))
		       (question ((lex-embedded yes) 
				  (semr {^3 semr args action})))))
	   (lex-cset ({^ lex-roles asker} {^ lex-roles askee} 
			 {^ lex-roles question}))))))))



;; By playing on the here-now argument, generate from the same PC the
;; following:
;; Ask Ann to come.
;; Ask Ann to go.
;; Sue asks me to ask you to come.
;; 
;; (say '(request sue alan (request alan ann (move ann inside outside)))
;;     :here-now '((speaker ((name alan)))
;;                 (location ((name inside)))))

VERSION 4: With variation of mood depending on value of pred

1. Come.
2. What is the combination?
3. Sue asks Ann what is the combination.
4. Sue asks Ann to come.

(request a b action)
(request a b inform_ref)
;; Partial interrogatives:
(inform_ref ann alan (color box blue))

VERSION 5: Start with NP planning - not yet recoverability

;; (inform sue ann (and (color box1 blue) (location box1 inside)))
;; -->
;; The blue box is inside.
;; The box that is inside is blue.
;;
;; (and (color box1 blue) (location box1 inside)) -->
;; (semr ((pred and)
;;        (shared {semr 1 args object})
;;        (1 ((pred color)
;;            (args ((object ((name box1)))
;;                   (color ((name blue)))))))
;;        (2 ((pred location)
;;            (args ((located {semr shared})
;;  		     (location ((name inside)))))))))

#+ignore(def-alt lex-clause (:index (semr pred))
  (((semr ((pred and)))
    ;; Do a modifier?  
    ;; Is there a shared argument?
    ;; Which of 1 and 2 is the head?
    (alt and-relative (:index (semr shared))
	 (((semr ((shared given)))
	   ;; Create a new constituent with transformed semr
	   
	   )
	  ((semr ((shared none)))
	   (complex conjunction)
	   (distinct ((car ((semr {^3 semr 1})))
		      (cdr ((car ((semr {^4 semr 2})))
			    (cdr none)))))
	   (lex-cset ({^ distinct car} {^ distinct cdr car}))))))

   ;; ... other predicates ...

   ))

VERSION 6: Floating constituents