;;; File: b-patch.lisp (for now)
;;; Last saved in emacs:  Time-stamp: <95/08/10 14:53:11 williams>

;;; This file contains grammar patches received from Brigitte Grote
;;; (which she did not write), which allow for conjoining of adverbs,
;;; as for instance, in the sentence "You should dicsuss this
;;; carefully and thoughtfully."

;;; The file contains a few inquiries and systems that seem to be
;;; unchanged from previous versions.  This should be double checked
;;; against our current versions of these, and removed if they are the
;;; same. 

;;; Note:  A couple of these systems were changed slightly from the
;;; versions in FAW's file tri-systems.gram

(system
 :name ADVERBIAL-ADJECTIVAL-GROUP-COMPLEXITY
 :inputs (OR ADVERBIAL-GROUP 
	     ADJECTIVAL-GROUP 
	     ATTRIBUTIVE-ADJECTIVAL-GROUP)
 :outputs ((0.5 ADVERBIAL-ADJECTIVAL-GROUP-COMPLEX  ;;; (INSERT CIRCUMSTANCE) 
		(INSERT INITIATING)
		(INSERT CONTINUING)
		(INSERT CONJUNCT)
		(PARTITION INITIATING CONJUNCT) (PARTITION CONJUNCT CONTINUING))
	   (0.5 ADVERBIAL-ADJECTIVAL-GROUP-SIMPLEX )) 
 :chooser ADVERBIAL-ADJECTIVAL-GROUP-COMPLEXITY-CHOOSER	   
 :selector CHOICE-MASTER
 :old-feature ADVERBIAL-GROUP
 :region RANKING
 :metafunction LOGICAL)

;; new - techdoc
(gate
 :name ADVERBIAL-GROUP-COMPLEX
 :inputs (AND ADVERBIAL-GROUP 
	      ADVERBIAL-ADJECTIVAL-GROUP-COMPLEX)
 :outputs ((1.0 ADVERBIAL-GROUP-COMPLEX  ;;; (INSERT CIRCUMSTANCE) 
		(PRESELECT CONTINUING ADVERBIAL-GROUP)
		(PRESELECT INITIATING ADVERBIAL-GROUP)
		)) 
 :selector CHOICE-MASTER
 :old-feature ADVERBIAL-GROUP
 :region RANKING
 :metafunction LOGICAL)

;; new - techdoc
(gate
 :name ADVERBIAL-GROUP-SIMPLEX
 :inputs (AND ADVERBIAL-GROUP 
	      ADVERBIAL-ADJECTIVAL-GROUP-SIMPLEX)
 :outputs ((1.0 ADVERBIAL-GROUP-SIMPLEX 
		(INSERT CIRCUMSTANCE) 
		(* COPYHUB ONUS CIRCUMSTANCE)
		)) 
 :selector CHOICE-MASTER
 :old-feature ADVERBIAL-GROUP
 :region RANKING
 :metafunction LOGICAL)


;;; Apparently unchanged
(system
 :name ADVERBIAL-TYPE
 :inputs ADVERBIAL-GROUP
 :outputs ((0.33333334 INTERPERSONAL-ADVERBIAL
		       (CLASSIFY CIRCUMSTANCE ATTITUDINALADVERB))
	   (0.33333334 EXPERIENTIAL-ADVERBIAL)
	   (0.33333334 TEXTUAL-ADVERBIAL 
		       (CLASSIFY CIRCUMSTANCE LINKER))) 
 :chooser ADVERBIAL-TYPE-CHOOSER
 :selector CHOICE-MASTER
 :old-feature EXPERIENTIAL-ADVERBIAL
 :region ADVERBIAL
 :metafunction IDEATIONAL)

;;; new
(chooser
 :name ADVERBIAL-ADJECTIVAL-GROUP-COMPLEXITY-CHOOSER 
 :definition ((ASK (CONTINUING-SET-Q ONUS  ONUS )
		   (NOT-CON-SET (CHOOSE ADVERBIAL-ADJECTIVAL-GROUP-SIMPLEX))
		   (CON-SET (IDENTIFY INITIATING (INITIATING-ID ONUS))
			    (IDENTIFY INITIATING (CONCEPTUAL-CORRELATE-ID INITIATING))
			    (IDENTIFY CONTINUING (CONTINUING-ID ONUS))
			    (IDENTIFY CONTINUING (CONCEPTUAL-CORRELATE-ID CONTINUING))
			    (CHOOSE ADVERBIAL-ADJECTIVAL-GROUP-COMPLEX)))
	      (* EDITED " 1-Jan-01 19:19:37")) 
 :comments ""
 :editor "Haihua"
 :date "6/17/93 11:20:06")

;;; Apparently unchanged
(chooser
 :name ADVERBIAL-TYPE-CHOOSER 
 :definition 
 ((ASK (ATTITUDE-Q ONUS)
       (ATTITUDE (* IDENTIFY CIRCUMSTANCE (TERM-SPECIFICATION-ID CIRCUMSTANCE ADVERB))
		 (CLASSIFY CIRCUMSTANCE ATTITUDINALADVERB)
		 (IDENTIFY CIRCUMSTANCE (TERM-RESOLVE-ID CIRCUMSTANCE CIRCUMSTANCE))
		 (CHOOSE INTERPERSONAL-ADVERBIAL))
       (NOTATTITUDE (CHOOSE EXPERIENTIAL-ADVERBIAL)))
  (* LP " 5-Jun-87 17:51:16")) 
 :comments ""
 :editor ""
 :date "")

;;; Apparently unchanged
(askoperator 
 :name ATTITUDE-Q
 :domain KB
 :mode IMPLEMENTED
 :parameters (ITEM)
 :english ("Does " ITEM " describe an attitude?")
 :operatorcode TRIVIALDEFAULTCODE
 :parameterassociationtypes (CONCEPT)
 :preselectionguidance ((INTERPERSONAL-ADVERBIAL . ATTITUDE) 
			(EXPERIENTIAL-ADVERBIAL . NOTATTITUDE)
			(ATTITUDINAL-KIND . ATTITUDE))
 :answerset (ATTITUDE NOTATTITUDE)
 :trivialdefault NOTATTITUDE)

(askoperator 
 :name CONTINUING-SET-Q
 :domain KB
 :mode IMPLEMENTED
 :parameters (PROCESS1 PROCESS2)
 :english ("Is "PROCESS2 " a set of at least two elements ?")
 :operatorcode CONTINUING-SET-Q-CODE
 :parameterassociationtypes (CONCEPT CONCEPT)
 :answerset (CON-SET NOT-CON-SET)
 :trivialdefault NOT-CON-SET)

(defun CONTINUING-SET-Q-CODE (pros1 pros2)
  "Check if pros2 consists of more than one process. - HP - extended - DR"
  (declare (ignore pros1))
  (cond ((and (or (term-type-p pros2 'Set) 
		  (term-type-p pros2 'Disjunctive-Set))
	      (> (length (term-graph-symbol (symbol-value pros2))) 1))  'CON-SET)
	((term-type-p (term-graph-parent (symbol-value pros2)) 'PENMAN-KB::CONJUNCTION)
	 ;; cf. example below - DR
	 (if (term-type-p (term-graph-parent (symbol-value (term-graph-parent (symbol-value pros2))))
			  'PENMAN-KB::CONJUNCTION)
	     'CON-SET
	   'NOT-CON-SET))
	(t 'NOT-CON-SET)))

;;; new
(system
 :name GROUP-CLASS
 :inputs GROUPS ;;;(OR GROUPS-SIMPLEX GROUPS-COMPLEX)
 :outputs ((0.5 NOMINAL-LIKE-GROUPS)
	   (0.5 ADVERBIAL-GROUP   ;;;(INSERT CIRCUMSTANCE)
		(* CLASSIFY CIRCUMSTANCE ADVERB))) 
 :chooser GROUP-CLASS-CHOOSER
 :selector CHOICE-MASTER
 :old-feature ADVERBIAL-GROUP
 :region RANKING
 :metafunction LOGICAL)

;;; Apparently unchanged
(chooser
   :name GROUP-CLASS-CHOOSER 
   :definition 
               ((ASK (CIRCUMSTANCE-Q ONUS) 
		     (CIRCUMSTANCE (COPYHUB ONUS CIRCUMSTANCE) 
				   (CHOOSE ADVERBIAL-GROUP))
                     (NOTCIRCUMSTANCE (CHOOSE NOMINAL-LIKE-GROUPS)))
		) 
   :comments ""
   :editor ""
   :date "")

;;; Apparently unchanged
(askoperator 
 :name CIRCUMSTANCE-Q
 :domain KB
 :mode IMPLEMENTED
 :parameters (ITEM)
 :english ("Is " ITEM " a specification of a circumstance i.e., of a time, place, cause, condition, manner, etc.?")
 :operatorcode CIRCUMSTANCE-Q-CODE
 :parameterassociationtypes (CONCEPT)
 :preselectionguidance ((EXTENDING-CLAUSE . NOTCIRCUMSTANCE) 
			(ELABORATING-CLAUSE . NOTCIRCUMSTANCE)
			(ENHANCING-CLAUSE . CIRCUMSTANCE) 
			(ADVERBIAL-GROUP . CIRCUMSTANCE)
			(NOMINAL-LIKE-GROUPS . NOTCIRCUMSTANCE)
			(NOMINAL-DEPENDENT . NOTCIRCUMSTANCE)
			(ADVERBIAL-DEPENDENT . CIRCUMSTANCE) 
			(ADJECTIVAL-DEPENDENT . NOTCIRCUMSTANCE))
 :answerset (CIRCUMSTANCE NOTCIRCUMSTANCE))

;;; changed
(defun Circumstance-Q-Code (arg)
  "Is its type circumstantial?"
  (if (or (term-type-p arg 'circumstantial)
	  (and (not (term-type-p arg 'object))  ;;;; Added to prevent the system from choosing 
		                                ;;;; 'circumstance' 
		                                ;;;; when 'arg' is a noun, HP 7/16/93 14:05:59
	                                        ;;; read:  when 'arg' is of type object - DR
	       (or (term-type-p (term-graph-parent (symbol-value arg)) 'circumstantial)
		   (when (term-graph-parent (symbol-value arg)) 
			 (term-role-p (term-graph-parent (symbol-value arg)) arg 'circumstantial)))))
      'circumstance
    'notcircumstance))

;;; brand new
(identifyoperator
 :name INITIATING-ID
 :domain KB
 :mode IMPLEMENTED
 :parameters (SPEC)
 :english ("What is the set of all potential representatives of the conceptual category specified by " CONCEPTUALCATEGORY " in this mention of it?")
 :operatorcode INITIATING-ID-CODE
 :parameterassociationtypes (MODIFICATIONSET)
 :createdassociationtype MODIFICATIONSET)

(defun INITIATING-ID-CODE (onus)
  "Check if onus consists of one or more concept. If so, return the 'car' part. - HP"
  ;;(declare (ignore pros1))
  (if (or (term-type-p onus 'disjunctive-set)
	  (term-type-p onus 'Set))   
      (if (>= (length (term-graph-symbol (symbol-value onus))) 1)	 
	  (get-first-member onus))))

;;; unchanged apart from addition of English
(identifyoperator
   :name CONCEPTUAL-CORRELATE-ID
   :domain TP
   :mode IMPLEMENTED
   :parameters (PRESENTATIONSPEC)
   :english ("What is the identity of the existing or synthesized concept which represents the conceptual correlate of the presentation specification " PRESENTATIONSPEC " , i.e. a thing known only as specifically as the presentation specification specifies?")
   :operatorcode CONCEPTUAL-CORRELATE-ID-CODE
   :parameterassociationtypes (MODIFICATIONSET)
   :createdassociationtype CONCEPT)

(identifyoperator
   :name CONTINUING-ID
   :domain KB
   :mode IMPLEMENTED
   :parameters (SPEC)
   :english ("What is the set of all potential representatives of the conceptual category specified by " CONCEPTUALCATEGORY " in this mention of it?")
   :operatorcode CONTINUING-ID-CODE
   :parameterassociationtypes (MODIFICATIONSET)
   :createdassociationtype MODIFICATIONSET)

(defun CONTINUING-ID-CODE (onus)
   "Check if onus consists of more than one concept. If so, return the 'cdr' part; otherwise, return the 'car' part. - HP"
   ;;(declare (ignore pros1))
   (if (or (term-type-p onus 'disjunctive-set) 
	 (term-type-p onus 'Set))   
       (if (< 2 (length (term-graph-symbol (symbol-value onus))))
	   (and (setf (term-graph-symbol (symbol-value onus)) 
		      (rest (term-graph-symbol (symbol-value onus))))
		onus)
	   (get-second-member onus))))

(identifyoperator
 :name TERM-SPECIFICATION-ID
 :domain TP
 :mode IMPLEMENTED
 :parameters (ITEM LEXFEATURE)
 :english ("What is the set of applicable lexical items which are denotationally appropriate for expressing " ITEM " with the lexical feature " LEXFEATURE " ?")
 :operatorcode TERMSPECIFICATIONCODE
 :parameterassociationtypes (CONCEPT LEXICALFEATURE)
 :createdassociationtype TERMSET)

(identifyoperator
 :name TERM-RESOLVE-ID
 :domain TP
 :mode IMPLEMENTED
 :parameters (THEFUNCTION TERMS)
 :english ("Select one of these " TERMS " " TERMS " to express " THEFUNCTION " ?")
 :operatorcode TERM-RESOLVE-ID-CODE
 :parameterassociationtypes (CONCEPT FUNCTION)
 :createdassociationtype TERM)

;;; new
(defun get-first-member (onus)
  "Get the fist member in the set onus."
  (if (symbolp (first (term-graph-symbol (symbol-value onus))))
      (first (term-graph-symbol (symbol-value onus)))
    (term-graph-id (first (term-graph-symbol (symbol-value onus))))))

;;; new
(defun get-second-member (onus)
  (if (symbolp (second (term-graph-symbol (symbol-value onus))))
      (second (term-graph-symbol (symbol-value onus)))
    (term-graph-id (second (term-graph-symbol (symbol-value onus))))))

;;new - techdoc
(system
 :name CONJUNCT-AND-TYPE
 :inputs (OR ADDITIVE-STRUCTURAL ADDITIVE-GROUP)
 :outputs ((0.5 CONJUNCT-AND-ZERO  (LEXIFY CONJUNCT ZERO))		  
	   (0.5 CONJUNCT-AND-LEXICAL (LEXIFY CONJUNCT AND)))	         
 :chooser CONJUNCT-AND-TYPE-CHOOSER 
 :selector CHOICE-MASTER
 :old-feature RELATIONAL-OTHER
 :region CONJUNCTION
 :metafunction TEXTUAL
 :comments "(HP)")

;; new - techdoc
(system
 :name CONJUNCT-OR-TYPE 
 :inputs (OR DISJUNCTIVE-STRUCTURAL MULTI-ALTERNATIVE-GROUP)
 :outputs ((0.5 CONJUNCT-OR-ZERO (LEXIFY CONJUNCT Zero))
	   (0.5 CONJUNCT-OR-LEXICAL (LEXIFY CONJUNCT OR))) 
 :chooser CONJUNCT-OR-TYPE-CHOOSER 
 :selector CHOICE-MASTER
 :old-feature RELATIONAL-OTHER
 :region CONJUNCTION
 :metafunction TEXTUAL
 :comments "(HP)")

;;; new
(system
 :name GROUPS-CONJUNCTION-TYPE
 :inputs (OR PREPOSITIONAL-PHRASE-COMPLEX 
	     non-elaborating-NOMINAL-GROUP-COMPLEX   ; changed from tri-systems.gram
	     ADVERBIAL-ADJECTIVAL-GROUP-COMPLEX)
 :outputs ((0.25 ADDITIVE-GROUP;;(LEXIFY CONJUNCT AND)
		 )
	   (0.25 CONTRASTIVE-GROUP (LEXIFY CONJUNCT BUT))
	   (0.25 MULTI-ALTERNATIVE-GROUP)
	   (0.25 ALTERNATIVE-GROUP (INSERT CORRELATOR)
		 (ORDER CORRELATOR INITIATING) (LEXIFY CORRELATOR EITHER)
		 ;;(INSERT COORDINATOR) 
		 ;;(ORDER CONJUNCT )
		 (LEXIFY CONJUNCT OR)
		 )) 
 :chooser GROUPS-CONJUNCTION-TYPE-CHOOSER
 :selector CHOICE-MASTER
 :old-feature ADDITIVE-STRUCTURAL
 :region CONJUNCTION
 :metafunction TEXTUAL)

;;; new
(chooser
   :name CONJUNCT-AND-TYPE-CHOOSER 
   :definition 
               ((ASK (CONTINUING-SET-Q INITIATING CONTINUING)
                     (CON-SET (CHOOSE CONJUNCT-AND-ZERO))
                     (NOT-CON-SET (CHOOSE CONJUNCT-AND-LEXICAL)))
		) 
   :comments "Select the lexical form of 'and' (COORDINATOR) in structural coordination."
   :editor "Haihua"
   :date "15-6-93")

;;; new
(chooser
   :name CONJUNCT-OR-TYPE-CHOOSER  
   :definition 
               ((ASK (CONTINUING-SET-Q INITIATING CONTINUING)
                     (CON-SET (CHOOSE CONJUNCT-OR-ZERO))
                     (NOT-CON-SET (CHOOSE CONJUNCT-OR-LEXICAL)))
		) 
   :comments "Select the lexical form of 'or' (COORDINATOR) in structural coordination."
   :editor "Haihua"
   :date "15-6-93")

;;; new
;;; Note that this chooser is incomplete and could hit a boundary.
(chooser
 :name GROUPS-CONJUNCTION-TYPE-CHOOSER
 :definition ((ASK (CONTRASTIVE-EXTENSION-Q INITIATING CONTINUING)
		   (NONCONTRASTIVE
		    (ASK (CONJUNCTIVE-EXTENSION-Q INITIATING CONTINUING)
			 (NONCONJUNCTIVE
			  (ASK (DISJUNCTIVE-EXTENSION-Q INITIATING CONTINUING)
			       (DISJUNCTIVE 
				(ASK (CONTINUING-SET-Q INITIATING CONTINUING)
				     (CON-SET (CHOOSE MULTI-ALTERNATIVE-GROUP))
				     (NOT-CON-SET (CHOOSE ALTERNATIVE-GROUP))))))
			 (CONJUNCTIVE (CHOOSE ADDITIVE-GROUP))))
		   (CONTRASTIVE (CHOOSE CONTRASTIVE-GROUP)))) 
 :comments ""
 :editor "Haihua"
 :date "6/17/93 15:00:04")

;;; unchanged apart from addition of English
(askoperator 
 :name CONTRASTIVE-EXTENSION-Q
 :domain TP
 :mode IMPLEMENTED
 :parameters (ONE1 TWO)
 :english ("Is the relation between " ONE1 " and " TWO " one of contrast?")
 :operatorcode CONTRASTIVE-EXTENSION-Q-CODE
 :parameterassociationtypes (CONCEPT CONCEPT)
 :preselectionguidance ((ALTERNATIVE-EXTENDING . NONCONTRASTIVE) 
			(ADDITIVE-EXTENDING . NONCONTRASTIVE)
			(VARYING-EXTENDING . CONTRASTIVE))
 :answerset (CONTRASTIVE NONCONTRASTIVE)
 :trivialdefault NONCONTRASTIVE)

;;; unchanged
(askoperator 
 :name CONJUNCTIVE-EXTENSION-Q
 :domain TP
 :mode IMPLEMENTED
 :parameters (ONE1 TWO)
 :english ("Is the relation between " ONE1 " and " TWO " one of conjunction?")
 :operatorcode CONJUNCTIVE-EXTENSION-Q-CODE
 :parameterassociationtypes (CONCEPT CONCEPT)
 :preselectionguidance ((ALTERNATIVE-EXTENDING . NONCONJUNCTIVE) 
			(ADDITIVE-EXTENDING . CONJUNCTIVE))
 :answerset (CONJUNCTIVE NONCONJUNCTIVE)
 :trivialdefault CONJUNCTIVE)


;;; unchanged
(askoperator 
   :name DISJUNCTIVE-EXTENSION-Q
   :domain TP
   :mode IMPLEMENTED
   :parameters (ONE1 TWO)
   :english ("Is the relation between " ONE1 " and " TWO " one of disjunction?")
   :operatorcode DISJUNCTIVE-EXTENSION-Q-CODE
   :parameterassociationtypes (CONCEPT CONCEPT)
   :preselectionguidance ((ALTERNATIVE-EXTENDING . DISJUNCTIVE))
   :answerset (DISJUNCTIVE NONDISJUNCTIVE)
   :trivialdefault DISJUNCTIVE)

;;; changed
(system
   :name EXPERIENTIAL-ADVERBIAL-MOOD
   :inputs 
           (and EXPERIENTIAL-ADVERBIAL adverbial-group-simplex)
   :outputs 
            ((0.5 WH-ADVERBIAL)
             (0.5 NONWH-ADVERBIAL (CLASSIFY CIRCUMSTANCE ADVERB))) 
   :chooser EXPERIENTIAL-ADVERBIAL-MOOD-CHOOSER
   :selector CHOICE-MASTER
   :old-feature NONWH-ADVERBIAL
   :region ADVERBIAL
   :metafunction IDEATIONAL)


(defvar sample-conjoined-adverbs-spl
 '(disc / nondirected-action 
	:lex discuss 
	:modality should
	:actor (hearer / person) 
	:manner ((care / quality
		       :lex carefully)
		 (th / quality 
		     :lex thoughtfully))))
;;; "You should discuss carefully and thoughtfully."
