
; (load "~/minlog/init.scm")


(display "
Begin of bar.scm

In this file we define notions like (decidable) tree, path, bar etc.

We load first positive.scm
")


(exload "FAN/positive.scm")

(begin
(display "

In positive.scm we defined:

")
(display-constructors "pos")

(display-constructors "upos")

(display"

Binary relation < on pos

Binary relation ◁ on upos


₂ : upos -> pos

")
(display-program-constants "uposposTwoexp")
)



(begin
(display "

Above k ≼ n  states that node k is above node n

")
(add-program-constant
 "Above"
 (mk-arrow (py "pos") (py "pos") (py "boole"))
 1 'const 2
)
(add-token
 "≼"
 'rel-op
 (lambda (x y)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "Above")) x y)))
(add-display
 (py "boole")
 (lambda (x)
   (let* ((op (term-in-app-form-to-final-op x))
	  (args (term-in-app-form-to-args x)))
     (if (and (term-in-const-form? op)
	      (string=? "Above"
		(const-to-name (term-in-const-form-to-const op)))
	      (= 2 (length args)))
	 (list 'rel-op "≼"
	       (term-to-token-tree (car args))
	       (term-to-token-tree (cadr args)))
	 #f))))
; Computation Rules For Above
(add-computation-rule (pt "1≼pos")(pt "True"))

(add-computation-rule (pt "SZero pos≼1")(pt "False"))
(add-computation-rule (pt "SZero pos1≼SZero pos2")(pt "pos1=pos2 ∨ SZero pos1≼pos2"))
(add-computation-rule (pt "SZero pos1≼SOne pos2")(pt "SZero pos1≼pos2"))

(add-computation-rule (pt "SOne pos≼1")(pt "False"))
(add-computation-rule (pt "SOne pos1≼SZero pos2")(pt "SOne pos1≼pos2"))
(add-computation-rule (pt "SOne pos1≼SOne pos2")(pt "pos1=pos2 ∨ SOne pos1≼pos2"))

(display-program-constants "Above")

(display"

Test of Above ≼:

")
(display "Above     5     11    ")
     (pnt"Above     5     11")
(display "Above    10     23    ")
     (pnt"Above    10     23")
(display "Above    11     21    ")
     (pnt"Above    11     21")
(display "Above    42     42    ")
     (pnt"Above    42     42")
(display "Above  1024   1023    ")
     (pnt"Above  1024   1023"))



(begin

(display "

ℓ k  is the length of the sequence at node k.

")

 
(add-program-constant
 "ℓ"
 (mk-arrow (py "pos") (py "upos"))
 1 'const 1
)



; Computation Rules For ℓ

(add-computation-rule (pt "ℓ 1")(pt "Unum"))
(add-computation-rule (pt "ℓ (SZero pos)")(pt "SUCC(ℓ pos)"))
(add-computation-rule (pt "ℓ (SOne pos)")(pt "SUCC(ℓ pos)"))

(display-program-constants "ℓ")


(display"

Test of length ℓ:

")

(display "ℓ     5         ")
     (pnt"Upostopos(ℓ     5)")
(display "ℓ    10         ")
     (pnt"Upostopos(ℓ    10)")
(display "ℓ    11         ")
     (pnt"Upostopos(ℓ    11)")
(display "ℓ    42         ")
     (pnt"Upostopos(ℓ    42)")
(display "ℓ  1024         ")
     (pnt"Upostopos(ℓ  1024)")

)



(display "

∀n.   ℓn = 1  ->   n = 1


PROOF:
")
(sg "ℓ pos=Unum → pos=1")
(cases)
(auto)
; Proof finished.
(nrw "ℓ pos=Unum → pos=1")




(display "

∀n.   ℓ(2ⁿ) = n+1

")
(sg "ℓ(₂ upos)=SUCC upos")
(ind)
(auto)
; Proof finished.
(add-rewrite-rule(pt"ℓ(₂ upos)")(pt"SUCC upos"))




(display "

∀n,k. ℓn ◁ ℓk →   n < k

")
(sg "(ℓ pos1 ◁ ℓ pos2) → (pos1<pos2)")
(begin
  (ind)
  (cases)
  (auto)
  (assume "pos1" "IH1")
  (cases)
  (auto)
  (assume "pos2")
  (ng #t)
  (cd "ℓpos1◁ ℓpos2" "l1<l2")
  (use "BooleImp" (pt"pos1<pos2"))
  (auto)
  (use "BooleImp" (pt"ℓpos1◁ ℓpos2"))
  (auto)
  (assume "pos1" "IH1")
  (cases)
  (auto))
; Proof finished.
(nrw "(ℓ pos1 ◁ ℓ pos2) → (pos1<pos2)")


(display "

∀n ℓn ◁ k  ⇔   2n < 2^k

")
(sg "(ℓpos◁upos)=(SZero pos< ₂upos)")
(begin
  (ind)
  (cases)
  (auto)
  (assume "pos" "IH")
  (cases)
  (auto)
  (assume "pos" "IH")
  (cases)
  (auto))
; Proof finished.
(add-rewrite-rule(pt"ℓpos◁upos")(pt"SZero pos< ₂upos"))


(display "

∀n ℓn = k  ⇔   2^k ≤ 2n < 2^(k+1))

")
(sg "all upos,pos.(ℓpos=upos)=(₂upos ≤ SZero pos ∧ SZero pos< ₂(SUCC upos))")
(assume "upos" "pos")
(simp (pf"all upos1,upos2.(upos1=upos2)=(¬(upos1◁upos2) ∧ upos1◁SUCC upos2)"))
(auto)
; Proof finished.
(save "lengthequal")
(display-theorems "lengthequal")



(begin
(av "f" "g" "h" "b" (mk-arrow (py "pos") (py "boole")))

(display "
We define the subsetrelation ⊆(f,g):

")
(define(⊆ function1 function2)
  (string-append "all pos.(" function1 " pos) → (" function2 " pos)"))
(pp(pf(⊆ "f" "g")))
(display "


We define ∞(f) as follows:

")
(define(∞ function)
  (string-append "all upos.ex pos.( ℓ(pos) = upos ∧ (" function " pos))"))

(pp(pf(∞ "f")))
(display "


We define TREE(f) as follows:

")
(define(TREE function)
  (string-append "all pos.(" function "(SZero pos) → " function " pos) ∧ ("
                  function "(SOne pos) → " function " pos)"))
(pp(pf(TREE "f")))
(display "


We define PATH(f) as follows:

")
(define(PATH function)
  (string-append "all pos1,pos2.(" function " 1) ∧ ((("
                  function " pos1) ∧ (" function " pos2))  →  (pos1≼pos2 ∨ pos2≼pos1))"))
(pp(pf(PATH "f")))
(display "


We define BAR(f) as follows:

")
(define(BAR function) (string-append
 "(all pos.(" function " pos) → ( (" function " (SZero pos)) ∧ (" function " (SOne pos)) )) & (all g. ("
 (PATH "g") ") -> (" (∞ "g") ")-> ex pos. (g pos) ∧ (" function " pos))"))

(pp(pf(BAR "f"))))



(begin
(display "

The Complement f∖g

")
(add-program-constant
 "Setminus"
 (mk-arrow
  (mk-arrow (py "pos") (py "boole"))
  (mk-arrow (py "pos") (py "boole"))
  (mk-arrow (py "pos") (py "boole")))
 1 'const 2)
(add-token
 "∖"
 'rel-op
 (lambda (x y)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "Setminus")) x y)))
(add-display
 (mk-arrow (py "pos") (py "boole"))
 (lambda (x)
   (let* ((op (term-in-app-form-to-final-op x))
	  (args (term-in-app-form-to-args x)))
     (if (and (term-in-const-form? op)
	      (string=? "Setminus"
		(const-to-name (term-in-const-form-to-const op)))
	      (= 2 (length args)))
	 (list 'rel-op "∖"
	       (term-to-token-tree (car args))
	       (term-to-token-tree (cadr args)))
	 #f))))
; Computation Rules For Setminus
(add-computation-rule (pt "f ∖ g")(pt "[pos] f pos ∧ ¬(g pos)"))

(display-program-constants "Setminus"))



(begin
(display "

The Union f∪g

")
(add-program-constant
 "Union"
 (mk-arrow
  (mk-arrow (py "pos") (py "boole"))
  (mk-arrow (py "pos") (py "boole"))
  (mk-arrow (py "pos") (py "boole")))
 1 'const 2)
(add-token
 "∪"
 'rel-op
 (lambda (x y)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "Union")) x y)))
(add-display
 (mk-arrow (py "pos") (py "boole"))
 (lambda (x)
   (let* ((op (term-in-app-form-to-final-op x))
	  (args (term-in-app-form-to-args x)))
     (if (and (term-in-const-form? op)
	      (string=? "Union"
		(const-to-name (term-in-const-form-to-const op)))
	      (= 2 (length args)))
	 (list 'rel-op "∪"
	       (term-to-token-tree (car args))
	       (term-to-token-tree (cadr args)))
	 #f))))
; Computation Rules For Union
(add-computation-rule (pt "f ∪ g")(pt "[pos] f pos ∨ g pos"))
(display-program-constants "Union"))




(sg "(pos<(₂(SUCC upos)) ∧ ¬((f∪([pos]ℓpos◁SUCC upos)) pos)) = (([pos]ℓpos=SUCC upos)∖f)pos")
(begin
  (assume "pos" "upos" "f")
  (ng)
  (cd "ℓpos=SUCC upos" "ln=k+1")
  (ng #t)
  (cd "f pos" "fn")
  (use "Truth-Axiom")
  (assume "¬fn")
  (ng)
  (simp "<-" (pf"(ℓpos ◁ (SUCC (SUCC upos))) = (pos< SZero(₂ upos))"))
  (simp  "ln=k+1")
  (simp "<-" (pf"(ℓpos ◁ SUCC upos) = (pos< (₂ upos))"))
  (simp  "ln=k+1")
  (auto)
  (assume "ln≠k+1")
  (ng #t)
  (cd "f pos" "fn")
  (use "Truth-Axiom")
  (assume "¬fn")
  (ng)
  (simp "<-" (pf"(ℓpos ◁ (SUCC (SUCC upos))) = (pos< SZero(₂ upos))"))
  (simp "<-" (pf"(ℓpos ◁ SUCC upos) = (pos< (₂ upos))"))
  (simp (pf "all upos1,upos2.(upos1◁SUCC upos2)=( (upos1◁upos2) ∨ (upos1=upos2) )"))
  (simp  "ln≠k+1")
  (use "Truth-Axiom")
  (use "uposlessS1")
  (auto))
; Proof finished.
(add-rewrite-rule
 (pt "pos<(₂(SUCC upos)) ∧ ¬((f∪([pos]ℓpos◁SUCC upos)) pos)")
 (pt "(([pos]ℓpos=SUCC upos)∖f)pos"))


(begin

(display "

TOT (f,n) = True iff  f contains all nodes below n.

")
(add-program-constant
 "TOT"
 (mk-arrow (mk-arrow (py "pos") (py "boole")) (py "upos")  (py "boole"))
 1 'const 2)
; Computation Rules For TOT
(add-computation-rule (pt "TOT f Unum")(pt "True"))
(add-computation-rule (pt "TOT f (SUCC upos)")(pt "TOT f upos ∧ f(Upostopos upos)"))

(display-program-constants "TOT")

(display "TOT f Unum              ")
    (pnt "TOT f Unum")
(display "TOT f (SUCC Unum)       ")
    (pnt "TOT f (SUCC Unum)")
(display "TOT f (Postoupos 10)    ")
    (pnt "TOT f (Postoupos 10)"))



(sg "all f,upos.( f(Upostopos upos) ∧ TOT f upos ) → (TOT f (SUCC upos))")
(begin
  (assume "f")
  (ind)
  (use "Truth-Axiom")
  (assume "upos")
  (ng)
  (cases (pt"f(Upostopos upos+1)"))
  (auto))
; Proof finished
(nrw "( f(Upostopos upos) ∧ TOT f upos ) → (TOT f (SUCC upos))")
(nrw "( TOT f upos  ∧ f(Upostopos upos)) → (TOT f (SUCC upos))")



(display "
(TOT f upos ∧  pos<Upostopos upos) → f pos

")
(sg "all f,upos,pos. (TOT f upos ∧  pos<Upostopos upos) → f pos")
(begin
  (assume"f")
  (ind)
  (search)
  (assume "upos" "IH" "pos")
  (ng #t)
  (cds "Upostopos upos=pos" "n=k")
  (cases(pt "f pos"))
  (auto)
  (assume "n≠k")
  (cd "f (Upostopos upos)" "fn")
  (ng #t)
  (simp "posLE_LESSorEQUAL")
  (simp "posEQsym" (pt"pos"))
  (simp "n≠k")
  (auto))
; Proof finished.
(nrw "(TOT f upos ∧ pos<Upostopos upos) → f pos")
(nrw "(pos<Upostopos upos ∧ TOT f upos) → f pos")

(display"

End of bar.scm

")



