;;Created by Justin Del Vecchio

;;Additions made by Chris Becker
;;(all additions are clearly marked.  No original code was altered)


(in-package :snepsul)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;
;;       METHODS THAT DEFINE STRUCTURES USED IN VERB ALGORITHM
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defstruct predicatePools
  "Holder for the pools of objects, indobj, agents and everything else (possibly)."
  agents
  objects
  indirectObjects
;;;;;;;;;;;;;;;;;;;;;;;;-CLB
  instruments
;;;;;;;;;;;;;;;;;;;;;;;;
)

(defstruct subclassToSuperclassMatrixElement
  "Holds a superclass and all subclasses that recognize it as a superclass"
  superclass
  recognizingAgentActPredicateBase
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A structure to hold each individual instance of the verb as it exists in the network
;; with respect to its aspects the algorithm is interested in.  Each instance will have
;; one structure representing it. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; todo: make methods that will initialize each and everyone of these variables
(defstruct verbInstance
  "An instance of the verb in question that exists in the network.  The structure contains all the information the verb algorithm determines to be of importance."
  snepsNode ;; the node loacted in the network
  predicateType ;; whether it is transitive, intransitive, etc.
  agent 
  agentHierarchyList
  act
  object
  indirectObject
;;;;;;;;;;;;;;;;;;;;;;;;-CLB
objectType
indirectObjectType
 instrument
InstrumentType
enabledBy
synonym
;;;;;;;;;;;;;;;;;;;;;;;;
  prepositionList ;; a list of prepositions that may (or may not) be in the sentence
  superclassHierarchy ;; who are the parents of the verb? 
  effects  ;; what happens when this verb takes place in the world in general
  consequences  ;; what is the consequence of the verb in the form of a rule ("If x
  ;; hits y, then y falls to the ground (maybe)"
)










;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;
;;       METHODS THAT INSTANTIATE STRUCTURES
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun instantiateInstances (nodeList nodeType)
  "Categorize the instances.  This requires building a structure that contains all the useful information."
 (dolist (nodeInstance nodeList)
   (setf temp (cons(make-verbInstance
		    		      : snepsNode nodeInstance 
				      : predicateType nodeType
		  		      : agent (findAgent nodeInstance)
				      : act verb
				      : object (findObject nodeInstance)
				      : indirectObject (findIndirectObject nodeInstance)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
				      : objectType (findObjectType nodeInstance)
				      : indirectObjectType (findIndirectObjectType nodeInstance)
				      : instrument (findInstrument nodeInstance)
			              : InstrumentType (findInstrumentType nodeInstance)
				      : enabledBy (findEnabler nodeInstance)
				      : synonym(findSynonym nodeInstance)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
				      : agentHierarchyList nil
					;;: prepositionList (findAttachedPrepositions bitransitiveNodeInstance)
				      : superclassHierarchy (findVerbsParentClass nodeInstance)
				      : effects (findEffects nodeInstance)
				      : consequences (findConsequences nodeInstance)
				      ) verbInstances) verbInstances temp)
 ) ;; end of do list
)





(defun instantiatePredicatePools
    "Find the pools of agents, objects and indirect objects."
  (make-predicatePools : agents  		       
		       (union (first (list #3!(( find (class- member agent- act action lex) ~verb  ))  ))
			      ;; terrible assumption that a rel "isa" exists!!! Same for the rest
			      (first (list #3!(( find (object2- object1  agent- act action lex) ~verb  ))  )) )
		       
		       : objects
		       (union (first (list #3!(( find (class- member object- action lex) ~verb  ))  )) 
			      (first (list #3!(( find (object2- object1 object- action lex) ~verb  ))  )) )
		       
		       : indirectObjects
		       (union (first (list #3!(( find (class- member indobj- action lex) ~verb  ))  ))
			      (first (list #3!(( find (object2- object1 indobj- action lex) ~verb  ))  ))
			      )

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
		       : instruments
		       (union (first (list #3!(( find (class- member instrument- action lex) ~verb  ))  ))
			      (first (list #3!(( find (object2- object1 instrument- action lex) ~verb  ))  ))
			      )

		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		       
	)  
    )










;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;
;;      DRIVER FOR ENTIRE ALGORTIHM
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A simplisitic parser that will categorize the network into lists that we may work with.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun defineVerb (verbToDefine traceLevel) 
  "The entry point to the entire verb algorithm."
 (setf instrumentList nil) ;;;;;;;;; -CLB
 (setTraceLevel traceLevel)
  (categorizeBasedOnPredicateStructure verbToDefine)  ;; Get the lists of the ver types 
  (createStructuresToRepresentEachInstanceOfVerb )    ;; Fill out a nice list of instances
  (setf cummulativeLists (orderPredicateTypesByUsage) )
  (setf finalString (introduceTheVerbAlgorithm))
  (setf predicateStringTopDown (printPredicateUnificationTopDown cummulativeLists))
  (setf predicateStringBottomUp (printPredicateUnificationBottomUp cummulativeLists))
  (setf verbUnificationString (printVerbUnificationString))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
(setf verbOutputString (printableVerbOutput))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (test) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf finalString (concatenate 'string finalString verbOutputString))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setf finalString (concatenate 'string finalString verbUnificationString))
  (setf finalString (concatenate 'string finalString predicateStringTopDown))
  (setf finalString (concatenate 'string finalString predicateStringBottomUp))
  (format nil finalString)



)

(defun printVerbUnificationString 
    "Find the superclasses of the verb in question and return them in string format."
  (setf verbSuperclassesString "The verbs superclasses are: ")
  (setf verbNode (first (list #3! ((find (lex ) ~verb )))))
  (setf parentClasses (findVerbsParentClass verbNode))
  
  (cond ((eql parentClasses nil)
	 (setf verbSuperclassesString "No superclasses were found for this verb.")
	 )
	(t 
	 (dolist (class parentClasses)
	   (setf verbSuperclass (first (list #3! ((find lex- ~class)))))
	   (setf name (first verbSuperclass ))
	   (setf name (node-to-lisp-object name))
	   (setf name (symbol-name name))    
	   (setf verbSuperclassesString (concatenate 'string verbSuperclassesString name))
	   (setf verbSuperclassesString (concatenate 'string verbSuperclassesString " : "))
	   )	 
	 )
	)
  (setf verbSuperclassesString (concatenate 'string verbSuperclassesString " ~2% "))
  verbSuperclassesString
  )



















;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;
;;       THE EDUCTION ENGINE
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun printPredicateUnificationBottomUp (rankedPredicates)
   "We have a ranking of predicate occurences.  Based on this ranking print information about the predicate cases based on unification."
  (setf outputString "Now, looking from the bottom up I want to get a sense of the categories that most of the agents, objects and indirect objects belong to.  This is different from looking for the most unified case.  Instead I am looking for the classes that contain approximately half of the agents, objects and indirect objects.  This is an attempt at generalization but from another approach. ~2%")
  ;;@todo creating duplicate lists here!  The code needs some refactoring  Some of these lists are 
  ;; duped in printPredicateUnificationTopDown
  (dolist (rankedPredicate rankedPredicates) 
    
    (setf bottomUpMostCommonAgent nil)
    (setf cummulativeBottomUpMostCommonObjects nil)
    (setf cummulativeBottomUpMostCommonIndirectObjects nil)
;;;;-CLB
     (setf cummulativeBottomUpMostCommonInstruments nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     
    (dolist (rankedElement rankedPredicate) 
      
      (setf agents (findAgentsForType rankedElement))
      (setf agentsMatrix (createSuperclassToSubclassMatrix agents))
      (setf bottomUpMostCommonAgent (findBottomUpDominant agentsMatrix (length agents) ) )
      (dolist (element bottomUpMostCommonAgent)
	(cond ( (or (string= rankedElement "bitransitive") (string= rankedElement "transitive")) 		
		(setf localAgents (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase element))
		(setf objects (translateFromAgentsToObjects localAgents ))
		(setf objectsMatrix (createSuperclassToSubclassMatrix objects))
		(setf topDownMostCommonObjects (findBottomUpDominant objectsMatrix (length objects) ))
		;; What if the topDownMostCommonObjects is nil? Handle that here!
		(cond ((eql topDownMostCommonObjects nil)
		       (setf topDownMostCommonObjects (cons "No class hierarchy was found.  Use a better representation") topDownMostCommonObjects)
		       )
		      )
		(setf cummulativeBottomUpMostCommonObjects (cons
							   topDownMostCommonObjects
							  cummulativeBottomUpMostCommonObjects
							  ))
	      ) ;; case is either transitive or intrasitive 	    
	    );; end of cond

      (cond ((string= rankedElement "bitransitive")
	       ;; Get the agents for the first most unified case
	       (setf localAgents (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase element) ) 
	       (setf indirectObjects (translateFromAgentsToIndirectObjects localAgents ))
	       (setf indirectObjectsMatrix (createSuperclassToSubclassMatrix indirectObjects))
	       (setf topDownMostCommonIndirectObjects (findBottomUpDominant indirectObjectsMatrix (length indirectObjects) ))
	       ;; What if the topDownMostCommonObjects is nil? Handle that here!
	       (cond ((eql topDownMostCommonIndirectObjects nil)
		      (setf topDownMostCommonIndirectObjects (cons "No class hierarchy was found.  Use a better representation") topDownMostCommonIndirectObjects)
		      )
		     )
	       (setf cummulativeBottomUpMostCommonIndirectObjects (cons
							  topDownMostCommonIndirectObjects
							  cummulativeBottomUpMostCommonIndirectObjects
							  ))	       
	     )
	   ) ;; end of cond    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB


(cond ((string= rankedElement "instrument")
	       ;; Get the agents for the first most unified case
	       (setf localAgents (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase element) ) 
	       (setf instruments (translateFromAgentsToInstruments localAgents ))
	       (setf instrumentsMatrix (createSuperclassToSubclassMatrix instruments))
	       (setf topDownMostCommonInstruments (findBottomUpDominant instrumentsMatrix (length instruments) ))
	      
	       (cond ((eql topDownMostCommonInstruments nil)
		     ;; (setf topDownMostCommonInstruments (cons "No class hierarchy was found.  Use a better representation") topDownMostCommonInstruments)
		      )
		     )
	       (setf cummulativeBottomUpMostCommonInstruments (cons
							  topDownMostCommonInstruments
							  cummulativeBottomUpMostCommonInstruments
							  ))	       
	     )
	   ) ;; end of cond   

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 
    (setf outputString (concatenate 'string  outputString (createFormattedString (cons element nil)
										 cummulativeBottomUpMostCommonObjects
										 cummulativeBottomUpMostCommonIndirectObjects
										cummulativeBottomUpMostCommonInstruments)))   
 								;;;;;;;;;;;;;;;;;;-CLB
	       ;; Need to remember to nil out the lists of topDownMostCommonObjects and ;;cummulativeTopDownMostCommonINdirectObjects
	(setf cummulativeBottomUpMostCommonObjects nil)
	(setf cummulativeBottomUpMostCommonIndirectObjects nil)
	;;;;;;;;;;;;;;-CLB
        ;;(setf cummulativeBottomUpMostCommonInstruments nil)
	;;;;;;;;;;;;

	);;end of dolist
      (setf outputString (concatenate 'string outputString "~2%"))
      );; end inner dolist
    ;;(setf outputString (concatenate 'string outputString "~2%"))
    );; end outer dolist  
  outputString  
  )











(defun printPredicateUnificationTopDown (rankedPredicates) 
  "We have a ranking of predicate occurences.  Based on this ranking print information about the predicate cases based on unification."
  (setf outputString "Sorting from the most common predicate case to the least common here is what I know.  I will first attempt to unify the components of the sentences that use the verb giving a generalizaiton based on my background knowledge: ~2%")

  (dolist (rankedPredicate rankedPredicates) 
    
    (setf topDownMostCommonAgent nil)
    (setf cummulativeTopDownMostCommonObjects nil)
    (setf cummulativeTopDownMostCommonIndirectObjects nil)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
    (setf cummulativeTopDownMostCommonInstruments nil)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
    (dolist (rankedElement rankedPredicate) 
      
      (setf agents (findAgentsForType rankedElement))
      (setf agentsMatrix (createSuperclassToSubclassMatrix agents))
      (setf topDownMostCommonAgent (findTopDownDominant agentsMatrix) )
      (dolist (element topDownMostCommonAgent)
	(cond ( (or (string= rankedElement "bitransitive") (string= rankedElement "transitive")) 		
		(setf localAgents (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase element))
		(setf objects (translateFromAgentsToObjects localAgents ))
		(setf objectsMatrix (createSuperclassToSubclassMatrix objects))
		(setf topDownMostCommonObjects (findTopDownDominant objectsMatrix))
		;; What if the topDownMostCommonObjects is nil? Handle that here!
		(cond ((eql topDownMostCommonObjects nil)
		       (setf topDownMostCommonObjects (cons "No class hierarchy was found.  Use a better representation") topDownMostCommonObjects)
		       )
		      )
		(setf cummulativeTopDownMostCommonObjects (cons
							   topDownMostCommonObjects
							  cummulativeTopDownMostCommonObjects
							  ))
	      ) ;; case is either transitive or intrasitive 	    
	    );; end of cond

      (cond ((string= rankedElement "bitransitive")
	       ;; Get the agents for the first most unified case
	       (setf localAgents (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase element) ) 
	       (setf indirectObjects (translateFromAgentsToIndirectObjects localAgents ))
	       (setf indirectObjectsMatrix (createSuperclassToSubclassMatrix indirectObjects))
	       (setf topDownMostCommonIndirectObjects (findTopDownDominant indirectObjectsMatrix))
	       ;; What if the topDownMostCommonObjects is nil? Handle that here!
	       (cond ((eql topDownMostCommonIndirectObjects nil)
		     ;; (setf topDownMostCommonIndirectObjects (cons "No class hierarchy was found.  Use a better representation") topDownMostCommonIndirectObjects)
		      )
		     )
	       (setf cummulativeTopDownMostCommonIndirectObjects (cons
							  topDownMostCommonIndirectObjects
							  cummulativeTopDownMostCommonIndirectObjects
							  ))	       
	     )
	   ) ;; end of cond     

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB

      (cond ((string= rankedElement "instrument")
	       ;; Get the agents for the first most unified case
	       (setf localAgents (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase element) ) 
	       (setf instruments (translateFromAgentsToInstruments localAgents ))

	      ;;(format t "~% INSTRUMENTS: ~A" instruments)

	       (setf instrumentsMatrix (createSuperclassToSubclassMatrix instruments))

	 ;;(format t "~3%     INSTRUMENTS MATRIX: ~A" instrumentsMatrix )
	       (setf topDownMostCommonInstruments (findTopDownDominant instrumentsMatrix))


	;;(format t "~3%     TOP DOWN MOST COMMON INSTRUMENTS: ~A" topDownMostCommonInstruments )


	       (cond ((eql topDownMostCommonInstruments nil)
		     ;; (setf topDownMostCommonInstruments (cons "No class hierarchy was found.  Use a better representation") topDownMostCommonInstruments)
		      )
		     )
	       (setf cummulativeTopDownMostCommonInstruments (cons
							  topDownMostCommonInstruments
							  cummulativeTopDownMostCommonInstruments
							  ))	       
	     )
	   ) ;; end of cond   

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


    (setf outputString (concatenate 'string  outputString (createFormattedString (cons element nil)
										 cummulativeTopDownMostCommonObjects
										 cummulativeTopDownMostCommonIndirectObjects
;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
										 cummulativeTopDownMostCommonInstruments)))    
	       ;; Need to remember to nil out the lists of topDownMostCommonObjects and cummulativeTopDownMostCommonINdirectObjects
	(setf cummulativeTopDownMostCommonObjects nil)
	(setf cummulativeTopDownMostCommonIndirectObjects nil)
;;;;;;;;;;;;;;;;;;;;;CLB
	(setf cummulativeTopDownMostCommonInstruments nil)
;;;;;;;;;;;;;;;;;;;;
	);;end of dolist
      (setf outputString (concatenate 'string outputString "~2%"))
      );; end inner dolist
    ;;(setf outputString (concatenate 'string outputString "~2%"))
    );; end outer dolist  
  outputString
  )

;;;;;;-edit - CLB
(defun createFormattedString (allAgents allObjects allIndirectObjects allInstruments)
  "Based on what is passed in return the appropriate human readable string."
(setf noString "") 
 (setf returnString "")

;;(format t "~%ALLAGENTS: ~A ~%" allAgents ) 
;;(format t "~%ALLOBJECTS: ~A ~%" allObjects ) 
;;(format t "~%ALLINDIRECTOBJECTS: ~A ~%" allIndirectObjects ) 
;;(format t "~%ALLINSTRUMENTS: ~A ~%" allInstruments)

 
  (cond ((eql allAgents nil)
	 (setf returnString "The algorithm has lost the set of most common agents or no such set ever existed.")
	 )
	( t 
	 (dolist (anAgent allAgents)
	   (setf verbString (symbol-name verb))
	   (setf agentName (findHumanReadableName anAgent))
;;;;;;;;;;;;;;;;-CLB
	 
;;;;;;;;;;;;;;;;
	   (setf returnString (concatenate 'string returnString "~1%"))
	   (setf returnString (concatenate 'string "A " agentName))
	
	   (setf returnString (concatenate 'string returnString " can "))
	   (setf returnString (concatenate 'string returnString verbString))
	   
	   (cond ((eql allObjects nil)
		  )
		 (t
		  (setf returnString (concatenate 'string returnString (createHumanReadableNamesForElements allObjects)))
		  (cond ((eql allIndirectObjects nil)
			 )
			(t
			 ;;@todo here we would need to do some evaluation of the preposition
			 (setf returnString (concatenate 'string returnString " to/from"))
			 (setf returnString (concatenate 'string returnString (createHumanReadableNamesForElements allIndirectObjects)))

		   (cond ((eql allInstruments nil)
		  )
		 (t
		  (setf returnString (concatenate 'string returnString " using"))
		  (setf returnString (concatenate 'string returnString (createHumanReadableNamesForElements allInstruments)))
				  )
		 );; end cond			 

		        )
		   );;end cond
		  )
		 );; end cond


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;added by -CLB, 4/13/2003
;;	   (cond ((eql allInstruments nil)
;;		  )
;;		 (t
;;		  (setf returnString (concatenate 'string returnString " using"))
;;		  (setf returnString (concatenate 'string returnString (createHumanReadableNamesForElements allInstruments)))
;;				  )
;;		 );; end cond
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	   
	   ) ;; end of dolist
	 )
	)

(concatenate 'string returnString ".~%")

)

(defun createHumanReadableNamesForElements (allElements)
    "Based on the set of elements passed in, find the human readable names and simply return them."
    (setf localizedString "")
    (setf firstTimeThru t)
    (setf objName nil)
    (dolist (element (first allElements) )
      ;;(setf element (first element))
      (setf objName (findHumanReadableName element))
      (cond (firstTimeThru
	     (setf firstTimeThru nil)
	     (setf localizedString (concatenate 'string " a " objName))
	     )
	    (t
	     (setf commaAndName (concatenate 'string ", " objName))
	     (setf localizedString (concatenate 'string localizedString commaAndName))
	     )       
       )
      ) ;; end of dolist
    localizedString
    )

(defun findHumanReadableName (matrixElement) 
  "Based on the input node find the class or sublcass it belongs to.  The hope is that this node indeed belongs to one or the either!"
  (setf name nil)
  (setf localNode (subclassToSuperclassMatrixElement-superclass matrixElement))
  (setf name (union (first (list #3! ((find (lex- class- member) ~localNode )) ))
		    (first (list #3! ((find lex- ~localNode)) ))
		    )
	)
  (cond ((eql name nil)
	 (setf name "There was a component that was not a part of a class or subclass")
	 )
	(t
	 ;;@todo make a utility method, see its usages
	 (setf name (first name ))
	 (setf name (node-to-lisp-object name))
	 (setf name (symbol-name name))
	 )	
	) ;; end of cond
  name
  )


(defun translateFromAgentsToIndirectObjects (agentNodes)
  "Based on a set of nodes pointing to agents frind the complimentary nodes that point to objects in the Agent/Act case frame."
  (setf foundObjects nil)
  (dolist (node agentNodes)
    (setf nodePointingToObject (first (list #3! ((find (agent) ~node )))))
    (setf foundObjects (union 
			(first (list #3! ((find (indobj- act-)~nodePointingToObject )) ))
			foundObjects ) 
	  )
    );;end of dolist
  foundObjects
  )

(defun translateFromAgentsToObjects (agentNodes)
  "Based on a set of nodes pointing to agents frind the complimentary nodes that point to objects in the Agent/Act case frame."
  (setf foundObjects nil)
  (dolist (node agentNodes)
    (setf nodePointingToObject  (first (list #3! ((find (agent) ~node)))))
    (setf foundObjects (union 
			(first (list #3! ((find (object- act-)~nodePointingToObject )) ))
			foundObjects ) 
	  )
    );;end of dolist
  foundObjects
  )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;created 4/12/03 -CLB

(defun translateFromAgentsToInstruments (agentNodes)
  "Based on a set of nodes pointing to agents find the complimentary nodes that point to objects in the Agent/Act/Instrument case frame."
  (setf foundObjects nil)
  (dolist (node agentNodes)
    (setf nodePointingToObject  (first (list #3! ((find (agent) ~node)))))
    (setf foundObjects (union 
			(first (list #3! ((find (instrument- !)~nodePointingToObject )) ))
			foundObjects ) 
	  )
    );;end of dolist
	     ;; (format t "~2%****instrument node*****:~2% ~A ~3%" (first (list #3! ((find (instrument- !)~nodePointingToObject )) )))
  foundObjects
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun findTopDownDominant (matrix)
  "Based on the superclass-to-subclass matrix find the most node in the matrix"
  (setf mostDominantSuperclasses nil)
  (dolist (matrixElement matrix)
    (cond ((eql mostDominantSuperclasses nil)
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses) )
	   ) ;; Case where nothing has been input yet
	  
	  ;; If the incoming has a recognizing predicate base greater than saved one, remove the saved one
	  (( lisp::> (length (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase matrixElement)) 
		     (length (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase (first mostDominantSuperclasses))))
	  ;;@todo whats the difference between nulling this out and consing? 
	   (setf mostDominantSuperclasses nil)
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses))
	   )
	  
	  (( lisp::= (length (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase matrixElement)) 
		     (length (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase (first mostDominantSuperclasses))))
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses))
	   )
     
     ) ;; end cond
   
    );; end dolist
  (setf mostDominantSuperclasses (tidyTopDownSuperclasses mostDominantSuperclasses))
  mostDominantSuperclasses
  )


(defun findBottomUpDominant (matrix listLength)
  "Based on the superclass-to-subclass matrix find the first subclass, from the bottom up, that contains half or more of the particular predicate component manifest in the matrix. THis function makes *lots* of guesstimations and needs some serious reconsideration."
  (setf mostDominantSuperclasses nil)
  ;; Find the ideal median point.  The length of predicateActors array div two
  (setf idealMedianPoint (/ listLength 2) )
  (setf currentMedianPoint -97)
  (dolist (matrixElement matrix)
    (setf possibleMedianPoint (length (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase matrixElement)))
    
    (cond (;;CASE 1 - Nothing added to matrix at all
	   (eql mostDominantSuperclasses nil)
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses) )
	   (setf currentMedianPoint possibleMedianPoint)
	   )
	  
	  ;;CASE 2 - The current median point was too large and a suitable replacement found
	  ((and (lisp::> currentMedianPoint possibleMedianPoint)
		(lisp::> currentMedianPoint idealMedianPoint)
		)
	   (setf mostDominantSuperclasses nil)
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses))
	   )
	  
	  ;; CASE 3 - The current median point is too small and a suitable replacement found
	  ((and (lisp::< currentMedianPoint possibleMedianPoint)
		(lisp::< possibleMedianPoint idealMedianPoint))
	   (setf mostDominantSuperclasses nil)
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses))
	   )
	  
	  ;; CASE 4 - We have a nice match and its time to append to the list
	  ((lisp::= possibleMedianPoint currentMedianPoint)	   
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses))	   
	   )
	  
	  ;; CASE 5 - We found an honest to God exact match!!
	  ((lisp::= possibleMedianPoint idealMedianPoint)
	   (setf mostDominantSuperclasses nil)
	   (setf mostDominantSuperclasses (cons matrixElement mostDominantSuperclasses))	   
	   )
	  
	  ) ;; end of cond
   
    );; end dolist
  (setf mostDominantSuperclasses (tidyBottomUpSuperclasses mostDominantSuperclasses))
  mostDominantSuperclasses
  )

(defun tidyBottomUpSuperclasses (dominantSuperclasses)
  "We have a list of top down dominant classes.  However, the list will contain 'duplicates'.  Suppose that the class animal is the pinnacle with two supporting classes.  Now consdier the divergence point for the classes does not exist until three levels lower and the class mammal and primate also contains these subclasses.  We only want the pinnacle, animal, and want to discard the rest.  This is because we want only the most general form possible, in this case animal."

  (setf nodesToRemove nil)
  (dolist (elementToCompare dominantSuperclasses)
    ;; here we get the superclasses of the element to compare.  So if the hierarchy 
    ;; were primate -> mammal -> animal and  the element were primate, this find 
    ;; would return both mammal and animal
    ;; Get the node in question
    (setf nodeToCompare (subclassToSuperclassMatrixElement-superclass elementToCompare))
    ;; Find its superclasses
    (setf nodeToCompareSubclasses (first (list #3! ((find (superclass- subclass) ~nodeToCompare)) ))  )       
    ;; Do a search of the subclasses
    (dolist (nodeSubClass nodeToCompareSubclasses)       
      (cond ((isNodeInBottomUpSuperclasses nodeSubClass dominantSuperclasses)
	     (setf nodesToRemove (cons nodeSubClass nodesToRemove ))
	     )
       )      
      )        
    ) ;; end outer dolist
  (dolist (nodeToRemove nodesToRemove)
    (setf dominantSuperclasses (removeNodeFromBottomUpSuperclasses nodeToRemove dominantSuperclasses))
    )
  
  dominantSuperclasses
  )

(defun removeNodeFromBottomUpSuperclasses (nodeToRemove superclasses)
  (dolist (element superclasses) 
    (setf nodeToCompare (subclassToSuperclassMatrixElement-superclass element))
    (cond ((eql nodeToCompare nodeToRemove)
	   (setf superclasses (set-difference superclasses (cons element nil)))	   
	      )
	  )    
    );;end dolist  
  superclasses
  )

(defun isNodeInBottomUpSuperclasses (node bottomUpSuperclasses)
  "Based on the node passed in, see if it is already in the bottomUpSuperClasses."
  (setf isAlreadyIn nil)
  (dolist (element bottomUpSuperclasses) 
    (setf nodeToCompare (subclassToSuperclassMatrixElement-superclass element))
    (cond ((eql nodeToCompare node)
	   (setf isAlreadyIn t)
	      )
	  )
    );;end dolist
  isAlreadyIn
  )


(defun tidyTopDownSuperclasses (dominantSuperclasses)
  "We have a list of top down dominant classes.  However, the list will contain 'duplicates'.  Suppose that the class animal is the pinnacle with two supporting classes.  Now consdier the divergence point for the classes does not exist until three levels lower and the class mammal and primate also contains these subclasses.  We only want the pinnacle, animal, and want to discard the rest.  This is because we want only the most general form possible, in this case animal."

  (dolist (elementToCompare dominantSuperclasses)
    ;; here we get the superclasses of the element to compare.  So if the hierarchy were primate -> mammal -> animal and 
    ;; the element were primate, this find would return both mammal and animal
    ;; Get the node in question
    (setf nodeToCompare (subclassToSuperclassMatrixElement-superclass elementToCompare))
    ;; Find its superclasses
    (setf nodeToComparesParent (first (list #3! ((find (superclass- subclass) ~nodeToCompare)) ))  )   
    (cond ((eql nodeToComparesParent nil)
	   ;; if the parent node is nil, we know we have the apex and need do nothing more
	   )
	  (t
	   ;; Here it is not the apex, time to remove it from the list
	   (setf dominantSuperclasses (set-difference dominantSuperclasses (cons elementToCompare nil)))
	   )
	  )
    ) ;; end of dolist
  dominantSuperclasses
  )


(defun getClassMembershipOrInstanceMembershipForNode (node)
  "Within one level, get the class or membership of this node"
      ;; Find all instances of this agent with respect to the subclass it belongs to
      (union
      (first (list #3! ((find (class- member) ~node )) ))
      ;; Hideous code, should not assume that a rel exists pointing to "ISA" @todo resolve this issue
      (first (list #3! ((find (object2- object1) ~node )) ))
      ) ;; end union   
  )



(defun createSuperclassToSubclassMatrix (nodeInstances)
  "Based on the subclass instances find all the possible 'parents' (superclasses really) of the subclass and rank them.  This is a tricky proposition as a subclass can be part of many hierarchies."


;;@todo way too nested, attempt to simplify by extracting functions

  (setf superclassToSubclassMatrix nil)
  (dolist (nodeInstance nodeInstances)

    ;;(setf nodeInstance (node-to-lisp-object (first nodeInstance)))
    (setf classOrIsa (getClassMembershipOrInstanceMembershipForNode nodeInstance))
    (dolist (subclass classOrIsa)
      (setf subclassAndAllParents 
	(cons subclass
	      (first (list #3! ((find superclass- (findassert subclass ~subclass )))))
	      )) ;; end set subclassAndAllParents
      ;;Now we have ALL the superclasses of the original node passed in.  It is time to cycle
      ;; through these superclasses and place them in the proper place in the matrix
      (dolist (verifiedSuperclass subclassAndAllParents)

	;; Now we must cycle through the list and add them to the matrix.  
	(setf elementDoesNotExist t)

	(dolist (matrixElement superclassToSubclassMatrix)
	  (cond (
		 (eql (subclassToSuperclassMatrixElement-superclass matrixElement) verifiedSuperclass)
		 (setf (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase matrixElement) (cons nodeInstance (subclassToSuperclassMatrixElement-recognizingAgentActPredicateBase matrixElement) ))
		 (setf elementDoesNotExist nil)
		 ) ;; first and ONLY case
	    );; end cond
	  ) ;; end inner inner inner dolist
	
	;; If this is true than it is the first occurence.  Add a struct to the matrix list
	(cond ( elementDoesNotExist   
		(setf superclassToSubclassMatrix (cons 
						  (make-subclassToSuperclassMatrixElement
						   :superclass verifiedSuperclass
						   :recognizingAgentActPredicateBase (cons nodeInstance nil))  
						  superclassToSubclassMatrix)) ;; end setf superclassToSubclassMatrix
	    )
	  );; end of cond
	
	) ;; end inner inner dolist
      
      );; end inner dolist
    
    );; end outer dolist
  superclassToSubclassMatrix
  )







(defun findAgentsForType (predicateType)
  "Based on the input predicate type find all the agents for that type (immediate agents, not inferred ones found via path based inference) and return them "
  (setf allAgents nil)
  (dolist (instance verbInstances)

    (setf instancePredicateType (verbInstance-predicateType instance))
    (if (string= predicateType instancePredicateType) 	  
	      (setf allAgents (cons (first (verbInstance-agent instance)) allAgents))
	    ) ;; end if
	 ) ;; end of dolist
  allAgents      
    )
  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Ask the user what CASSIE should do.  With a verb there are many different ways
;; to interpret the information and different lines of thought can lead to 
;; different guesses as to the meaning.  Its impossible to gauge which definition 
;; is more correct than another.  So, ask the user what they want to know from
;; CASSIE.  She will of course guide them along the lines she thinks are most 
;; likely to yield a definition.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun introduceTheVerbAlgorithm 
    "Because verbs have many different lines of though with repsect to their meaning ask the user which direction the
  y want CASSIE to go.  CASSIE lets them know what she believes to be the most promising."
  (setf verbString (symbol-name verb))
  (setf introString  "You want me to define the verb '")
  (setf introString (concatenate 'string introString verbString))


;;;;;;;;;;;;-CLB
;;  (setf introString (concatenate 'string introString "'.~2%I'll start by looking at the ;;predicate stucture of the sentences I know that use '"))
;;;;;;;;;;;
 (setf introString (concatenate 'string introString "'.~3%Predicate stucture of the sentences using the verb: "))

;;;;;;;;;;;;


  (setf introString (concatenate 'string introString verbString))	
  (setf introString (concatenate 'string introString "~2%"))
  (setf introString (concatenate 'string introString (returnStringOfPredicateTypeUsage)))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Order the preicate types known by CASSIE based on the most common.
;; For instance if CASSIE knows the verb throw in the following senses:
;; Bitransitive - 12 instances
;; Transitive - 31 Instances
;; Intransitive - 10 instances
;; This function will return a list as follows:
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun returnStringOfPredicateTypeUsage
    "Return a tidy string of the predicate types based on usage.  Something of the form 'A something can verb a something'"

  ( setf returnString "")

  (setf verbString (symbol-name verb))

  ( setf mostCommonCases (concatenate 'string (concatenate 'string "The most common type of sentences I know of that use '" verbString) "' are of the form: ~2%"))
  ( setf otherCases (concatenate 'string (concatenate 'string "The next most common types of sentences that I know of that use '" verbString) "' are of the form: ~%"))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;edit -CLB
  ( setf bitransitiveSkeleton (concatenate 'string (concatenate 'string "     'A something can " verbString ) " something to/from something.'~2%"))
  ( setf transitiveSkeleton (concatenate 'string (concatenate 'string "     'A something can " verbString) " something.'~2%" ))
  ( setf intransitiveSkeleton (concatenate 'string (concatenate 'string "     'A something can " verbString) ".'~2%" ))


 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -CLB
  ( setf instrumentSkeleton (concatenate 'string (concatenate 'string "     'A something can " verbString) " by using something.'~2%" ))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  (setf returnString (concatenate 'string returnString mostCommonCases ))
  ( setf firstTimeThrough t)
  ( dolist (currentList cummulativeLists)
    (if firstTimeThrough 
	(setf firstTimeThrough nil)
        (setf returnString (concatenate 'string returnString otherCases) )
      )
    ( dolist (currentTransitiveType currentList)
	(cond ( (string= currentTransitiveType "bitransitive") 
		(setf returnString (concatenate 'string returnString bitransitiveSkeleton))
		
		);; if bitrans
	      
	      ( (string= currentTransitiveType "transitive") 
		(setf returnString (concatenate 'string returnString transitiveSkeleton))
		
		);; if trans

	      ( (string= currentTransitiveType "intransitive") 
		(setf returnString (concatenate 'string returnString intransitiveSkeleton))
		
		);; if intrans
	      

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	      ( (string= currentTransitiveType "instrument") 
		(setf returnString (concatenate 'string returnString instrumentSkeleton))
		
		);; if instr
	      )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	
      ) ;; end of inner doList
    ) ;; end of outer doList
  
  (concatenate 'string returnString "~%")
 
  )


(defun orderPredicateTypesByUsage
    "Return a list of the predicate names sorted by usage count.  For instance the usage Bi - 12, Tr - 31 and In - 10 would return a list ( (Transitive) (Bitransitive) (Intransitive) (Instrument))"
  (setf predicateListOrdering (sort  (cons (length bitransitiveList) ( cons (length transitiveList) ( cons (length intransitiveList) (cons (length instrumentList) ())))) #'lisp::>))

  (setf instanceCount -97)
  (setf comprehensiveList nil)
  (setf tempList nil)
  (dolist (frequency predicateListOrdering)
    (cond ((lisp::= instanceCount -97)  
	   ;; We are entering the loop the first time.  So, the first element must be the most common case
	   (setf instanceCount frequency)
	   (setf comprehensiveList (cons (getPredicateListsWithFrequency frequency) comprehensiveList))
	   )
          
	  ((and (lisp::> instanceCount frequency) (lisp::> frequency 0) )
	   ;; Time to move on
	   (setf instanceCount frequency)
	   (setf comprehensiveList (cons (getPredicateListsWithFrequency frequency) comprehensiveList))
	   )
	  
	  ((and (lisp::> instanceCount frequency) (lisp::= frequency 0)) 
	   (setf instanceCount frequency)
	   ;; do nothing else here.  0s are of no interest to us.
	   )

	  ((lisp::= instanceCount frequency)
	   nil
	   ;; do nothing in this case
	   )	  
     ) ;; end cond
    
    ) ;; end doList

  (setf comprehensiveList (reverse comprehensiveList))
  comprehensiveList
)


(defun getPredicateListsWithFrequency (frequency) 
  "Gather up the predicate categories that have instance counts of the passed in frequency and return them as a list.  So if Bitransitive 3, Transitive 12, Intrnasitive 12 it will return the list (Transitive Intransitive)"
  (setf frequencyList nil)
  (if (lisp::= frequency (length bitransitiveList))
               (setf frequencyList (cons  "bitransitive" frequencyList)) ) 
  
  (if (lisp::= frequency (length transitiveList))   
               (setf frequencyList (cons "transitive" frequencyList)) )

  (if (lisp::= frequency (length intransitiveList)) 
               (setf frequencyList (cons "intransitive" frequencyList)) )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
  (if (lisp::= frequency (length instrumentList)) 
               (setf frequencyList (cons "instrument" frequencyList)) )
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  frequencyList
)













;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;
;;       PRINTABLE OUTPUT:  NOTE, COULD GROW TO RIDICULOUS LENGTHS
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A function to provide a nice printing interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun printableVerbOutputBAK ()
"Show a user friendly version of the information regarding this verb."

  (format nil
	  "The precise verb instances follow.  They are categorized in the following order: ~2%     1. Bitransitive Instances ~%     2. Transitive Instances ~%     3. Intransitive Instances. ~%   4. Instrument uses ~2% The format of the output is the printable version of LISP structs.  This format can be changed. ~4% ~A ~3% The immediate nodes pointing to the verb are: ~% ~A"
	  verbInstances 
 ))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
;;
;;;;;;;;;;;;;;;;

(defun printableVerbOutputS ()
"Show a user friendly version of the information regarding this verb."
  (format nil "~% Things found for this verb: ~% ~A"  (first verbInstances) ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(currently used)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun printableVerbOutput ()
"Show a user friendly version of the information regarding this verb."
(format nil
	 "~% Things found for this verb: ~%" )
(printVinstance) 
)
;;;;;;;;;;;;;;;;;;;;;;;;

;;-CLB 4/12/2003
(defun printVinstance ()
  "prints out the elements of each verbInstance"
   (dolist (instance verbInstances)


(format t "~3% ************(Meaningless Information)************ ~% ")

	(format t "~3% predicateType: ~A " (verbInstance-predicateType instance))
     	  
	(format t "~% agent: ~A " (verbInstance-agent instance))

	(format t "~% act: ~A " (verbInstance-act instance))
	 
	(format t "~% object: ~A " (verbInstance-object instance))
   
	(format t "~% indirectObject: ~A " (verbInstance-indirectObject instance))

	(format t "~% instrument: ~A " (verbInstance-instrument instance))

(format t "~4% ************(Meaningful Information)************* ~% ")

	(format t "~% * object types acted upon:~%         ~A " (verbInstance-objectType instance))

	(format t "~2% * indirect object types acted in relation to/from:~%      ~A " (verbInstance-indirectObjectType instance))

	(format t "~2% * Types and properties of instruments that can be used to ~A:~%" verb) 
        (format t "          ~A" (verbInstance-InstrumentType instance))

	(format t "~2% * Things that enable the action to take place:~%          ~A " (verbInstance-enabledBy instance))

	(format t "~2% * synonyms of ~A:~%" verb) 
	(format t "         ~A" (verbInstance-synonym instance))

	(format t "~2% effects of the action taking place :~%       ~A" (verbInstance-effects instance))


(format t "~4% ****************(Useless)**************** ~% ")

	(format t "~% agentHierarchyList:~%        ~A" (verbInstance-agentHierarchyList instance))

	(format t "~% prepositionList: (lists 'attached prepositions' -nothing implemented)~%        ~A" (verbInstance-prepositionList instance))

	(format t "~% superclassHierarchy (i.e, superclasses of the verb):~%        ~A" (verbInstance-superclassHierarchy instance))

	(format t "~% consequences (i.e, searches for ant- cq case frames, the the antecedent is the action): ~A" (verbInstance-consequences instance))
	
(format t "~5% ********************(END)***************** ~3% ")


	) ;;end of dolist
      
    )




















;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;






















;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;;
;;       METHODS THAT DETERMINE TRANSITIVITY TYPE AND FILL APPROPRIATE LISTS
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Here we determine the most gerealized caegorization schema, the predicate structure.
;; We look for transitive, bitransitive, intransitive and reflexive instances and place them
;; in seperate lists.  Later functions will use these lists to fill out actual structures
;; to represent each instance of the verb.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun  categorizeBasedOnPredicateStructure (verbToDefine)
  "Breakdown the predicate structure."
  (setf verb verbToDefine)
  ;; @todo what happens with reflexive instances? Is there a reflexive-bitransitive?
  ;; Should ask Dr. Rapaport.
  (setf bitransitiveList (isBitransitive verb) )
  (setf transitiveList (isTransitive verb) )
  (setf intransitiveList (isIntransitive verb) )
  (setf instrumentList (isInstrument verb) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Time to make the structures.  This is actually the fun part.  It is supposed to be 
;; similar to how a human might envision a verb and how they (might) would categorize
;; it to make sense of it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun createStructuresToRepresentEachInstanceOfVerb 
  "Begin the process of running through each of the predicate types (bitransitive, transitive, etc.) and creating structures to represent each instance."
  (setf verbInstances nil) ;; A list for all the verb instances.  To be filled in by the 
  ;; functions called below.
  (instantiateInstances intransitiveList "intransitive") 
  (instantiateInstances transitiveList "transitive")
  (instantiateInstances bitransitiveList "bitransitive")  
  (instantiateInstances instrumentList "instrument") 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A function to find a bitransitive verb
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun isBitransitive (verb)
  "Searching for Bitransitive verbs that have Agent/Act where Act arc points to node representing Action/Object/Indobj case frame"
  (first (list #3! ((  find (act action lex) ~verb (act object) ?object (act indobj) ?indirectObject (agent) ?agent ))))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A function to find a transitive verb
;; Find an act -> action -> to the verb in question AND agent -> any agent and object -> any
;; object.
;; Note the nested call to set difference.  It may have been clearer to do the list #3! stuff
;; as a setf variable but brevity is key.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun isTransitive (verb)
  "Searching for Transitive verbs that have Agent/Act where Act arc points to node representing Action/Object case frame" 
  (set-difference (first  (list #3! ( (find (act action lex) ~verb (act object) ?object (agent) ?agent (instrument lex) ?instrument ) ) ) )  bitransitiveList )  
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A function to find an intransitive verb
;; Find an act -> action -> to the verb in question AND agent -> any agent.  Both paths need to eminate from the 
;; same node.
;; Note the nested calls to set-difference.  First get the list and its difference
;; against the bitransitive list and then its difference against the transitive
;; list.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun isIntransitive (verb)
  "Searching for Intransitive verbs that have Agent/Act where Act arc points to node representing Action case frame"
  (set-difference   (set-difference (first (list #3! (( find (act action lex) ~verb (agent) ?agent (instrument lex) ?instrument )))) bitransitiveList ) bitransitiveList )
)








;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A function to find an instrument
;; Find an act -> action -> to the verb in question AND agent -> any agent and object -> any
;; object.
;; Note the nested call to set difference.  It may have been clearer to do the list #3! stuff
;; as a setf variable but brevity is key.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun isInstrument (verb)
  "Searching for Transitive verbs that have Agent/Act where Act arc points to node representing Action/Object case frame" 
  (set-difference (first  (list #3! ( (find (act action lex) ~verb (act object) ?object (agent) ?agent (instrument) ?instrument ) ) ) )  instrumentList )  )


















;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;
;;      Utility methods that are used to fill out the verbInstance variables
;;
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   Based on the node passed in find the agent of the agent/action case frame
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun findAgent (nodeInstance)
  "Return the agent of this agent/action case"
  (first (list #3! (( find agent- ~nodeInstance))  ))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   Based on the node passed in find the object of the agent/action case frame
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun findObject (nodeInstance)
  "Return the object of this agent/action case"
  (first (list #3! (( find (object- act-) ~nodeInstance))  ))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   Based on the node passed in find the indirect object of the agent/action case frame
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun findIndirectObject (nodeInstance)
  "Return the indirect object of this agent/action case"
  (first (list #3! (( find (indobj- act-) ~nodeInstance))  ))
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;
;;
;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;CLB


(defun findIndirectObjectType (nodeInstance)
  "Return the indirect object of this agent/action case
 as well as superclasses of their types"
(union
	(first (list #3! (( find (lex- superclass- ! subclass class- ! member indobj- act-) ~nodeInstance))  ))
	 (first (list #3! (( find (lex- class- ! member indobj- act-) ~nodeInstance))  ))
))



(defun findObjectType (nodeInstance)
  "Return the object type/name of this agent/action case
 as well as superclasses of their types"

(union
	(first (list #3! (( find (lex- superclass- ! subclass class- ! member object- act-) ~nodeInstance))  ))
	(first (list #3! (( find (lex- class- ! member object- act-) ~nodeInstance))  ))
))


(defun findInstrument (nodeInstance)
  "Return the instrument object of this agent/act/instrument case"
  (first (list #3! (( find (instrument-) ~nodeInstance))  ))
  )


(defun findInstrumentType (nodeInstance)
  "Return the instrument name/type of this agent/act/instrument case
  as well as superclasses, properties"

(union
(union	
	  (first (list #3! (( find (lex- property- ! object superclass- class- instrument-) ~nodeInstance))  ))
	  (first (list #3! (( find (lex- property- ! object class- member instrument-) ~nodeInstance))  ))
	)


(union	
	(union	
	  (first (list #3! (( find (lex- property- ! object instrument-) ~nodeInstance))  ))
	  (first (list #3! (( find (lex- property- ! object class- instrument-) ~nodeInstance))  ))
	)

	(union	
	  (first (list #3! (( find (lex- superclass- ! subclass class- member instrument-) ~nodeInstance))  ))
	  (first (list #3! (( find (lex- class- member instrument-) ~nodeInstance))  ))
	)
)
)
)

(defun findEnabler (nodeInstance)
  "Return the proposition that enables the verb action to take place"
(union	
	(list
		(first (list #3! ((find (cause- effect) ~nodeInstance))  ) )
		(first (list #3! ((find (lex- cause- effect) ~nodeInstance))  ) )
	)
	
	(union
	(list	
		(first (list #3! ((find (ant- cq) ~nodeInstance))  ) )
		(first (list #3! ((find (lex- property- ant- cq) ~nodeInstance))  ) )
	)
	(list
		(first (list #3! ((find (&ant- cq) ~nodeInstance))  ) )
		(first (list #3! ((find (lex- property- &ant- cq) ~nodeInstance))  ) )
	)
	)
))

(defun findSynonym (nodeInstance)
  "Returns synonyms of the verb"
 (first (list #3! ((find (lex- synonym- synonym action- act-) ~nodeInstance))  ))
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB
;;;
;;  
;;   
;;   
;;  
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   Based on the node passed in find the parent class(es) of the verb in the sentence.
;;  Potentially thev verb could have more than one parent class in different hierarchies
;;  no less.  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun findVerbsParentClass (nodeInstance)
  "Return the parent class(es) of the verb in question"
  (setf immediateMembership  (list #3! (( find (class- member) ~nodeInstance ))))
  (setf allVerbSuperclasses nil)
  (dolist (member immediateMembership)
    (setf allVerbSuperclasses
      (union
       member
       ;; @todo This search may be over complicated and reduced to a single call 
       (first (list #3! ((find superclass- (findassert subclass ~nodeInstance )))))   
       )
      )
    )
  allVerbSuperclasses
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Based on the node passed in find the effects of the verb having taken place.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; @todo This probably should not be instance specific.  It will be reptition of data.
(defun findEffects (nodeInstance)
  "Return the effects of the verb having taken place.  In practice these refer mostly to the effects this verb has on the world around it and not a sequence of events detailing the verb (this is covered by findConsequences)"
  ;; @todo This search may be over complicated and reduced to a single call
  ;;@todo In more general sense many of these finds should probably be deduces.
(union  
	(first (list #3! ((find (effect- cause) ~nodeInstance))  ) )
	(first (list #3! ((find (lex- effect- cause) ~nodeInstance))  ) )
	;; (first (list #3! (( find cause- ~nodeInstance))  ))
)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Based on the node passed in find the consequences of the verb having taken place.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; @todo This probably should not be instance specific.  It will be reptition of data.
(defun findConsequences (nodeInstance)
  "Return the effects of the verb having taken place.  In practice this should be rules to the effect 'If x smits y when then x physically hits y and there is a good chance y may have died.'"
  (union
   (first (list #3! (( deduce &ant ~nodeInstance))  ))
   (first (list #3! (( deduce ant ~nodeInstance))  ))
  )
  )




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-CLB

(defun findCauseOf (nodeInstance)
  "Return the effects of the verb having taken place.  In practice this should be rules to the effect 'If x smits y when then x physically hits y and there is a good chance y may have died.'"
  (union
   (first (list #3! (( deduce &ant ~nodeInstance))  ))
   (first (list #3! (( deduce ant ~nodeInstance))  ))
  )
  )

















;;;;;;;;;;;;;;;;;;;;;;;;;;;; What to do with these!!! :::::::::::::::::::::::::::::::::::::::::::
;;  Attempt at creating an uber powerful search that in all reality may not be needed and much
;; more complex than is worth spending time on.


(defun determineNodeHierarchy (instance instanceStructure) "Determine the node's hierarchy.  That is find all the hierarchies that it belongs to and attempt to unify these structures in a meaningful way."
       (setf hierarchyList (first (list #3!((find (class- ! member) ~instance)))))
       (dolist (hierarchyInstance hierarchyList)
	 ;;@todo figure out how to get the initial node in here
	 (setf pathToTop (cons hierarchyInstance (followHierarchyToTop hierarchyInstance)))
	 ;; Make a list of lists
	 (setf (verbInstance-agentHierarchyList instanceStructure) 
	             (cons pathToTop (verbInstance-agentHierarchyList instanceStructure) ))
	 )
       )


(defun followHierarchyToTop (nodeFromList)
  "Trace this node to the top of its hierachy recording all the nodes inbetween"
  (setf node (first (list #3!((find (superclass- ! subclass) ~nodeFromList )))))
  (cond ((eq nil node) nil)   ;; do nothing
        (t (cons node (followHierarchyToTop node)))
	)

	)


(defun searchEntireRelationSet
"Search the relation set to find which nodes point to the verb in question."    
( dolist (relation allRelations) 
   (setf tempList  (first (list #3! ((find  (~relation lex)  ~verb)) )))
   (setf nodesPointingToVerb (union tempList nodesPointingToVerb))  
  );;end of dolist
)



;; The tracing method.  Taken from, based upon Scott N's work in the noun algorithm.  Level 0 shuts
;; off all tracing.  Level 1 turns on all tracing.  Obviously this ought to change and more
;; cases should exist for further tracing.  This will be an ongoing challenge.
(defun setTraceLevel (level)
  "Trace the functions that compose the verb algorithm.  Level 0 turns off all tracing while level 1 turns on all tracing."
 (case level
       (0 (untrace categorizeBasedOnPredicateStructure
		   createFormattedString
		   createHumanReadableNamesForElements
		   createSuperclassToSubclassMatrix
		   createStructuresToRepresentEachInstanceOfVerb 
		   defineVerb
		   determineNodeHierarchy
		   findAgent
		   findAgentsForType 
		   findConsequences
		   findEffects
		   findHumanReadableName
		   findIndirectObject
;;;
		  findInstrument
		  isInstrument
;;;
		   findObject
		   findBottomUpDominant
		   findTopDownDominant
		   findVerbsParentClass
		   followHierarchyToTop
		   getClassMembershipOrInstanceMembershipForNode
		   getPredicateListsWithFrequency
		   introduceTheVerbAlgorithm 
		   instantiateInstances 
		   instantiatePredicatePools
		   isBitransitive
		   isIntransitive
		   isNodeInBottomUpSuperclasses		   
		   isTransitive
		   orderPredicateTypesByUsage 
		   printPredicateUnificationBottomUp
		   printPredicateUnificationTopDown 
		   printableVerbOutput
		   printVerbUnificationString
		   removeNodeFromBottomUpSuperclasses
		   returnStringOfPredicateTypeUsage 
		   searchEntireRelationSet
		   tidyBottomUpSuperclasses		   
		   tidyTopDownSuperclasses
		   translateFromAgentsToIndirectObjects
		   translateFromAgentsToObjects)
	  )   
       (1 (trace   categorizeBasedOnPredicateStructure
		   createFormattedString
		   createHumanReadableNamesForElements
		   createSuperclassToSubclassMatrix
		   createStructuresToRepresentEachInstanceOfVerb 
		   defineVerb
		   determineNodeHierarchy
		   findAgent
		   findAgentsForType 
		   findConsequences
		   findEffects
		   findHumanReadableName
		   findIndirectObject
;;;
		  findInstrument
		  isInstrument
;;;
		   findObject
		   findBottomUpDominant
		   findTopDownDominant
		   findVerbsParentClass
		   followHierarchyToTop
		   getClassMembershipOrInstanceMembershipForNode
		   getPredicateListsWithFrequency
		   introduceTheVerbAlgorithm 
		   instantiateInstances 
		   instantiatePredicatePools
		   isBitransitive
		   isIntransitive
		   isNodeInBottomUpSuperclasses		
		   isTransitive
		   orderPredicateTypesByUsage 
		   printPredicateUnificationBottomUp
		   printPredicateUnificationTopDown 
		   printableVerbOutput
		   printVerbUnificationString
		   removeNodeFromBottomUpSuperclasses
		   returnStringOfPredicateTypeUsage 		   
		   searchEntireRelationSet
		   tidyBottomUpSuperclasses
		   tidyTopDownSuperclasses
		   translateFromAgentsToIndirectObjects
		   translateFromAgentsToObjects)
	  )           
  )
)