ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/AI_OCT86.ZIP/EXPERT1.LTG

Text File | 1986-10-30 | 5.2 KB | 223 lines

Listing 1.
A sample ATN.



(DEFNODE S  ; sentence
 (PUSH NP T S-VP
       (SETR SUBJ *VALUE*)))

(DEFNODE S-VP
 (PUSH VP T S-END
       (SETR PRED *VALUE*)))

(DEFNODE S-END
 (POP (S-VALUE (GETR SUBJ) (GETR PRED)) T))

;;;;;

(DEFNODE NP  ; noun phrase
 (WRD WHO T NP-REL-OR-PP  ; If the NP starts with "who",
      (SETR HEAD 'EMPLOYEES))  ; the subject must be employees.
 (CAT WH T NP-HEAD)  ; e.g. what, which
 (CAT QUANT T NP-HEAD)  ; e.g. all
 (JUMP NP-NUM T))


(DEFNODE NP-NUM
 (TEST (NUMBERP *WORD*) NP-HEAD
       (SETR NUMBER *WORD*))
 (JUMP NP-HEAD T))

(DEFNODE NP-HEAD  ; "head" of NP; i.e., main noun
 (CAT N T NP-REL-OR-PP
      (SETR HEAD *WORD*))
 (TEST (OR (IS-EMPLOYEE *WORD*) (IS-DEPARTMENT *WORD*)) NP-REL-OR-PP
       (SETR HEAD *WORD*)))

(DEFNODE NP-REL-OR-PP  ; relative clause, pp, or compar. cl.
 (PUSH REL-CLAUSE T NP-END
       (SETR MODIFIERS *VALUE*))
 (PUSH PP T NP-END
       (SETR MODIFIERS *VALUE*))
 (PUSH COMPAR-CLAUSE T NP-END
       (SETR MODIFIERS *VALUE*))
 (JUMP NP-END T))

(DEFNODE NP-END
 (POP (NP-VALUE (GETR HEAD) (GETR NUMBER) (GETR MODIFIERS)) T))

;;;;;

(DEFNODE REL-CLAUSE  ; relative clause
 (CAT POSS-COMP T RC-POSS)  ; e.g. whose
 (CAT COMP T RC-COMP))  ; e.g. who, that

(DEFNODE RC-POSS  ; possessive relative clause
 (PUSH S T RC-END
       (SETR VAL *VALUE*)))

(DEFNODE RC-COMP
 (PUSH VP T RC-END
       (SETR VAL *VALUE*)))

(DEFNODE RC-END
 (POP (RC-VALUE (GETR VAL)) T))

;;;;;

(DEFNODE PP  ; prepositional phrase
 (CAT PREP T PP-HEAD
      (SETR PREP (GET *WORD* 'TRANS))))


(DEFNODE PP-HEAD
 (PUSH NP T PP-END
       (SETR HEAD *VALUE*))
 (PUSH COMPAR-CLAUSE T PP-END
       (SETR COMP *VALUE*)))

(DEFNODE PP-END
 (POP (PP-VALUE (GETR PREP) (GETR HEAD) (GETR COMP)) T))

;;;;;

(DEFNODE COMPAR-CLAUSE  ; comparative clause
 (CAT COMPAR-TO T CC-TO
      (SETR COMP (GET *WORD* 'TRANS)))
 (CAT COMPAR-THAN T CC-THAN
      (SETR COMP (GET *WORD* 'TRANS)))
 (CAT COMPAR T CC-HEAD
      (SETR COMP (GET *WORD* 'TRANS))))

(DEFNODE CC-TO
 (WRD TO T CC-HEAD))

(DEFNODE CC-THAN
 (WRD THAN T CC-HEAD))

(DEFNODE CC-HEAD
 (PUSH NP T CC-END
       (SETR HEAD *VALUE*)))

(DEFNODE CC-END
 (POP (CC-VALUE (GETR COMP) (GETR HEAD)) T))

;;;;;

(DEFNODE VP  ; verb phrase
 (CAT V T VP-V
      (SETR VERB *WORD*)))

(DEFNODE VP-V
 (PUSH NP T VP-END  ; For transitive verbs
       (SETR OBJ *VALUE*))
 (JUMP VP-PP T))  ; For instransitive verbs

(DEFNODE VP-PP
 (PUSH PP T VP-END
       (SETR PP *VALUE*))
 (PUSH COMPAR-CLAUSE T VP-END
       (SETR PP *VALUE*))
 (JUMP VP-END T))

(DEFNODE VP-END
 (POP (VP-VALUE (GETR VERB) (GETR OBJ) (GETR PP)) T))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Auxiliary functions.

(SETQ *EMPLOYEES* '(JONES SMITH))
(SETQ *DEPARTMENTS* '(SALES PR))

(DEFUN IS-EMPLOYEE (WORD)  ; These functions are used in TEST
  (MEMBER WORD *EMPLOYEES*))  ; arcs, rather than make EMPLOYEE
  ; and DEPARTMENT separate grammatical
(DEFUN IS-DEPARTMENT (WORD)  ; categories!
  (MEMBER WORD *DEPARTMENTS*))

;;; The following routines try to construct a structure based on the
;;; meaning of the input sentence.

(DEFUN VP-VALUE (VERB OBJ PP)
  ;; Try to put together a reasonable structure based on the main verb.
  (CASE VERB
    ((MAKE MAKES)  ; salary question
     `(WITH SALARY (,(FIRST PP) ,(SECOND PP))))
    ((WORK WORKS)  ; in which department
     `(WITH DEPARTMENT ,(SECOND PP)))
    ((HAVE HAS ARE IS)  ; dummies
     (IF OBJ
 (LIST 'WITH OBJ)
 PP))
    (OTHERWISE
     (LIST VERB OBJ PP))))

(DEFUN NP-VALUE (HEAD NUMBER MODIFIERS)
  (LET ((MODIFIERS (IF NUMBER
       (CONS `(NUMBER ,NUMBER) MODIFIERS)
       MODIFIERS)))
    (IF MODIFIERS
(CONS HEAD MODIFIERS)
HEAD)))

(DEFUN S-VALUE (SUBJ PRED)
  (COND
    ((NULL SUBJ)
     PRED)
    ((SYMBOLP SUBJ)
     (LIST SUBJ PRED))
    (T
     (CONS (CAR SUBJ) (APPEND (CDR SUBJ) (LIST PRED))))))

(DEFUN RC-VALUE (VAL)
  (IF (NOT (EQ (CAR VAL) 'WITH))
      (LIST 'WITH VAL)
      VAL))

(DEFUN CC-VALUE (COMP HEAD)
  (LIST COMP HEAD))

(DEFUN PP-VALUE (PREP HEAD COMP)
  (IF (NULL HEAD)
      (LIST PREP COMP)
      (LIST PREP HEAD)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Words.  The "trans" property is used in some cases to translate
;;; words into a standard vocabulary.

(WORD ALL (CAT QUANT))
(WORD EMPLOYEE (CAT N))
(WORD EMPLOYEES (CAT N))
(WORD DEPARTMENT (CAT N))
(WORD DEPARTMENTS (CAT N))
(WORD SALARY (CAT N))
(WORD SALARIES (CAT N))
(WORD DOLLARS (CAT N))
(WORD WHOSE (CAT POSS-COMP))
(WORD LESS (CAT COMPAR-THAN)  (TRANS LESS-THAN))
(WORD FEWER (CAT COMPAR-THAN) (TRANS LESS-THAN))
(WORD MORE (CAT COMPAR-THAN)  (TRANS GREATER-THAN))
(WORD EQUAL (CAT COMPAR-TO)   (TRANS EQUAL-TO))
(WORD OVER (CAT COMPAR)       (TRANS GREATER-THAN))
(WORD UNDER (CAT COMPAR)      (TRANS LESS-THAN))
(WORD WHICH (CAT WH))
(WORD WHAT (CAT WH))
(WORD HAS (CAT V))
(WORD HAVE (CAT V))
(WORD IS (CAT V))
(WORD ARE (CAT V))
(WORD MAKE (CAT V))
(WORD MAKES (CAT V))
(WORD WORK (CAT V))
(WORD WORKS (CAT V))
(WORD WHO (CAT COMP))
(WORD THAT (CAT COMP))
(WORD IN (CAT PREP)    (TRANS IN))
(WORD WITH (CAT PREP)  (TRANS WITH))