;;;; created 3/31/2004 by clbecker ;;;; last modified 4/16/2004 by clbecker ;;;; ;;;; ;;;; this file contains the output functions for the verb ;;;; algorithm. ;;;; ;;;; The primary purpose of these functions is to print the ;;;; data found in an easily readable format. ;;;; ;;;; ;;;; ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; ;;;; ;;;; Modification History ;;;; ;;;; 4/2/2004 ;;;; Added more comments ;;;; ;;;; ;;;; 4/16/2004 ;;;; Modified output format slightly to include ;;;; extras newlines between each set of outputted data. ;;;; This makes it more readable. ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;------------------------------------------- ;;; ;;; function: outputFoundList ;;; ;;; arguments: ;;; optional: ;;; flist ;;; by default it is set to *Found-List* ;;; ;;; ;;; This function prints out the elements of the *Found-List* that ;;; are not nil ;;; ;;;------------------------------------------- (defun outputFoundList (&optional (flist *Found-List*)) "iterate though double association list, flist and print the items found. " (format t "~2% * * * Basic Findings * * * ~1%") ;; go through misc list ;; ;; as of now this includes things like ;; synonym, cause, effect... (loop for misc in *MiscList* do (when (not (null (cadr (assoc misc *Found-List*)))) (format t "~2% possible ~A of ~A is: " ;;example output: "possible synonym of verb" misc verb ) ; end format ;; list items found following the above phrase (loop for element in (cadr (assoc misc *Found-List*)) do (format t "~% ~T ~T ~T ~A, " element) ) ;end loop ) ; end when ) ; end loop ;; go through arguments (loop for arg in *ArgsFound* do (when (not (null (second arg))) (format t"~%") (loop for rel in *RelsList* do (when (not (null (second (assoc rel (cadr (assoc (first arg) *Found-List*)))) )) ; end not equal (format t "~2% possible ~A of ~A is: " ;;example output: "possible superclass of agent" rel (first arg) ) ; end format ;; list items found following the above phrase (loop for element in (second (assoc rel (cadr (assoc (first arg) *Found-List*)))) do (format t "~% ~T ~T ~T ~A, " element) ) ;end loop ) ; end if ) ; end loop for rel ) ; end when ) ; end loop for arg ) ; end of function outputFoundList ;;;------------------------------------------- ;;; ;;; Function: Generate-Generalizations ;;; ;;; Arguments: ;;; flist (set to *Found-List* by default) ;;; ;;; argflist (set to *ArgsFound* by default) ;;; ;;; Calls: recursive-Print ;;; ;;; ;;; This function prints out sentences generalizing for ;;; all combinations of the information gathered for ;;; each argument of the verb. ;;; ;;; ;;; example output: ;;; A {windstorm, typhoon} can cripple ;;; A {port, seaport, area, city} ;;; ;;; A {windstorm, typhoon} can cripple ;;; Something with the properties {municipal, large} ;;; ;;; ;;;------------------------------------------- (defun generate-Generalizations (&optional (flist *Found-List*) (argflist *ArgsFound*)) "Iterates through all relations found for the agent, then calls the function recursive-Print to recurse through each argument that may follow." ;; these association lists are used to insert canned phrases ;; for each of the relations and arguments to be ;; combined in the output sentence. (setf tempOutputs (list '(superclass " Something that is a subclass of ") '(membership " A ") '(property " Something with the properties ") '(superordinate " A ") )) (setf tempPrep (list '(object "") '(indobj "") '(instrument " with ") '(to " to ") '(from " from ") )) (format t "~2% * * * generalizations from this context * * * ~1%") ;; begin loop (loop for agent-rel in (cadr (assoc 'agent flist)) do (when (not (null (cadr agent-rel))) (setf OutString (concatenate 'string ;; 1. print canned phrase. ;; if there is no canned phrase for the given ;; relation, use the 'other' phrase. (if (not (null (assoc (first agent-rel) tempOutputs))) (second (assoc (first agent-rel) tempOutputs)) (second (assoc 'other tempOutputs)) ) ; end if ;; nodes found are enclosed in brackets "{" ;; 2. value of nodes found (string-right-trim ", " ; remove trailing comma ;; combine two halves of the command to evaluate ;; and then evaluate it. (eval (append '(concatenate 'string ) ;; concatenate all elements of the list: (second agent-rel) ;; to separate strings. (mapcar #'(lambda (x) (concatenate 'string (string x) ", ")) ;; Turn this list into a string. ;; but first, it needs to convert each element ;; of the list from sneps node to lisp ;; object (otherwise we get a type error) (mapcar #'(lambda (x) (node-to-lisp-object x)) (second agent-rel)) ) )) ; end eval; end append ) ; end string trim ;; close brackets, insert modal 'can' in front of verb "} can " ;; 3. the unknown verb, converted from symbol to string (string verb) )) ; end setf OutString ; end concatenate ;; recursively construct the parts of sentences ;; generalizing on each argument of the verb. (recursive-Print (nthcdr 3 argflist) OutString) ); end when ) ; end loop ); end generate-Generalizations ;;;------------------------------------------- ;;; ;;; Function: recursive-Print ;;; ;;; Arguments: ;;; args an association list containing names for each of the ;;; verb's arguments as the key, and the nodes found for each ;;; as the rest. ;;; example: ((verb (m107)) (act (m111)) (agent (m39)) ...) ;;; ;;; optional: ;;; str the output string to be printed, thus far ;;; example: "A {human} can verb " ;;; ;;; arg the first list in args ;;; example: (object (b1 m2)) ;;; ;;; Called by: generate-Generalizations ;;; ;;; example output: ;;; A {windstorm, typhoon} can cripple ;;; A {port, seaport, area, city} ;;; ;;; A {windstorm, typhoon} can cripple ;;; Something with the properties {municipal, large} ;;; ;;;------------------------------------------- (defun recursive-Print (args &optional str (arg (first args))) "This function recurses through the rest of the arguments of the verb, after agent in the Arglist. It generates each of the output sentences for each combination of relations that were found for each argument." (cond ;; condition[1]: if args is empty, then print the string str ((null args) (format t "~2% ~A" str)) ;; condition[2]: if the first list in args is empty ;; example: ((indobj nil) (from (m1)) (to (m24)) ...) ;; then call recursive-Print on the rest of the list args ((null (first (cadr arg))) (recursive-Print (rest args) str)) ;; condition[3]: in all other cases, loop through each relation ;; e.g. superclass, membership, properties, ;; and construct a portion of the output sentence for each. ;; call recursive-Print with the rest of args and (string + new string) ;; as arguments. (t (loop for rel in *RelsList* do ;; if relation list is not empty, continue. (when (not (null (second (assoc rel (cadr (assoc (first arg) *Found-List*)))) )) ; end not ; end null ;; combine the string thus far with ;; the elements of the new string concatenated here. (recursive-Print (rest args) (concatenate 'string str ;;insert a newline + tab, this keeps the output looking nicer. ;; note: replacing the below bit with "~1% ~T" does not work ;; since this string is being concatenated. " " ;;4. preposition - specifier of the phrase ;; this is from the tempPrep list (cadr (assoc (first arg) tempPrep)) ;;5. canned phrase: (second (assoc rel tempOutputs)) ;;6. convert nodes found to strings, and enclose in brackets "{" (string-right-trim ", " ;; combine two halves of the command to evaluate ;; and then evaluate it. (eval (append '(concatenate 'string ) ;;concatenate all elements of the list below to a string (mapcar #'(lambda (x) (concatenate 'string (string x) ", " )) ;; Turn this list into a string. ;; but first, it needs to convert each element ;; of the list from sneps node to lisp ;; object (otherwise we get a type error) (mapcar #'(lambda (x) (node-to-lisp-object x)) (second (assoc rel (cadr (assoc (first arg) *Found-List*)))) ) ; end mapcar ) ; end mapcar )) ; end eval append ) ; end string trim ;; close brackets surrounding node name(s) "} " ); end concatenation );end call to recursive-Print ) ; end when ) ; end loop ) ; end condition[3] ); end cond ) ; end function recursive-Print