;;; -*- lisp -*-
;;; Brian Anger (bdanger@cse.buffalo.edu)
;;; Project: Contextual Vocabulary Acquisition
;;; File: Pyrrhic.demo
;;; Revision: 1.0, 12-Dec-03
;;;
;;; Actual passage:
;;; "In _The Pity of War_ (1998), Ferguson argued that British involvement in
;;; World War I was unnecessary, far too costly in lives and money for any
;;; advantage gained, and a Pyrrhic victory that in many ways contributed to
;;; the end of the Empire."
;;;
;;; Simplified passage:
;;; "British involvement in World War I was unnecessary, more costly in lives
;;; and money than the advantage gained, and a Pyrrhic victory that contributed
;;; to the end of the Empire."
;;;

;; Load the noun definition algorithm.
^(load "/projects/rapaport/CVA/STN2/defun_noun.cl")

;; Reset the network.
(resetnet t)

;; Turn off infer trace.
^(setq snip:*infertrace* nil)

;; Turn off singular path inference.  Redefine the function to return nil so
;; that forward inference will not be limited.
^(in-package snip)
^(defun broadcast-one-report (rep)
   (let (anysent)
     (do.chset (ch *OUTGOING-CHANNELS* anysent)
               (when (isopen.ch ch)
                 (setq anysent (or (try-to-send-report rep ch) anysent)))))
   nil)
^(in-package sneps)

;; Load pre-defined relations.
(intext "/projects/rapaport/CVA/STN2/demos/rels")

;; Load pre-defined path definitions.
(intext "/projects/rapaport/CVA/mkb3.CVA/paths/paths")

;; Define relations for the structure of various expressions.
(define mod head)
(define expr str adj noun)

;; Build frequently-used lex nodes.
(describe (build lex "British")                   = lexBritish)
(describe (build lex "costly in lives and money") = lexCostlyLM)
(describe (build lex "empire")                    = lexEmpire)
(describe (build lex "end of an empire")          = lexEndEmpire)
(describe (build lex "involvement")               = lexInvolvement)
(describe (build lex "political unit")            = lexPolUnit)
(describe (build lex "Pyrrhic victory")           = lexPV)
(describe (build lex "victory")                   = lexVictory)

;;==============================================================================
;; BACKGROUND KNOWLEDGE:
;;==============================================================================

;; Introduce various objects.
(describe (assert object #bBritain   proper-name (build lex "Great Britain")))
(describe (assert object #bTheEmpire proper-name (build lex "The Empire")))
(describe (assert object #bWW1       proper-name (build lex "World War I")))

;; There exists some advantage.
(describe (assert member #bAdv class (build lex "advantage")))

;; There exists some involvement.
(describe (assert member #bInv class *lexInvolvement))

;; "Great Britain" is a political unit.
(describe (assert member *bBritain class *lexPolUnit))

;; "The Empire" is British.
(describe (assert object *bTheEmpire property *lexBritish))

;; "The Empire" is an empire.
(describe (assert object *bTheEmpire class *lexEmpire))

;; There exists some end of the Empire.
(describe (assert member #bEnd class *lexEndEmpire))
(describe (assert object1 *bEnd rel (build lex "of") object2 *bTheEmpire))

;; "World War I" is a war.
(describe (assert member *bWW1 class (build lex "war")))

;; The expression "Pyrrhic victory" consists of an adjective and a noun.
(describe (assert expr *lexPV str (build adj  (build lex "Pyrrhic")
                                         noun *lexVictory)))

;;==============================================================================
;; BACKGROUND KNOWLEDGE RULES:
;;==============================================================================

;; RULE: ADJ-NOUN
;; An ADJ-NOUN where ADJ is not abnormal is a NOUN.
(describe (assert forall ($vANExpr $vAdj $vNoun)
            ant (build expr *vANExpr str (build adj *vAdj noun *vNoun))
            cq  (build subclass *vANExpr superclass *vNoun)))

;; Desired consequent of ADJ-NOUN rule:
;; (describe (assert subclass *lexPV superclass *lexVictory))

;; RULE: BRITISH-EMPIRE
;; If an empire is British, then it is ruled by Great Britain.
(describe (assert forall ($vBritEmp)
            &ant ((build object *vBritEmp
                         property *lexBritish)
                  (build object *vBritEmp
                         class *lexEmpire))
            cq   (build object1 *bBritain
                        rel (build lex "rules")
                        object2 *vBritEmp)))

;; Desired consequent of BRITISH-EMPIRE rule:
;; (describe (assert object1 *bBritain rel (build lex "rules")
;;                   object2 *bTheEmpire))

;; RULE: BRITISH-INVOLVEMENT
;; If X is an involvment and X is British, then it is of Great Britain.
(describe (assert forall ($vBritInv)
            &ant ((build member *vBritInv
                         class *lexInvolvement)
                  (build object *vBritInv
                         property *lexBritish))
            cq   (build object *vBritInv
                        rel *lexInvolvement
                        possessor *bBritain)))

;; Desired consequent of BRITISH-INVOLVEMENT rule:
;; (describe (assert object *bInv possessor *bBritain))

;; RULE: END-OF-EMPIRE
;; If X contributes to the end of the empire E and the political unit P rules
;; the empire E, then X weakens P.
(describe (assert forall ($vContributer $vAnEnd $vPolUnit $vAnEmpire)
            &ant ((build agent *vContributer
                         act (build action (build lex "contributes to")
                                    object *vAnEnd))
                  (build member *vAnEnd
                         class *lexEndEmpire)
                  (build object1 *vAnEnd
                         rel (build lex "of")
                         object2 *vAnEmpire)
                  (build object1 *vPolUnit
                         rel (build lex "rules")
                         object2 *vAnEmpire))
            cq   (build agent *vContributer
                        act (build action (build lex "weakens")
                                   object *vPolUnit))))

;; Desired consequent of END-OF-EMPIRE rule:
;; (describe (assert object1 *bInv rel (build lex "weakens")
;;                   object2 *bBritain))

;; RULE: HEAVY-LOSSES
;; If X is an involvement, W is a war, X is in W, X is costly in lives and
;; money, and X is possessed by Y, then Y incurs heavy losses in W.
(describe (assert forall ($vAnInv $vWar $vPossessor)
            &ant ((build member *vAnInv
                         class *lexInvolvement)
                  (build member *vWar
                         class (build lex "war"))
                  (build object1 *vAnInv
                         rel (build lex "in")
                         object2 *vWar)
                  (build object *vAnInv
                         property *lexCostlyLM)
                  (build object *vAnInv
                         possessor *vPossessor))
            cq   (build object1 *vPossessor
                        rel (build lex "incurs heavy losses in")
                        object2 *vWar)))

;; Desired consequent of HEAVY-LOSSES rule:
;; (describe (assert object1 *bBritain rel (build lex "incurs heavy losses in")
;;                   object2 *bWW1))

;; RULE: WAR-VICTORY
;; If X is an involvement, W is a war, X is in W, X is a victory, and X is
;; possessed by Y, then Y is victorious in W.
(describe (assert forall ($vAnInv $vWar $vPossessor)
            &ant ((build member *vAnInv
                         class *lexInvolvement)
                  (build member *vWar
                         class (build lex "war"))
                  (build object1 *vAnInv
                         rel (build lex "in")
                         object2 *vWar)
                  (build member *vAnInv
                         class *lexVictory)
                  (build object *vAnInv
                         possessor *vPossessor))
            cq   (build object1 *vPossessor
                        rel (build lex "is victorious in")
                        object2 *vWar)))

;; Desired consequent of WAR-VICTORY rule:
;; (describe (assert object1 *bBritain rel (build lex "is victorious in")
;;                   object2 *bWW1))

;; RULE: MEMBER-SUPERCLASS
;; If X is a member of the class Y, and Y is a subclass of the superclass Z,
;; then X is a member of the class Z.
(describe (assert forall ($vMember $vSubClass $vSuperClass)
            &ant ((build member *vMember
                         class *vSubClass)
                  (build subclass *vSubClass
                         superclass *vSuperClass))
            cq   (build member *vMember
                        class *vSuperClass)))

;; Desired consequent of MEMBER-SUPERCLASS rule:
;; (describe (assert member *bInv class *lexVictory))

;;==============================================================================
;; CASSIE READS THE PASSAGE:
;;==============================================================================

;; The involvement was British.
(describe (add object *bInv property *lexBritish))

;; The involvement was in World War I.
(describe (add object1 *bInv rel (build lex "in") object2 *bWW1))

;; The involvement was unnecessary.
(describe (add object *bInv property (build lex "unnecessary")))

;; The involvement was costly in lives and money.
(describe (add object *bInv property *lexCostlyLM))

;; The advantage was gained from the involvement.
(describe (add object1 *bAdv
            rel (build lex "gained from")
            object2 *bInv))

;; The involvement was more costly ... than the advantage (gained from it).
(describe (add object1 *bInv
            rel (build mod (build lex "more") head *lexCostlyLM)
            object2 *bAdv))

;; The involvement was a Pyrrhic victory...
(describe (add member *bInv class *lexPV))

;; ... that contributed to the end of the Empire.
(describe (add agent *bInv
               act (build action (build lex "contributes to")
                          object *bEnd)))

;;==============================================================================
;; CASSIE'S DEFINITION
;;==============================================================================

^(defineNoun "Pyrrhic victory")