; =======================================================================
; FILENAME:	tatterdemalion.demo
; DATE:		DATE
; PROGRAMMER:	Nicholas P. Schwartzmyer



; Lines beginning with a semi-colon are comments.
; Lines beginning with "^" are Lisp commands.
; All other lines are SNePS commands.
;
;
;	          IMPORTANT
; =========================================================
; To use this file: due to the use of SNeBR in this demo
; please run SNePS2.61: 
;
;	:ld /projects/shapiro/Sneps/sneps261
;
;       types (sneps), and at the SNePS prompt (*), type:
;
;	;;;;(demo "Tatterdemalion/tatterdemalion.fullBK.demo" :av)
;	(demo "Tatterdemalion/tatterdemalion.demo" :av)	
;	
; Make sure all necessary files are in the current working directory
; or else use full path names.
;
; WARNING!!!  You *MUST* use the ":av" parameter, since this demo
;		invokes SNeBR, and using :av will tell you what to do!
; =======================================================================

; Turn off inference tracing.
; This is optional; if tracing is desired, then delete this.
 ^(setq snip:*infertrace* nil)

; Load the appropriate definition algorithm:
;;  No accepted adjective algorithm used on this demo
;; 


; Load SNeBRIO for the derived contradiction in this demo:
  ^(load "/projects/shapiro/Sneps/new-snebrio")


; Clear the SNePS network:
(resetnet t)

; OPTIONAL:
; UNCOMMENT THE FOLLOWING CODE TO TURN FULL FORWARD INFERENCING ON:
;
; ;enter the "snip" package:
;^(in-package snip)
;
; ;turn on full forward inferencing:
;^(defun broadcast-one-report (represent)
;   (let (anysent)
;     (do.chset (ch *OUTGOING-CHANNELS* anysent)
;      	 (when (isopen.ch ch)
;         (setq anysent
;	       (or (try-to-send-report represent ch)
;	           anysent)))))
;    nil)
;
; ;re-enter the "sneps" package:
; ^(in-package sneps)

; load all pre-defined relations:
(intext "/projects/rapaport/CVA/STN2/demos/rels")


; define relations necessary for this passage, but absent from the CVA case frame dictionary:
(define mod head obj1 obj2 equiv skolem-function)

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



; THE PASSAGE
; ===========================================================

;  "Trains go almost everywhere, and tickets cost
;   roughly two dollars an hour for  first-class travel 
;   (first-class Romanian-style that is, with tatterdemalion
;   but comfortably upholstered compartments 
;   and equally tatterdemalion but solicitous attendants.)"


; Tayler, J. (1997), "Transylvania Today", The Atlantic Monthly 279(6): 50-54;
; http://www.theatlantic.com/issues/97jun/transyl.htm
; ============================================================



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


;PRAGMATIC BACKGROUND KNOWLEDGE
;==============================



; Geo-Political
; =============


;; There is an object that is a country

(describe (assert member #Romania class (build lex "country")))






;; This country has the name Romania

(describe (assert object *Romania proper-name (build lex "Romania")))






;; It also has the property of being poor

(describe (assert object *Romania property (build lex "impoverished")))






;; Rule: Any head modified by "Romanian" inherits properties of Romania

(describe (assert forall ($a $y $x) 
				   &ant 
		       ((build member *x class            
			(build mod (build lex "Romanian") head *a))
	        	             (build object *Romania property *y))
	     			   cq 
 			            (build object *x property *y)))




;;  Rule: If a class is modified by Romanian, 
;;  then Romanian Class is a subset of Class (whatever that may be), therefore
;;  (presumably) if x is a member of the class Romanian Class,
;;  then it will be a member of the class, Class


;(describe (assert forall (*a *x $mod) 
		;ant (build member *x class (build mod *mod head *a))		
		 ;cq (build member *x class *a)))  




; Infrastructure rules
; ====================



;; Rule: Countries have infrastructure

(describe (assert forall $country 
		ant 
		(build member *country class (build lex "country"))
 		cq 				
		(build object 
			(build skolem-function 
			infrastructure\ of possessor *country) 
		       rel (build lex "infrastructure")
		       possessor *country)))











;; Rule: Traits of nations are transitive with respect to their infrastructure

(describe (assert forall (*country *y) 					
		&ant 
		((build member *country class (build lex "country"))
		(build object *country property *y))
		cq 
		(build object 
			(build skolem-function 
			infrastructure\ of  possessor *country) 
			property *y)))	








;; Rule: Trains are infrastructure

(describe (assert forall $t 
	ant 			
	(build member *t class (build lex "train"))
	cq 
	(build member *t class (build lex "infrastructure"))))







;; Rule for member-class transitivity: 
;; Trains inherit the properties of infrastructure

(describe (assert forall (*country *t *y) 				
	&ant 
	  ((build object 
		(build skolem-function infrastructure\ of possessor *country) 
		property *y)
		(build member *t class (build lex "train")))
	cq 
	(build object *t property *y)))







;; Rule: Parts of trains inherit properties of trains

(describe (assert forall (*t *y $possessed) 
	&ant 
	  ((build member *t class (build lex "train"))
	  (build object1 *t  
  		 rel (build lex "have") 
		 object2 *possessed)
	  (build object *t property *y))
	cq 
	 (build object *possessed property *y))) 




;; Rule: To a good degree, the properties of a train's
;; parts reflect on the properties of the train as a
;;  whole

(describe (assert forall (*t *y *possessed)
	&ant ((build member *t class (build lex "train"))
		(build object1 *t 
			rel (build lex "have")
			object2 *possessed)
		(build object *possessed property *y))
	cq (build object *t property *y)))




		

; First-class rules
; =================


;;  Anything that is First class train travel 
;;  is a member of the more general class of first-class travel


(describe (assert forall $vartrvl 
	ant 
	(build member *vartrvl class 
		       (build mod 
 			  (build mod (build lex "first\ class")
			         head (build lex "train")) 
			      head (build lex "travel")))
	cq 
	(build member *vartrvl class 
			(build mod (build lex "first\ class")
			       head (build lex "travel")))))




;; And from the above, all first class travel is a subclass of travel

(describe (assert  forall *vartrvl 
	ant 
	(build member *vartrvl class 
		(build mod (build lex "first\ class") 
		       head (build lex "travel"))= fctravel)
	cq 
	(build member *vartrvl class (build lex "travel"))))





;; Presumably, and double head-mod construction train travel 
;; is a subclass of first class travel

(describe (assert forall (*mod * head *vartrvl)
	ant 
	(build member *vartrvl class 
			(build mod 
				(build mod 
				(build mod *mod head *head) 
				       head (build lex "train")) 
			head (build lex "travel")))
	 cq 
	(build member *vartrvl class 
			(build mod 
				(build mod (build lex "first\ class") 
				       head (build lex "train"))
			head (build lex "travel")))))




;; This is meant to be general rule that says that forall things,
;; if they are a member of a class train travel that is doubly
;; modified, i.e. [Romanian-style [First Class [train travel]]]
;; then it is also simply train travel.


(describe (assert forall (*mod * head *vartrvl)
	ant 
	(build member *vartrvl class 
			(build mod 
				(build mod 
				(build mod *mod head *head) 
				       head (build lex "train")) 
			head (build lex "travel")))
	 cq 
	(build member *vartrvl class 
			(build mod 
				(build lex "train")
				head 
				(build lex "travel")))))


;; Rule: First class travel is expensive. 
;; More precisely, tickets for first class travel are expensive


(describe (assert forall $tk 
	&ant 
	((build member *tk class (build lex "tickets"))
	(build object1 *tk 
	       rel (build lex "for") 
	       object2 *fctravel))
	cq 
	(build object *tk property (build lex "expensive"))))





;; First class travel has particluar properties, 
;; it is usually comfortable and of high quality, to name a few 


(describe (assert forall *vartrvl 
	ant 
	(build member *vartrvl class *fctravel) 
	cq 
	(build object *vartrvl property 
				(build lex "comfortable"))
	 cq 
	(build object *vartrvl property 
				(build lex "of\ high\ quality"))))
				  


;; If tickets for first class travel cost two dollars 
;; (such as they do in this passage), 
;; then they are not expensive, which means
;;  it is not (actually) first class


(describe (assert forall (*vartrvl *tk) 
	&ant 
		((build member *tk class (build lex "tickets"))
		(build object (build lex "two\ dollars")
	       		rel (build lex "cost")
	       		possessor *tk)	
		(build object1 *tk 
			rel (build lex "for") 
			object2 *vartrvl))	
	cq 
		(build min 0 max 0 
		arg 
		 	(build object *tk 
				property (build lex "expensive"))
		arg 
			(build member *vartrvl class *fctravel))))




;;  So following from the above, is it likely not the case 
;;  that the travel will be so welcoming.  
;;  We will unfortunately eschew some of the modality 
;;  of a NL and opt for strict negation

(describe (assert forall *vartrvl 
	&ant 
	((build member *vartrvl class (build lex "travel"))
	(build object *vartrvl property (build lex "high\ quality")))
	cq 
	(build member *vartrvl class *fctravel)))







; Properties of Properties
; ========================

;; To use with but rule: comfortable is a positive modifier

(describe (assert 
		member (build lex "comfortable") 
		class (build lex "positive attributes")))


;; As above solicitious is a positive modifer

(describe (assert 
		member (build lex "solicitous")
		class (build lex "positive attributes")))



; BUT rule: context specific version
; ==================================


; TODO: Replace with more general rule/rules to capture 
; the semantics of "but" 

; This version basically states that if two attributes opposed
; by "but" and the second is a member of the class positive attributes, 
; then the first will be a member of the class of negative attributes
; This positive/negative distinction seems to capture one 
; basic use of "but"...
; This rule also goes on to equate this member of class negative attributes
; with the very general property "negative quality". 
; Following the CVA group protocol and my reading of the passage,
; I do not think anything of a truly more explicit nature
; can be gleaned about the meaning of "tatterdemalion"

; This needs to be modified as it is too specific: it is not 
; the case that the frist will always be negative in a 'but' 
; relationship, it was merely true for this passage. 


(describe (assert forall ($attribute1 $attribute2)
		&ant ((build object1 *attribute1 
			     rel (build lex "but")
			     object2 *attribute2)
		       (build member *attribute2
			      class (build lex "positive attributes"))) 
		cq (build member *attribute1 
				class (build lex "negative attributes"))
		cq
		   (ant (build object *entity property *attribute1) 
		    cq (build object *entity property (build lex "negative quality")))
		cq (build equiv *attribute1 equiv (build lex "negative quality"))))
		   






;		The Linguistic/Pragmatic Unification Rule
; ================================================================

;;  The following rule is my way to join together the pragmatic context, i.e.
;;  knowledge about Romania (well, actually not so much: that's for the future;
;;  perhaps a rule that states if something is called first class travel in 
;;  an impoverished nation, then its probably not first class travel)
;;  about infrastructure, and about first class travel with the other context,
;;  the linguistic, namely the "but" construction.


;;  What the rule says is this, if something is not first class travel,
;;  which we come to believe about RSFC train travel after we revise
;;  our beliefs, and if there is a train that has qualities in a but
;;  relationship with each other, then the first of these is will 
;;  mean second rate. 

;;  This rule should be an immediate future change. For one,
;;  while the logic mirrors that of the protocols, in the rule,
;;  there is a certain disconnect in the logic--the train ant is
;;  not really linked to the negation of member-class ant,
;;  the train ant should incorporate that these are the trains
;;  used for this not first class travel, and probably that notions
;;  of property inheritance between nations and their trains.

;;  Also see above comments about my usage of the 'but' relationship  


(describe (assert forall (*possessed *vartrvl *attribute1 *attribute2 *t)
	&ant 
	  ((build min 0 max 0 
		    arg
		(build member *vartrvl class *fctravel))
	   ;(build member *vartrvl class
		;			(build mod (build lex "train")
					;	head (build lex "travel")))
	   (build object1 *t 
		  rel (build lex "have")
		  object2 *possessed)
	   (build object *possessed property *attribute1)
	   (build object *possessed property *attribute2) 
	   (build object1 *attribute1 
		  rel (build lex "but")
		  object2 *attribute2))
	cq 
	   (build equiv *attribute1 equiv (build lex "second rate")))))






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



;Trains of Romanian provenance go almost everywhere in Transylvania

(describe (add agent 
		(build  mod (build  lex "Romanian") 
			head (build lex "train"))
	       act 
		(build action (build lex "go\ everywhere\ in") 
		       object (build lex "Transylvania"))))




; Romanian trains are trains

(describe (add member 
		(build mod (build lex "Romanian") 
		       head (build lex "train")) 
	         class (build lex "train")))








;Romanian-style first-class trains are a subclass

(describe (add member 
		(build mod (build mod 
				(build lex "Romanian-style")
		                  head 
				(build lex "first\ class")) 
		      head (build lex "train") = rsfctrain) 
		class 
		  (build mod (build lex "Romanian") 
			 head (build lex "train"))))
	    



;;  Romanian-Style first class train travel 
;; are members of the class of first class travel

(describe (add member 
		(build mod 
		      (build mod 
			(build mod (build lex "Romanian-style")
				head (build lex "first\ class"))
			      head (build lex "train"))
			 head (build lex "travel"))
	       class  
		*fctravel))






;; Contradiction resolution
;; This was supposed to rid the demo of the need for SNeBR,
;; but I've yet to get it working.  

;;   (describe (assert
;;  		&ant ((build member  
;;  	        	(build mod  
;;  				(build mod 
;;  					(build mod (build lex "Romanian-style")
;;  					       head (build lex "first\ class"))  
;;  			      		 head (build lex "train"))
;;  				head (build lex "travel"))
;;  			     class *fctravel)
;;  	     (build min 0 max 0 arg 
;;  	      (build member 
;;  			(build mod  
;;  				(build mod 
;;  					(build mod (build lex "Romanian-style")
;;  					       head (build lex "first\ class"))  
;;  			      		 head (build lex "train"))
;;  				head (build lex "travel"))	
;;  		     class *fctravel)))
;;  	cq (build min 0 max 0 arg
;;  		(build member 
;;  			(build mod  
;;  				(build mod 
;;  					(build mod (build lex "Romanian-style")
;;  					       head (build lex "first\ class"))  
;;  			      		 head (build lex "train"))
;;  				head (build lex "travel"))
;;  			class *fctravel))))





;tickets for RSFC travel exist

(describe (add 
		object1 #ticket 
		rel (build lex "for")
		object2 (build mod 
				(build mod 
					(build mod (build lex "Romanian-style") 
						head (build lex "first\ class"))
					head (build lex "train"))
			       head (build lex "travel"))))



; An object call ticket is a member of the class of tickets

(describe (add member *ticket class (build lex "tickets")))



;; ========================================================
;; IMPORTANT 

;; The following rule will derive the contradiction that will
;; invoke SNeBR. While it is actually in the hands of the 
;; demo-runner as to which hypothesis to discard,
;; the hypothesis that is intended to be discarded is #4,
;; which states that RSFC travel is first class travel.

;; Demo-runner: please enter following commands at SNeBR 
;; prompt:
;; --Type 'r' to restart the run
;; --Type 4 to select this hypothesis 
;; --Type 'd' to delete it from the set
;; --Type 'q' to quit revising the set
;; --Inspecting the other hypotheses is optional, but do not
;;   delete any
;; --Type 'no' when asked if it is desired 
;;   to add a new hypothesis

;; =========================================================
;; MAKE SURE YOU READ THE ABOVE BEFORE HITTING RETURN!!!!!

;  These tickets cost two dollars, 
;  literally, "the tickets have the cost of two dollars"
;  cost is a stative verb, not an act, 
;  thus I am violating the SNePS rule of thumb
;  which uses agent-act-action-object for verbs. 
;  My approach may be novel, but I think, using
;  only pre-established CVA case frames, 
;  it most adequately captures the meaning. 
;  Certain states in languages in fact must be represent 
;  by possession, take Spanish,
;  "Tengo vienticinco anos" or "Tiene frio" 
 

(describe (add object 
		(build lex "two\ dollars") 
		rel 
		(build lex "cost") 
		possessor 
		*ticket))  








;RSFC trains have compartments

(describe (add 	object1 *rsfctrain 
		rel (build lex "have") 
		object2 #compartments))


(describe (add member *compartments class (build lex "compartments")))










;RSFC trains have attendants

(describe (add 	object1 *rsfctrain 
		rel (build lex "have") 
		object2 #attendants))


(describe (add member *attendants class (build lex "attendants")))





;These compartments have the quality of being tatterdemalion 

(describe (add object *compartments 
		property (build lex "tatterdemalion")))








;These compartments are comfortable

(describe (add object *compartments 
		property (build lex "comfortable")))








;  Comfortable/Solicitous and tatterdemalion are in a 
;  "but" relationship with each other


(describe (add object1 (build lex "tatterdemalion")
		rel (build lex "but")
		object2 (build lex "comfortable")))



(describe (add object1 (build lex "tatterdemalion")
		rel (build lex "but")
		object2 (build lex "solicitous")))





;The attendants are tatterdemalion

(describe (add object *attendants 
		property (build lex "tatterdemalion")))








;These attendants are solicitous

(describe (add object *attendants 
		property (build lex "solicitous")))






; Ask Cassie what "tatterdemalion " means:
;=========================================



;			Equivalences
; =====================================================



; Following our "but" rule, tatterdemalion should be equivalent
; to a negative quality:

(describe (deduce 
		equiv (build lex "tatterdemalion") 
		equiv (build lex "negative quality")))


; Cassie agrees!





; Following our unified linguistic/pragmatic rule, 
; the meaning of "tatterdemalion" should be something like
; 'second rate':

(describe (deduce 
		equiv (build lex "tatterdemalion")
		equiv (build lex "second rate")))


; Cassie agrees!



;			Class Membership
; ===============================================================

; Properties can be members of larger class of properties, e.g.
; the property 'green' is a member of the class of properties
;  we refer to as 'colors'

;  Following the protocols, the most we can say about "tatterdemalion"
;  is that it is (probably) a negative attribute, let us see
;  if Cassie agrees, following the rules given to her:
 
(deduce member (build lex "tatterdemalion") class (build lex "negative attributes"))


;  She does.



; 			Modified Entities
;  ===============================================================

; Lets find the nodes with object- property arc with "tatterdemalion":

(dump (find (object- property) (build lex "tatterdemalion")))



; And what are these entities?

(describe m118 m121)