;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; train.scm
;;
;; Train Example
;;
;; $Id: train.scm 2156 2008-01-25 13:25:12Z schimans $
;;
;; Markus Sauermann
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; load integers, unary natural numbers and a fitting representation
(exload "train/index2int.scm")



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Sections
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(add-alg "section"
         '("Scon" "int=>section")
         '("Sundef" "section"))
(av "s" (py "section"))

(add-program-constant "nexts" (py "section=>section") 1 'const 1)
(add-program-constant "prevs" (py "section=>section") 1 'const 1)
(add-computation-rule (pt "nexts (Scon z)") (pt "Scon (z/+Ipos One)")) ;; def
(add-computation-rule (pt "prevs (Scon z)") (pt "Scon (z/+Ineg One)")) ;; def
(add-computation-rule (pt "prevs Sundef") (pt "Sundef")) ;; def
(add-computation-rule (pt "nexts Sundef") (pt "Sundef")) ;; def
(add-rewrite-rule (pt "nexts (prevs s)") (pt "s")) ;; lemma
(add-rewrite-rule (pt "prevs (nexts s)") (pt "s")) ;; lemma


(add-program-constant "EqSec" (py "section=>section=>boole") 1 'const 2)
(add-computation-rule (pt "EqSec (Scon z1) (Scon z2)") (pt "z1=z2")) ;; def
(add-computation-rule (pt "EqSec Sundef (Scon z)") (pt "False")) ;; def
(add-computation-rule (pt "EqSec (Scon z) Sundef") (pt "False")) ;; def
(add-computation-rule (pt "EqSec Sundef Sundef") (pt "True")) ;; def
(add-rewrite-rule (pt "EqSec s s") (pt "True")) ;; lemma
(add-rewrite-rule (pt "EqSec (Scon z) (nexts (Scon z))") (pt "False")) ;; lemma
(add-rewrite-rule (pt "EqSec (prevs (Scon z)) (Scon z)") (pt "False")) ;; lemma
(add-rewrite-rule (pt "EqSec (prevs s1) (prevs s2)") (pt "EqSec s1 s2"));;lemma

(aga "axiom-sectionequal=" (pf "all s1,s2. EqSec s1 s2 -> s1 = s2")) ;; axiom

(set-goal (pf "all s1,s2.(((nexts s1)=(nexts s2)) -> (s1=s2)) & ((s1=s2) -> ((nexts s1)=(nexts s2)))"))
(cases)
(assume "z1")
(cases)
(assume "z2")
(split)
(assume 1)
(ng)
(use "intIdPred" (pt "Ipos One"))
(use 1)
(assume 1)
(simp 1)
(use "Truth-Axiom")
(split)
(assume 1)
(use 1)
(assume 1)
(use 1)
(cases)
(assume "z2")
(search)
(search)
(save "zugHelper1")


(add-program-constant "LtSec" (py "section=>section=>boole") 1 'const 2)
(add-computation-rule (pt "LtSec (Scon z1) (Scon z2)") (pt "intLess z1 z2")) ;; def
(add-computation-rule (pt "LtSec Sundef s") (pt "False")) ;; def
(add-computation-rule (pt "LtSec (Scon z) Sundef") (pt "False")) ;; def
(add-rewrite-rule (pt "LtSec s s") (pt "False")) ;; axiom
(add-rewrite-rule (pt "LtSec (Scon z) (nexts (Scon z))") (pt "True")) ;; lemma
(add-rewrite-rule (pt "LtSec (prevs (Scon z)) (Scon z)") (pt "True")) ;; lemma
(add-rewrite-rule (pt "LtSec (prevs s1) (prevs s2)") (pt "LtSec s1 s2"));;lemma
(add-rewrite-rule (pt "LtSec (nexts s1) (nexts s2)") (pt "LtSec s1 s2"));;lemma


(add-program-constant "LeSec" (py "section=>section=>boole") 1 'const 2)
(add-computation-rule (pt "LeSec Sundef (Scon z)") (pt "False")) ;; def
(add-computation-rule (pt "LeSec (Scon z) Sundef") (pt "False")) ;; def
(add-computation-rule (pt "LeSec Sundef Sundef") (pt "True")) ;; def
(add-computation-rule (pt "LeSec (Scon z1) (Scon z2)") (pt "intLeq z1 z2")) ;; def
(add-rewrite-rule (pt "LeSec s s") (pt "True")) ;; lemma
(add-rewrite-rule (pt "LeSec s (nexts s)") (pt "True")) ;; lemma
(add-rewrite-rule (pt "LeSec (prevs s) s") (pt "True")) ;; lemma
(add-rewrite-rule (pt "LeSec (prevs s1) (prevs s2)") (pt "LeSec s1 s2"));;lemma
(add-rewrite-rule (pt "LeSec (nexts s1) (nexts s2)") (pt "LeSec s1 s2"));;lemma

(add-program-constant "ds" (py "section=>boole") 1 'const 1)
(add-computation-rule (pt "ds (Scon z)") (pt "True"))
(add-computation-rule (pt "ds Sundef") (pt "False"))

(set-goal (pf "all s1,s2. s1=s2 -> (nexts s1)=(nexts s2)"))
(assume "s1" "s2" 1)
(simp 1)
(use "Truth-Axiom")
(save "lemma-=-nexts-rewrite")

(set-goal (pf "all z.ds (prevs (Scon z))=True"))
(assume "z")
(cases (pt "(prevs (Scon z))"))
(assume "z1" 1)
(use "Truth-Axiom")
(assume 1)
(use (pf "nexts(prevs (Scon z)) = nexts Sundef"))
(use "lemma-=-nexts-rewrite")
(use 1)
(save "lemma-ds-prevs-rewrite")
(add-rewrite-rule (pt "ds (prevs (Scon z))") (pt "True"))
(add-rewrite-rule (pt "ds (nexts (Scon z))") (pt "True"))

(set-goal (pf "all s. (ds s) -> (LtSec (prevs s) s)"))
(cases)
(assume "z" 1)
(ng)
(simp "intPlusComm")
(use (pf "intLess(Ineg One/+z)(IZero/+z)"))
(simp "intIdLessLeqPred")
(use "Truth-Axiom")
(assume 1)
(use 1)
(save "lemma-ds-prevs-LtSec")

(set-goal (pf "all s. (prevs s) = s -> s = Sundef"))
(cases)
(assume "z" 1)
(ng)
(use (pf "Ineg One=IZero"))
(use "intIdPred" (pt "z"))
(simp "intPlusComm")
(use 1)
(assume 1)
(use "Truth-Axiom")
(save "lemma-prevs-eq-Sundef")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Trains
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(add-alg "train"
	 '("Tcon" "index=>train")
	 '("Tundef" "train"))
(av "t" (py "train"))

(add-program-constant "dt" (py "train=>boole") 1 'const 1)
(add-computation-rule (pt "dt Tundef") (pt "False"))
(add-computation-rule (pt "dt (Tcon i)") (pt "True"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Chioce functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(av "initocc" (py "section=>train"))
(av "initloc" (py "train=>section"))
(av "cleft" (py "index=>boole"))
(av "cs" (py "index=>section"))

;; (aga "lemma-initloc-total" (pf "all initloc,i. ds(initloc (Tcon i))"))
;; replaced by weaker axiom-initocc-undef
;; (aga "axiom-initocc-undef" (pf "all initocc. initocc Sundef = Tundef"));;axi
;; replaced by axiom-cs-total
(aga "axiom-cs-total" (pf "all cs,i. (cs i) = Sundef -> F")) ;; axiom

(set-goal (pf "all cs,i. ds(cs i)"))
(assume "cs" "i")
(cases (pt "cs i"))
(assume "z" 1)
(use "Truth-Axiom")
(assume 1)
(use "axiom-cs-total" (pt "cs") (pt "i"))
(use 1)
(save "lemma-ds-cs-total")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Definition of occupancy
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(add-program-constant "occ"
                      (py "(section=>train)=>(index=>boole)=>(index=>section)=>
                           index=>section=>train")
                      1 'const 5)
;; (remove-program-constant "occ")

(add-computation-rule (pt "occ initocc cleft cs Begin s") (pt "initocc s"))
(add-computation-rule
 (pt "occ initocc cleft cs (Next i) s")
 (pt "[if (cleft i)
          [if ((cs i) = (nexts s))
              (([t1] ([if (dt t1) t1 (occ initocc cleft cs i (nexts s))]))
               (occ initocc cleft cs i s))
              [if ((cs i) = s)
                  [if (dt (occ initocc cleft cs i (prevs s)))
                      (occ initocc cleft cs i s)
                      Tundef]
                  (occ initocc cleft cs i s)]]
          [if ((cs i) = (prevs s))
              (([t1] ([if (dt t1) t1 (occ initocc cleft cs i (prevs s))]))
               (occ initocc cleft cs i s))
              [if ((cs i) = s)
                  [if (dt (occ initocc cleft cs i (nexts s)))
                      (occ initocc cleft cs i s)
                      Tundef]
                  (occ initocc cleft cs i s)]]]"))
;; (remove-computation-rules-for (pt "occc initocc cleft cs (Next i) s"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Definition of location
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(add-program-constant "loc"
                      (py "(section=>train)=>(train=>section)=>(index=>boole)=>
                           (index=>section)=>index=>train=>section")
                      1 'const 6)
;; (remove-program-constant "loc")
(add-computation-rule (pt "loc initocc initloc cleft cs Begin t")
                      (pt "initloc t"))
(add-computation-rule
 (pt "loc initocc initloc cleft cs (Next i) t")
 (pt "([s1]
       ([if ((cs i) = s1)
            [if (cleft i)
                [if (dt (occ initocc cleft cs i (prevs s1))) s1 (prevs s1)]
                [if (dt (occ initocc cleft cs i (nexts s1))) s1 (nexts s1)]]
            s1]))
      (loc initocc initloc cleft cs i t)"))
;; (remove-computation-rules-for(pt "loc initocc initloc cleft cs (Next i) t"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; global assumptions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(aga "trans-<=-<-=-scon"
     (pf "all z1,z2,z3,z4. LeSec (Scon z1) (Scon z2) ->
                           LtSec (Scon z2) (Scon z3) ->
                           EqSec (Scon z3) (Scon z4) ->
                           LtSec (Scon z1) (Scon z4)"))
(aga "trans-=-<-<=-scon"
     (pf "all z1,z2,z3,z4. EqSec (Scon z1) (Scon z2) ->
                           LtSec (Scon z2) (Scon z3) ->
                           LeSec (Scon z3) (Scon z4) ->
                           LtSec (Scon z1) (Scon z4)"))
(aga "trans-<-<"
     (pf "all z1,z2,z3. LtSec (Scon z1) (Scon z2) ->
                        LtSec (Scon z2) (Scon z3) ->
                        LtSec (Scon z1) (Scon z3)"))
(aga "trans-<=-<=-scon"
     (pf "all z1,z2,z3. LeSec (Scon z1) (Scon z2) ->
                        LeSec (Scon z2) (Scon z3) ->
                        LeSec (Scon z1) (Scon z3)"))

(aga "lemma1-r" ;; for proof see lemma1-l
     (pf "all initocc,initloc,cleft,cs,i,i0.
          LeSec (loc initocc initloc cleft cs (Next i) (Tcon i0))
                           (nexts(loc initocc initloc cleft cs i (Tcon i0)))"))
(aga "lemma2-r" ;; for proof see lemma2-l
     (pf "all initocc,initloc,cleft,cs,i,i0.
          ((cleft i) -> F) -> (LeSec
                        (loc initocc initloc cleft cs i (Tcon i0))
                        (loc initocc initloc cleft cs (Next i) (Tcon i0)))"))
(aga "sectionSym"
     (pf "all s1,s2. (EqSec s1 s2) = (EqSec s2 s1)"))
(aga "lemma-<ps"
     (pf "all s1,s2, boole.
          (LtSec s1 s2) ->
          (EqSec s1 (prevs s2) -> boole) ->
          (LtSec s1 (prevs s2) -> boole) ->
          boole"))
(aga "lessimpleq" (pf "all s1,s2. (LtSec s1 s2) ->
                                  (LeSec (nexts s1) s2)"))

(aga "lemma-loc-passive"
     (pf "all initocc, initloc, cleft, cs, i, i0.
          ((cs i)=(loc initocc initloc cleft cs i (Tcon i0)) -> F) ->
          (loc initocc initloc cleft cs (Next i) (Tcon i0))=
          (loc initocc initloc cleft cs i (Tcon i0))"))
(aga "lemma-loc-active-left-full"
     (pf "all initocc,initloc,cleft,cs,i,i0.
          (cs i) = (loc initocc initloc cleft cs i (Tcon i0)) ->
          (cleft i) ->
          (dt (occ initocc cleft cs i
                   (prevs (loc initocc initloc cleft cs i (Tcon i0))))) ->
          (loc initocc initloc cleft cs (Next i) (Tcon i0)) =
          (loc initocc initloc cleft cs i (Tcon i0))"))
(aga "lemma-loc-active-right-full"
     (pf "all initocc,initloc,cleft,cs,i,i0.
          (cs i) = (loc initocc initloc cleft cs i (Tcon i0)) ->
          ((cleft i) -> F) ->
          (dt (occ initocc cleft cs i
                   (nexts (loc initocc initloc cleft cs i (Tcon i0))))) ->
          (loc initocc initloc cleft cs (Next i) (Tcon i0)) =
          (loc initocc initloc cleft cs i (Tcon i0))"))
(aga "lemma-occ-right-next-full"
     (pf "all initocc,initloc,cleft,cs,i,s.
          ((cleft i) -> F) ->
          (cs i) = (prevs s) ->
          (dt (occ initocc cleft cs i s)) ->
          (occ initocc cleft cs (Next i) s) = (occ initocc cleft cs i s)"))
(aga "lemma-occ-left-next-empty"
     (pf "all initocc,initloc,cleft,cs,i,s.
          (cleft i) ->
          (cs i) = (nexts s) ->
          ((dt (occ initocc cleft cs i s)) -> F) ->
          (occ initocc cleft cs (Next i) s) =
          (occ initocc cleft cs i (nexts s))"))
(aga "lemma-occ-right-next-empty"
     (pf "all initocc,initloc,cleft,cs,i,s.
          ((cleft i) -> F) ->
          (cs i) = (prevs s) ->
          ((dt (occ initocc cleft cs i s)) -> F) ->
          (occ initocc cleft cs (Next i) s) =
          (occ initocc cleft cs i (prevs s))"))
(aga "lemma-occ-left-present-full"
     (pf "all initocc,initloc,cleft,cs,i,s.
          (cleft i) ->
          (cs i) = s ->
          (dt (occ initocc cleft cs i (prevs s))) ->
          (occ initocc cleft cs (Next i) s) =
          (occ initocc cleft cs i s)"))
(aga "lemma-occ-right-present-full"
     (pf "all initocc,initloc,cleft,cs,i,s.
          ((cleft i) -> F) ->
          (cs i) = s ->
          (dt (occ initocc cleft cs i (nexts s))) ->
          (occ initocc cleft cs (Next i) s) =
          (occ initocc cleft cs i s)"))
(aga "lemma-loc-active-left-empty"
     (pf "all initocc,initloc,cleft,cs,i,i0.
          (cleft i) ->
          (cs i) = (loc initocc initloc cleft cs i (Tcon i0)) ->
          ((dt (occ initocc cleft cs i
                   (prevs (loc initocc initloc cleft cs i (Tcon i0))))) -> F) ->
          (loc initocc initloc cleft cs (Next i) (Tcon i0)) =
          (prevs (loc initocc initloc cleft cs i (Tcon i0)))"))
(aga "lemma-loc-active-right-empty"
     (pf "all initocc,initloc,cleft,cs,i,i0.
          ((cleft i) -> F) ->
          (cs i) = (loc initocc initloc cleft cs i (Tcon i0)) ->
          ((dt (occ initocc cleft cs i
                   (nexts (loc initocc initloc cleft cs i (Tcon i0))))) -> F) ->
          (loc initocc initloc cleft cs (Next i) (Tcon i0)) =
          (nexts (loc initocc initloc cleft cs i (Tcon i0)))"))
(aga "lemma-occ-left-else"
     (pf "all initocc,initloc,cleft,cs,i,s.
          (cleft i) ->
          ((cs i) = (nexts s) -> F) ->
          ((cs i) = s -> F) ->
          (occ initocc cleft cs (Next i) s) =
          (occ initocc cleft cs i s)"))
(aga "lemma-occ-right-else"
     (pf "all initocc,initloc,cleft,cs,i,s.
          ((cleft i) -> F) ->
          ((cs i) = (prevs s) -> F) ->
          ((cs i) = s -> F) ->
          (occ initocc cleft cs (Next i) s) =
          (occ initocc cleft cs i s)"))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; proven lemmata
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; lemma-helper-1
(set-goal (pf "all initocc,initloc,cleft,cs,i0,s,i1,i2.
               loc initocc initloc cleft cs i1 (Tcon i0)=s ->
               i1=i2 ->
               loc initocc initloc cleft cs i2 (Tcon i0)=s"))
(strip)
(simp "<-" 2)
(use 1)
(save "lemma-helper-1")

;; lemma-helper-2
(set-goal
 (pf "all initocc,initloc,cleft,cs,i0,s,i1,i2.
          (loc initocc initloc cleft cs i1 (Tcon i0)=s) ->
          ((loc initocc initloc cleft cs i2 (Tcon i0)=s) -> F) ->
          i1 = i2 ->
          F"))
(assume "initocc" "initloc" "cleft" "cs" "i0" "s" "i1" "i2" 1 2 3)
(use 2)
(simp "<-" 3)
(use 1)
(save "lemma-helper-2")



;; lemma-occ-left-next-full
(set-goal (pf "all initocc,initloc,cleft,cs,i,s.
               (cleft i) ->
               (cs i) = (nexts s) ->
               (dt (occ initocc cleft cs i s)) ->
               (occ initocc cleft cs (Next i) s) =
               (occ initocc cleft cs i s)"))
(assume "initocc" "initloc" "cleft" "cs")
(assume "i")
(cases)
(assume "z" 1 2 3)
(ng)
(simp 1)
(simp 2)
(simp 3)
(use "Truth-Axiom")
(assume 1 2 3)
(simp 2)
(use "Truth-Axiom")
(save "lemma-occ-left-next-full")


;; trans-=-<-<=
(set-goal (pf "all s1,s2,s3,s4. EqSec s1 s2 ->
                                LtSec s2 s3 ->
                                LeSec s3 s4 ->
                                LtSec s1 s4"))
(cases)
(assume "z1")
(cases)
(assume "z2")
(cases)
(assume "z3")
(cases)
(assume "z4")
(use "trans-=-<-<=-scon")
(assume 1 2 3)
(use 3)
(assume "s4" 1 2 3)
(use "Efq")
(use 2)
(assume "s3" "s4" 1 2 3)
(use "Efq")
(use 2)
(cases)
(assume "z2" "s3" "s4" 1 2 3)
(use 1)
(assume "s3" "s4" 1 2 3)
(use 2)
(save "trans-=-<-<=")

;; trans-<=-<-=
(set-goal (pf "all s1,s2,s3,s4. LeSec s1 s2 ->
                                LtSec s2 s3 ->
                                EqSec s3 s4 ->
                                LtSec s1 s4"))
(cases)
(assume "z1")
(cases)
(assume "z2")
(cases)
(assume "z3")
(cases)
(assume "z4")
(use "trans-<=-<-=-scon" (pt "z2") (pt "z3"))
(assume 1 2 3)
(use 3)
(assume "s4" 1 2 3)
(use "Efq")
(use 2)
(assume "s3" "s4" 1 2 3)
(use "Efq")
(use 2)
(cases)
(assume "z2" "s3" "s4" 1 2 3)
(use 1)
(assume "s3" "s4" 1 2 3)
(use 2)
(save "trans-<=-<-=")

;; lemma-ds-prevs
(set-goal (pf "all s. ds(s) -> ds(prevs s)"))
(cases)
(assume "z" 1)
(use "Truth-Axiom")
(assume 1)
(use 1)
(save "lemma-ds-prevs")

;; lemma-ds-nexts
(set-goal (pf "all s. ds(s) -> ds(nexts s)"))
(cases)
(assume "z" 1)
(use "Truth-Axiom")
(assume 1)
(use 1)
(save "lemma-ds-nexts")


;; trans-<=-<="
(set-goal (pf "all s1,s2,s3. LeSec s1 s2 ->
                             LeSec s2 s3 ->
                             LeSec s1 s3"))
(cases)
(assume "z1")
(cases)
(assume "z2")
(cases)
(assume "z3")
(use "trans-<=-<=-scon")
(assume 1 2)
(use 2)
(assume "s3" 1 2)
(use "Efq")
(use 1)
(cases)
(assume "z2" "s3" 1 2)
(use "Efq")
(use 1)
(assume "s3" 1 2)
(use 2)
(save "trans-<=-<=")


;; lemma-lessequal-rewrite-1
(set-goal (pf "all s1,s2. LeSec (nexts s1) (nexts s2)=LeSec s1 s2"))
(strip)
(use "Truth-Axiom")
(save "lemma-lessequal-rewrite-1")


;; lemma-lessequal-prevs-nexts
(set-goal (pf "all s. LeSec (prevs s) (nexts s)"))
(cases)
(assume "z")
(ng)
(simp "intPlusComm")
(simp-with "intPlusComm" (pt "z") (pt "Ipos One"))
(simp "intIdLessLeqPred")
(use "Truth-Axiom")
(use "Truth-Axiom")
(save "lemma-lessequal-prevs-nexts")

;;lemma-ds-help-1
(set-goal (pf "all s. (ds s) -> s=(nexts s) -> F"))
(cases)
(assume "z" 1 2)
(ng)
(use (pf "IZero=Ipos One"))
(use "intIdPred" (pt "z"))
(simp "intPlusComm")
(simp-with "intPlusComm" (pt "Ipos One") (pt "z"))
(use 2)
(assume 1 2)
(use 1)
(save "lemma-ds-help-1")

;;lemma-ds-help-2
(set-goal (pf "all s. (ds s) -> (prevs s)=s -> F"))
(cases)
(assume "z" 1 2)
(ng)
(use (pf "Ineg One=IZero"))
(use "intIdPred" (pt "z"))
(simp "intPlusComm")
(simp-with "intPlusComm" (pt "IZero") (pt "z"))
(use 2)
(assume 1 2)
(use 1)
(save "lemma-ds-help-2")

;;lemma-ds-help-3
(set-goal (pf "all s. (ds s) -> LtSec s s -> F"))
(cases)
(assume "z" 1 2)
(use 2)
(assume 1 2)
(use 1)
(save "lemma-ds-help-3")

;; lemma3
(set-goal
 (pf "all initocc,initloc,cleft,cs,i,i0.
          (initocc (initloc (Tcon i0)) = (Tcon i0)) ->
          (occ initocc cleft cs i
               (loc initocc initloc cleft cs i (Tcon i0)))=(Tcon i0)"))
(assume "initocc" "initloc" "cleft" "cs")
(ind)
(assume "i0" "H1")
(use "H1")
(assume "i" "IV" "i0" "base-hyp")
(cases (pt "cleft i"))
(assume "H1")
(cases (pt "(cs i) = (nexts (loc initocc initloc cleft cs i (Tcon i0)))"))
(assume "H2")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0") "?")
(simp-with "lemma-occ-left-next-full"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "loc initocc initloc cleft cs i(Tcon i0)") "H1" "H2" "?")
(use "IV")
(use "base-hyp")
(simp "IV")
(use "Truth-Axiom")
(use "base-hyp")
(assume "H3")
(use "axiom-cs-total" (pt "cs") (pt "i"))
(use "lemma-prevs-eq-Sundef")
(simp-with (pf "prevs(cs i) = (prevs(nexts(loc initocc initloc cleft cs i(Tcon i0))))"))
(simp "<-" "H3")
(use "Truth-Axiom")
(simp "<-" "H2")
(use "Truth-Axiom")
(assume "H2")
(cases (pt "(cs i) = (loc initocc initloc cleft cs i (Tcon i0))"))
(assume "H3")
(cases (pt "dt (occ initocc cleft cs i
                    (prevs (loc initocc initloc cleft cs i (Tcon i0))))"))
(assume "H4")
(simp-with "lemma-loc-active-left-full"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0") "H3" "H1" "H4")
(simp-with "lemma-occ-left-present-full"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "(loc initocc initloc cleft cs i(Tcon i0))")
          "H1" "H3" "H4")
(use "IV")
(use "base-hyp")
(assume "H4")
(simp-with "lemma-loc-active-left-empty"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0") "H1" "H3" "H4")
(simp-with "lemma-occ-left-next-empty"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "(prevs(loc initocc initloc cleft cs i(Tcon i0)))")
           "H1" "H3" "H4")
(use "IV")
(use "base-hyp")
(assume "H3")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0")
           "H3")
(simp-with "lemma-occ-left-else"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "(loc initocc initloc cleft cs i(Tcon i0))")
           "H1" "H2" "H3")
(use "IV")
(use "base-hyp")
(assume "H1")
(cases (pt "(cs i) = (prevs (loc initocc initloc cleft cs i (Tcon i0)))"))
(assume "H2")
(assert (pf "cs i=(loc initocc initloc cleft cs i(Tcon i0)) -> F"))
(assume "H3")
(use "axiom-cs-total" (pt "cs") (pt "i"))
(use "lemma-prevs-eq-Sundef")
(simp-with (pf "prevs(cs i) = prevs(loc initocc initloc cleft cs i(Tcon i0))"))
(simp "H2")
(use "Truth-Axiom")
(simp "H3")
(use "Truth-Axiom")
(assume "A2")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0") "A2")
(assert (pf "dt (occ initocc cleft cs i
                     (loc initocc initloc cleft cs i(Tcon i0)))"))
(simp "IV")
(use "Truth-Axiom")
(use "base-hyp")
(assume "L2")
(simp-with "lemma-occ-right-next-full"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "(loc initocc initloc cleft cs i(Tcon i0))")
           "H1" "H2" "L2")
(use "IV")
(use "base-hyp")
(assume "H2")
(cases (pt "cs i=loc initocc initloc cleft cs i(Tcon i0)"))
(assume "H3")
(cases (pt "dt(occ initocc cleft cs i
                   (nexts (loc initocc initloc cleft cs i (Tcon i0))))"))
(assume "H4")
(simp-with "lemma-loc-active-right-full"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0")
           "H3" "H1" "H4")
(simp-with "lemma-occ-right-present-full"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "(loc initocc initloc cleft cs i(Tcon i0))")
           "H1" "H3" "H4")
(use "IV")
(use "base-hyp")
(assume "H4")
(simp-with "lemma-loc-active-right-empty"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0")
           "H1" "H3" "H4")
(simp-with "lemma-occ-right-next-empty"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "nexts(loc initocc initloc cleft cs i(Tcon i0))")
           "H1" "H3" "H4")
(use "IV")
(use "base-hyp")
(assume "H3")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0")
           "H3")
(simp-with "lemma-occ-right-else"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "(loc initocc initloc cleft cs i(Tcon i0))")
           "H1" "H2" "H3")
(use "IV")
(use "base-hyp")
(save "lemma3")

;; lemma 1-l
(set-goal (pf "all initocc,initloc,cleft,cs,i,i0.
          LeSec (prevs(loc initocc initloc cleft cs i (Tcon i0)))
                           (loc initocc initloc cleft cs (Next i) (Tcon i0))"))
(assume "initocc" "initloc" "cleft" "cs")
(assume "i" "i0")
(cases (pt "(cs i=loc initocc initloc cleft cs i(Tcon i0))"))
(assume "H1")
(simp "H1")
(cases (pt "cleft i"))
(assume "H2")
(cases (pt "dt(occ initocc cleft cs i
                   (prevs(loc initocc initloc cleft cs i(Tcon i0))))"))
(assume "H3")
(use "Truth-Axiom")
(assume "H3")
(use "Truth-Axiom")
(assume "H2")
(cases (pt "dt(occ initocc cleft cs i
                   (nexts(loc initocc initloc cleft cs i(Tcon i0))))"))
(assume "H3")
(use "Truth-Axiom")
(assume "H3")
(use "lemma-lessequal-prevs-nexts")
(assume "H1")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i0") "H1")
(use "Truth-Axiom")
(save "lemma1-l")

;; lemma2-l
(set-goal (pf "all initocc,initloc,cleft,cs,i,i0.
          (cleft i) -> (LeSec
                        (loc initocc initloc cleft cs (Next i) (Tcon i0))
                        (loc initocc initloc cleft cs i (Tcon i0)))"))
(assume "initocc" "initloc" "cleft" "cs" "i" "i0" "H1")
(simp "H1")
(cases (pt "(cs i) = (loc initocc initloc cleft cs i(Tcon i0))"))
(assume "H2")
(cases (pt "dt (occ initocc cleft cs i
                    (prevs(loc initocc initloc cleft cs i(Tcon i0))))"))
(assume "H3")
(use "Truth-Axiom")
(assume "H3")
(use "Truth-Axiom")
(assume "H2")
(use "Truth-Axiom")
(save "lemma2-l")




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 1: No overtake
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(set-goal (pf "all initocc,initloc,cleft,cs,i1,i2.
               initocc (initloc (Tcon i1)) = (Tcon i1) ->
               initocc (initloc (Tcon i2)) = (Tcon i2) ->
               LtSec (initloc (Tcon i1)) (initloc (Tcon i2)) ->
               all i (LtSec
                      (loc initocc initloc cleft cs i (Tcon i1))
                      (loc initocc initloc cleft cs i (Tcon i2)))"))
(assume "initocc" "initloc" "cleft" "cs" "i1" "i2")
(assume "hyp-t1" "hyp-t2" "base-hyp")
(ind)
(use "base-hyp")
(assume "i" "IV")
(cases (pt "cleft i"))
(assume "H1")
(cases (pt "(cs i) = (loc initocc initloc cleft cs i (Tcon i1))"))
(assume "H2")
(use-with "trans-<=-<-="
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i2)")
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i2)")
         "?" "?" "?")
(use "lemma2-l")
(use "H1")
(use "IV")
(simp "sectionSym")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i2") "?")
(use "Truth-Axiom")
(assume "H3")
(use "lemma-ds-help-3" (pt "(loc initocc initloc cleft cs i(Tcon i1))"))
(simp "<-" "H2")
(use "lemma-ds-cs-total")
(simphyp "IV" "<-" "H3")
(simphyp 8 "H2")
(use 9)
(assume "H2")
(cases (pt "(cs i) = loc initocc initloc cleft cs i (Tcon i2)"))
(assume "H3")
(use-with "lemma-<ps"
          (pt "loc initocc initloc cleft cs i (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i2)")
          (pt "LtSec (loc initocc initloc cleft cs (Next i) (Tcon i1))
                           (loc initocc initloc cleft cs (Next i) (Tcon i2))")
          "IV" "?" "?")
(assume "H4")
(simp-with "lemma-loc-passive"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i1") "H2")
(simp-with "lemma-loc-active-left-full"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i2")
	  "H3" "H1" "?")
(use "IV")
(simp-with "<-" "axiom-sectionequal="
           (pt "(loc initocc initloc cleft cs i(Tcon i1))")
           (pt "(prevs(loc initocc initloc cleft cs i(Tcon i2)))") "H4")
(simp-with "lemma3"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i1") "hyp-t1")
(use "Truth-Axiom")
(assume "H4")
(use-with "trans-=-<-<="
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i1)")
          (pt "prevs(loc initocc initloc cleft cs i (Tcon i2))")
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i2)")
          "?" "?" "?")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i1") "H2")
(use "Truth-Axiom")
(use "H4")
(use-with "lemma1-l"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i2"))
(assume "H3")
(simp-with "lemma-loc-passive"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i1") "H2")
(simp-with "lemma-loc-passive"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i2") "H3")
(use "IV")
(assume "H1")
(cases (pt "(cs i) = (loc initocc initloc cleft cs i (Tcon i2))"))
(assume "H2")
(use-with "trans-=-<-<="
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i2)")
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i2)")
         "?" "IV" "?")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i1") "?")
(use "Truth-Axiom")
(assume "H3")
(use "lemma-ds-help-3" (pt "(loc initocc initloc cleft cs i(Tcon i1))"))
(simp "<-" "H3")
(use "lemma-ds-cs-total")
(simphyp "IV" "<-" "H2")
(simphyp 8 "H3")
(use 9)
(use-with "lemma2-r"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i2")
          "H1")
(assume "H2")
(cases (pt "(cs i) = loc initocc initloc cleft cs i (Tcon i1)"))
(assume "H3")
(use-with "lemma-<ps"
          (pt "loc initocc initloc cleft cs i (Tcon i1)")
          (pt "loc initocc initloc cleft cs i (Tcon i2)")
          (pt "LtSec (loc initocc initloc cleft cs (Next i) (Tcon i1))
                           (loc initocc initloc cleft cs (Next i) (Tcon i2))")
          "IV" "?" "?")
(assume "H4")
(simp-with "lemma-loc-active-right-full"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i1")
          "?" "H1" "?")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i2") "H2")
(use "IV")
(simp-with "axiom-sectionequal="
           (pt "(loc initocc initloc cleft cs i(Tcon i1))")
           (pt "(prevs(loc initocc initloc cleft cs i(Tcon i2)))") "H4")
(ng)
(simp-with "lemma3"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i2") "hyp-t2")
(use "Truth-Axiom")
(use "H3")
(assume "H4")
(use-with "trans-<=-<-="
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i1)")
          (pt "prevs(loc initocc initloc cleft cs i (Tcon i2))")
          (pt "loc initocc initloc cleft cs i (Tcon i2)")
          (pt "loc initocc initloc cleft cs (Next i) (Tcon i2)")
          "?" "?" "?")
(use "trans-<=-<=" (pt "nexts(loc initocc initloc cleft cs i (Tcon i1))"))
(use "lemma1-r")
(use "lessimpleq")
(use "H4")
(use "lemma-ds-prevs-LtSec")
(use (pf "all cs,s1,s2. (ds s1) -> (LtSec s1 s2) -> (ds s2)") (pt "cs") (pt "loc initocc initloc cleft cs i(Tcon i1)"))
(assume "cs1")
(cases)
(assume "z1")
(cases)
(assume "z2" "N1" "N2")
(use "Truth-Axiom")
(assume "N1" "N2")
(use "N2")
(assume "s2" "N1" "N2")
(use "Efq")
(use "N2")
(simp "<-" "H3")
(use "lemma-ds-cs-total")
(use "IV")
(simp "sectionSym")
(simp-with "lemma-loc-passive"
           (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
           (pt "i") (pt "i2") "H2")
(use "Truth-Axiom")
(assume "H3")
(simp-with "lemma-loc-passive"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i1") "H3")
(simp-with "lemma-loc-passive"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i") (pt "i2") "H2")
(use "IV")
(save "theorem-zug")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 2: Existence of movement
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(set-goal
 (pf "all initocc,initloc,cleft,cs,i,s,i0.
      (loc initocc initloc cleft cs i(Tcon i0)=s) ->
      (loc initocc initloc cleft cs (Next i)(Tcon i0)=s -> F) ->
      (cs i) = s"))
(assume "initocc" "initloc" "cleft" "cs" "i" "s" "i0")
(assume 1 2)
(cases (pt "cs i=s"))
(assume 3)
(use "Truth-Axiom")
(assume 3)
(use 2)
(simp "lemma-loc-passive")
(use 1)
(assume 4)
(use 3)
(simp 4)
(use 1)
(save "lemma-movement-of-train")

(set-goal
 (pf "all initocc,initloc,cleft,cs,i0,s,i1,i2.
      (loc initocc initloc cleft cs i1 (Tcon i0)) = s ->
      ((loc initocc initloc cleft cs (i1$+(Next i2)) (Tcon i0)) = s -> F) ->
      ex i. (cs i) = s"))
(remove-rewrite-rules-for (pt "Next i1 $+ i2"))
(assume "initocc" "initloc" "cleft" "cs" "i0" "s" "i1")
(ind)
(assume "H1" "H2")
(ex-intro (pt "i1"))
(use-with "lemma-movement-of-train"
     (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
     (pt "i1") (pt "s") (pt "i0") "H1" "H2")
(assume "i2" "IV" "H1" "H2")
(cases (pt "loc initocc initloc cleft cs(i1$+Next i2)(Tcon i0)=s"))
(assume "H3")
(ex-intro (pt "i1$+Next i2"))
(inst-with-to "lemma-movement-of-train"
     (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
     (pt "i1$+Next i2") (pt "s") (pt "i0") "H3" "H4")
(use "H4")
(assume "H5")
(use "lemma-helper-2"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i0") (pt "s") (pt "(Next(i1$+Next i2))")
          (pt "(i1$+Next(Next i2))"))
(use "H5")
(use "H2")
(use "Truth-Axiom")
(assume "H3")
(use-with "IV" "H1" "H3")
(add-rewrite-rule (pt "Next i1 $+ i2") (pt "Next (i1 $+ i2)"))
(save "lemma-exists-movement")

(set-goal
 (pf "all initocc,initloc,cleft,cs,i0,s,i1,i2.
      indexLess i1 i2 ->
      (loc initocc initloc cleft cs i1 (Tcon i0)) = s ->
      (((loc initocc initloc cleft cs i2) (Tcon i0)) = s -> F) ->
      ex i. (cs i) = s"))
(assume "initocc" "initloc" "cleft" "cs" "i0" "s" "i1" "i2" 1 2 3)
(assert (pf "ex i. (Next i = i2)"))
(cases (pt "i2"))
(assume 4)
(ex-intro (pt "Begin"))
(simphyp 1 4)
(use 5)
(assume "i" 4)
(ex-intro (pt "i"))
(use "Truth-Axiom")
(assume 4)
(by-assume-with 4 "i" 5)
(simphyp 3 "<-" 5)
(use-with "lemma-exists-movement"
          (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i0") (pt "s") (pt "i1") (pt "i$-i1") 2 "?")
(simp (pf "(i1$+Next(i$-i1)) = (Next i)"))
(use 6)
(simp "indexPlusComm")
(use "indexMinusPlus")
(simp-with "<-" "indexLeqLessSimplifyer" (pt "i1") (pt "i") 'left 'right)
(simp 5)
(use 1)
(save "lemma-exists-movement-2")
;(pp(nt (proof-to-extracted-term (current-proof))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 3: Always to left
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;; part A
(set-goal (pf "all initocc,initloc,cleft,cs,i,t.
               (all i. (cleft i)) ->
               LeSec (loc initocc initloc cleft cs (Next i) t)
                     (loc initocc initloc cleft cs i1 t)"))
;; Proof by case distinction on movement-possibilities


;; part B
(set-goal (pf "all initocc,initloc,cleft,cs,i1,i2,t.
               (all i. (cleft i)) ->
               LeSec (loc initocc initloc cleft cs (i1$+i2) t)
                     (loc initocc initloc cleft cs i1 t)"))
;; Proof by induction on i2 using part A

;; Theorem
(set-goal (pf "all initocc,initloc,cleft,cs,i1,i2,t.
               (all i. (cleft i)) ->
               indexLess i1 i2 ->
               LeSec (loc initocc initloc cleft cs i2 t)
                     (loc initocc initloc cleft cs i1 t)"))
;; Proof by rewriting i1 and i2 as done in part B

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 4:
;;  Movement is always to left
;;  Current section at time i is the next of current section at time (i+1)
;;  there is a train in the current section at time i1
;;  z represents the current section at i1
;; Then for all sections <= z exists a time, where in section z is a train
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(set-goal (pf "all cs,z,i1,i2. (all i. (cs i) = nexts(cs(Next i))) ->
               (cs i1) = (Scon z) ->
               cs (i1$+i2) = (Scon (z/-(IndexToInt i2)))"))
(assume "cs" "z" "i1")
(ind)
(assume "H1" "H2")
(use "H2")
(assume "i2" "IV" "H1" "H2")
(ng)
(simp "intDoubleMinus")
(use "zugHelper1")
(simp "<-" "H1")
(ng)
(simp "intMinusPlus")
(use-with "IV" "H1" "H2")
(save "zugTheorem4-L1")

(set-goal (pf "all initocc,initloc,cleft,cs,i1,z,i2.
               (all i. cleft i) ->
               (all i. (cs i) = nexts (cs (Next i))) ->
               (cs i1) = (Scon z) ->
               dt (occ initocc cleft cs i1 (Scon z)) ->
               (dt (occ initocc cleft cs (i1$+i2) (Scon (z /-(IndexToInt i2)))))"))
(assume "initocc" "initloc" "cleft" "cs" "i1" "z")
(ind)
(assume "H1" "H2" "H3" "H4")
(use "H4")
(assume "i2" "IV" "H1" "H2" "H3" "H4")
(simp (pf "(i1$+Next i2) = Next(i1$+i2)"))
(cases (pt "dt(occ initocc cleft cs(i1$+i2)(Scon(z/-IndexToInt (Next i2))))"))
(assume "C1")
(simp-with "lemma-occ-left-next-full" (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs") (pt "i1$+i2")(pt "(Scon(z/-IndexToInt(Next i2)))") "?" "?" "C1")
(use "C1")
(ng)
(simp "intDoubleMinus")
(simp "intMinusPlus")
(use-with "zugTheorem4-L1" (pt "cs") (pt "z") (pt "i1") (pt "i2") "H2" "H3")
(use "H1")
(assume "C2")
(simp-with "lemma-occ-left-next-empty" (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs") (pt "i1$+i2")(pt "(Scon(z/-IndexToInt(Next i2)))") "?" "?" "C2")
(ng)
(simp "intDoubleMinus")
(simp "intMinusPlus")
(use-with "IV" "H1" "H2" "H3" "H4")
(ng)
(simp "intDoubleMinus")
(simp "intMinusPlus")
(use-with "zugTheorem4-L1" (pt "cs") (pt "z") (pt "i1") (pt "i2") "H2" "H3")
(use "H1")
(use "Truth-Axiom")
(save "zugTheorem4-L2")

(set-goal (pf "all initocc,initloc,cleft,cs,i1,z,i2.
               (all i. cleft i) ->
               (all i. (cs i) = nexts (cs (Next i))) ->
               (cs i1) = (Scon z) ->
               dt (occ initocc cleft cs i1 (Scon z)) ->
               ex i. (dt (occ initocc cleft cs i (Scon (z /-(IndexToInt i2)))))"))
(assume "initocc" "initloc" "cleft" "cs" "i1" "z" "i2" "H1" "H2" "H3" "H4")
(ex-intro (pt "i1$+i2"))
(use-with "zugTheorem4-L2" (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs")
          (pt "i1") (pt "z") (pt "i2") "H1" "H2" "H3" "H4")
(save "zugTheorem4")
;(pp(nt (proof-to-extracted-term (current-proof))))

(set-goal (pf "all initocc,initloc,cleft,cs,i2,z1,z2.
               (all i. cleft i) ->
               (all i. (cs i) = nexts (cs (Next i))) ->
               (cs i2) = (Scon z2) ->
               dt (occ initocc cleft cs i2 (Scon z2)) ->
               intLeq z1 z2 ->
               ex i1. (dt (occ initocc cleft cs i1 (Scon z1)))"))
(assume "initocc" "initloc" "cleft" "cs" "i2" "z1" "z2" "H1" "H2" "H3" "H4" "H5")
(inst-with-to "intLeqExIndex" (pt "z1") (pt "z2") "H5" "H6")
(by-assume-with "H6" "i1" "H7")
(simp (pf "z1=z2/-IndexToInt i1"))
(use-with "zugTheorem4" (pt "initocc") (pt "initloc") (pt "cleft") (pt "cs") (pt "i2") (pt "z2") (pt "i1") "H1" "H2" "?" "?")
(use "H3")
(use "H4")
(use "intIdPred" (pt "IndexToInt i1"))
(simp "intMinusPlus")
(simp "<-" "H7")
(simp "intPlusComm")
(use "intMinusPlus")
(save "zugTheorem4-2")
;(pp(nt (proof-to-extracted-term (current-proof))))


