;;; File: new-precardinals.lisp
;;; Last saved in emacs: Time-stamp: <95/07/27 14:53:10 williams>

;;; This file contains a rewriting of the system/chooser/inquiry set
;;; for LOOSER-CARDINAL-TYPE.  This system produces the pre-cardinal
;;; qualifiers "at least" or "at most," and I have modified it so that
;;; it can also produce "about".  I have also added a new upper-model
;;; concept, ABOUT, which is has the same properties as the concepts
;;; AT-LEAST and AT-MOST.  The inquiry implementation is also modified
;;; to take this into account.  
;;; Susan Williams, July, 1995 (at FAW).

;;; The next day:  I am now adding yet another qualifier: "up to",
;;; defined similarly to the others.

(in-package :penman)

(system
 :name LOOSER-CARDINAL-TYPE
 :inputs LOOSER
 :outputs ((0.2 range-at-least
		 (LEXIFY PRE-CARDINAL AT-LEAST))
	   (0.2 RANGE-at-most
		 (LEXIFY PRE-CARDINAL AT-MOST))
	   (0.2 range-about
		 (lexify pre-cardinal about))
	   (0.2 range-upto
		 (lexify pre-cardinal up-to))
	   (0.1 range-more-than
		(lexify pre-cardinal more-than))
	   (0.1 range-less-than
		(lexify pre-cardinal less-than)))
 :chooser LOOSER-CARDINAL-TYPE-CHOOSER
 :selector CHOICE-MASTER
 :region QUANTITY-GROUP
 :metafunction IDEATIONAL)

(chooser
   :name LOOSER-CARDINAL-TYPE-CHOOSER 
   :definition 
               ((ASK (NUMBER-RANGE-DIRECTION-Q PRE-CARDINAL ONUS)
                     (at-least (CHOOSE RANGE-at-least))
                     (at-most (CHOOSE RANGE-at-most))
		     (more-than (choose range-more-than))
		     (less-than (choose range-less-than))
		     (about (choose range-about))
		     (upto  (choose range-upto))))
   :comments ""
   :editor ""
   :date "8-4-1992 15:56:34 at IPSI."
)

(askoperator 
   :name NUMBER-RANGE-DIRECTION-Q
   :domain KB
   :mode IMPLEMENTED
   :parameters (PRE-CARDINAL ONUS)
   :english ()
   :operatorcode NUMBER-RANGE-DIRECTION-Q-CODE
   :parameterassociationtypes (CONCEPT CONCEPT)
   :answerset (at-least at-most more-than less-than about upto))

(defun Number-Range-Direction-Q-Code (numrel bogus-numrel)
  "Provisional implementation:  a guess."
  (declare (ignore bogus-numrel))
  (if (term-type-p numrel 'more-than)
      'more-than
    (if (term-type-p numrel 'at-least)
	'at-least
      (if (term-type-p numrel 'at-most)
	  'at-most
	(if (term-type-p numrel 'less-than)
	    'less-than
	  (if (term-type-p numrel 'about)
	      'about
	    (if (term-type-p numrel 'up-to)
		'upto)))))))

(lexical-item
  :name LESS-THAN
  :spelling "less than"
  :sample-sentence  "seven is less than eight"
  :features  (ADVERB NOT-LIMITER COMPARATIVEADVERB OTHERADVERB)
  :date  "July 27, 1995, at FAW"
  :editor  "WW")

(lexical-item
  :name MORE-THAN
  :spelling "more than"
  :sample-sentence  "seven is more than eight"
  :features  (ADVERB NOT-LIMITER COMPARATIVEADVERB OTHERADVERB)
  :date  "July 27, 1995, at FAW"
  :editor  "WW")

(lexical-item
  :name UP-TO
  :spelling "up to"
  :sample-sentence  "The operation takes up to 10 hours."
  :features  (ADVERB NOT-LIMITER COMPARATIVEADVERB OTHERADVERB)
  :date  "July 27, 1995, at FAW"
  :editor  "WW")

(penman-kb::defreified-relation About
  :is (:and penman-kb::Number-Focusing :primitive))

(penman::annotate-concept ABOUT
  :doc-strings
  ("A relation of focusing or restricting an attribution of quantity.")
  :lex-items
  (ABOUT))

(penman-kb::defreified-relation Up-To
  :is (:and penman-kb::Number-Focusing :primitive))

(penman::annotate-concept UP-TO
  :doc-strings
  ("A relation of focusing or restricting an attribution of quantity.")
  :lex-items
  (UP-TO))

(penman-kb::defreified-relation More-Than
  :is (:and penman-kb::Number-Focusing :primitive))

(penman::annotate-concept MORE-THAN
  :doc-strings
  ("A relation of focusing or restricting an attribution of quantity.")
  :lex-items
  (MORE-THAN))

(reset-system-network)
(set-grammar-keyword-types)


;;; Sample SPL:
(defvar sample-new-precardinals-SPL
  '(take / nondirected-action 
	 :lex take
	 :tense present
	 :actor (oper / abstraction 
		      :lex operation
		      :determiner the)
	 :actee (hours / abstraction 
		       :lex hour
		       :about 10)))
;;; Produces:
;;; "The operation takes about ten hours."
