;;;Adam Lammert's adjective definition algorithm
;;;modified by Ananthakrishnan Ugrasenan Santha

(in-package :snepsul)

(defstruct adj_info
  "A structure to store and report definitions of adjectives"
  adjective
  unlike_props
  class
  type_nouns
  possible_synonyms)

(defun define_adjective (adj)
  "Gives a definition of the adjective"
  (let (definition)
    (setf definition (make-adj_info))
    (setf (adj_info-adjective definition) adj)
    (setf (adj_info-unlike_props definition) (findUnlikeProp adj))
    (setf (adj_info-class definition) (findClass adj))
    (setf (adj_info-type_nouns definition) (findNounTypes adj))
    (setf (adj_info-possible_synonyms definition) (findPossibleSynonyms adj))
    definition))

(defun findUnlikeProp (adj)
  "Find words that are unlike 'adj'."
  #3! ((find (compose lex- property- arg- min) 0
             (compose lex- property- arg- max) 0
             (compose lex- property- arg- cq- ! ant property lex) ~adj
             (compose lex- property- object object- property lex) ~adj)))

(defun findClass (adj)
  "Find the class in which 'adj' is."
  #3! ((find (lex- class- member lex) ~adj)))

(defun findNounTypes (adj)
  "Find types of nouns that the adjective can describe"
  #3! ((find (lex- class- member object- property lex) ~adj)))

(defun findPossibleSynonyms (adj)
  "Find any possible synonyms"
  #3! ((find (compose object-) 
	     (find (compose rel  lex) "possible_synonym" 
		   (compose object) ~adj))))