; $Id: cont.scm 2339 2009-09-18 11:52:13Z schwicht $

; (load "~/minlog/init.scm")
; (set! DOT-NOTATION #f)
; (set! COMMENT-FLAG #f)
; (libload "nat.scm")
; (libload "numbers.scm")
; (load "real.scm")
; (set! COMMENT-FLAG #t)

; Continuous functions
; ====================

; To be added to tensor.scm: Constructor and accessors for tensor
; types:

; (define (make-tensor-type type1 type2)
;   (make-alg "tensor" type1 type2))

; ; (type-to-string (make-tensor-type (py "pos") (py "boole")))

; (define (tensor-form-to-arg-type tensor-type)
;   (car (alg-form-to-types tensor-type)))

; (define (tensor-form-to-val-type tensor-type)
;   (cadr (alg-form-to-types tensor-type)))

; ; (type-to-string
; ;  (tensor-form-to-arg-type (make-tensor-type (py "pos") (py "boole"))))

; ; (type-to-string
; ;  (tensor-form-to-val-type (make-tensor-type (py "pos") (py "boole"))))

; (define (mk-tensor-type x . rest) ;associates to the right
;   (if (null? rest)
;       x
;       (make-alg "tensor" x (apply mk-tensor-type rest))))

; ; (type-to-string (mk-tensor-type (py "pos") (py "pos") (py "boole")))

; (define (types-to-fst-term type1 type2) ;of type tau1 tensor tau2 => tau1
;   (let* ((const (pconst-name-to-pconst "tensorFst"))
; 	 (tvars (const-to-tvars const))
; 	 (subst (make-substitution tvars (list type1 type2))))
;     (make-term-in-const-form
;      (const-substitute const subst #f))))

; (define (types-to-snd-term type1 type2)
;   (let* ((const (pconst-name-to-pconst "tensorSnd"))
; 	 (tvars (const-to-tvars const))
; 	 (subst (make-substitution tvars (list type1 type2))))
;     (make-term-in-const-form
;      (const-substitute const subst #f))))

; ; (term-to-string (types-to-snd-term  (py "pos") (py "boole")))
; ; (type-to-string (term-to-type (types-to-snd-term  (py "pos") (py "boole"))))

; (define (index-and-types-to-proj-term i . types)
;   (if (< (length types) 2)
;       (myerror "index-and-types-to-proj-term" ">= 2 types expected"
; 	       (map type-to-string types)))
;   (if (not (< i (length types)))
;       (myerror "index-and-types-to-proj-term" "out of range"
; 	       i "for" (map type-to-string types)))
;   (let* ((type0 (car types))
; 	 (rest-types (cdr types))
; 	 (fst-term (types-to-fst-term type0 (apply mk-tensor-type rest-types)))
; 	 (snd-term
; 	  (types-to-snd-term type0 (apply mk-tensor-type rest-types))))
;     (cond
;      ((zero? i) fst-term)
;      ((and (= 1 i) (= 2 (length types))) snd-term)
;      (else ;lambda var.prev(snd-term var)
;       (let* ((var (type-to-new-var (apply mk-tensor-type types)))
; 	     (prev (apply index-and-types-to-proj-term
; 			  (cons (- i 1) rest-types))))
; 	(make-term-in-abst-form
; 	 var (make-term-in-app-form
; 	      prev (make-term-in-app-form
; 		    snd-term (make-term-in-var-form var)))))))))

; (term-to-string (index-and-types-to-proj-term 0 (py "pos") (py "boole")))
; (type-to-string
;  (term-to-type (index-and-types-to-proj-term 0 (py "pos") (py "boole"))))
; (term-to-string (index-and-types-to-proj-term 1 (py "pos") (py "boole")))
; (type-to-string
;  (term-to-type (index-and-types-to-proj-term 1 (py "pos") (py "boole"))))

; (term-to-string (index-and-types-to-proj-term
; 		 1 (py "pos") (py "boole") (py "boole")))
; (type-to-string
;  (term-to-type (index-and-types-to-proj-term
; 		1 (py "pos") (py "boole") (py "boole"))))
      
; (term-to-string (index-and-types-to-proj-term
; 		 2 (py "pos") (py "boole") (py "boole")))
; (type-to-string
;  (term-to-type (index-and-types-to-proj-term
; 		2 (py "pos") (py "boole") (py "boole"))))
      
; (term-to-string (index-and-types-to-proj-term
; 		 3 (py "pos") (py "boole") (py "boole")))

; (term-to-string
;  (nt (make-term-in-app-form
;       (index-and-types-to-proj-term 0 (py "pos") (py "boole") (py "boole"))
;       (make-term-in-var-form
;        (type-to-new-var
; 	(mk-tensor-type (py "pos") (py "boole") (py "boole")))))))

; (term-to-string
;  (nt (make-term-in-app-form
;       (index-and-types-to-proj-term 1 (py "pos") (py "boole") (py "boole"))
;       (make-term-in-var-form
;        (type-to-new-var
; 	(mk-tensor-type (py "pos") (py "boole") (py "boole")))))))

; (term-to-string
;  (nt (make-term-in-app-form
;       (index-and-types-to-proj-term 2 (py "pos") (py "boole") (py "boole"))
;       (make-term-in-var-form
;        (type-to-new-var
; 	(mk-tensor-type (py "pos") (py "boole") (py "boole")))))))

; 04-01-24
; Algebraic structures (`hierarchy') versus concrete algebras.

; To develop general group theory, take a type variable alpha (the
; type of the group elements) and a predicate variable G of arity
; alpha (the property to be an element of the group).  Take a binary
; predicate variable == and formulate as its properties that it is an
; equivalence relation on G.  Take a binary function variable o
; (composition), a unary function variable inv (inverse) and a
; variable e (unit), and formulate as their properties that G is
; closed under them, compatibility with ==, and finally the ordinary
; group axioms.  For equality reasoning we cannot use computation or
; rewrite rules (there are no program constants), but must use simp
; instead.  To apply general results for a concrete group, use proof
; substitution.

; For a concrete algebra (`record') the underlying data type is a free
; algebra with one non-iterable constructor.  The destructors are
; program constants and come with the obvious computation rules.  They
; should have informative names (`fields').  In a second step the
; actual elements of the concrete algebra are singled out by means of
; a (formally) inductively defined predicate, which in fact is
; explicitely defined by the required properties of the field
; components.

; Example: continuous functions.

(add-alg
 "cont"
 (list "ContConstr" "rat=>rat=>(rat=>nat=>rat)=>(int=>nat)=>(int=>int)=>cont"))

(add-var-name "h" (py "rat=>nat=>rat"))
(add-var-name "al" (py "int=>nat"))
(add-var-name "om" (py "int=>int"))

(add-program-constant "ContDoml" (py "cont=>rat") t-deg-one)

(add-token
 "doml"
 'postfix-op
 (lambda (x)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "ContDoml"))
    x)))

(add-display
 (py "rat")
 (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=? "ContDoml"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 1 (length args)))
	 (let ((arg (car args)))
	   (list
	    'postfix-op "doml"
	    (term-to-token-tree arg)))
	 #f))))
 
(add-computation-rule (pt "(ContConstr a0 b0 h al om)doml") (pt "a0"))

(add-program-constant "ContDomr" (py "cont=>rat") t-deg-one)

(add-token
 "domr"
 'postfix-op
 (lambda (x)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "ContDomr"))
    x)))

(add-display
 (py "rat")
 (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=? "ContDomr"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 1 (length args)))
	 (let ((arg (car args)))
	   (list
	    'postfix-op "domr"
	    (term-to-token-tree arg)))
	 #f))))
 
(add-computation-rule (pt "(ContConstr a0 b0 h al om)domr") (pt "b0"))

(add-program-constant
 "ContApprox" (py "cont=>rat=>nat=>rat") t-deg-one 'const 1)

(add-token
 "approx"
 'postfix-op
 (lambda (x)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "ContApprox"))
    x)))

(add-display
 (py "rat=>nat=>rat")
 (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=? "ContApprox"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 1 (length args)))
	 (let ((arg (car args)))
	   (list
	    'postfix-op "approx"
	    (term-to-token-tree arg)))
	 #f))))
 
(add-computation-rule (pt "(ContConstr a0 b0 h al om)approx") (pt "h"))

(add-program-constant "ContuMod" (py "cont=>int=>nat") t-deg-one 'const 1)

(add-token
 "uMod"
 'postfix-op
 (lambda (x)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "ContuMod"))
    x)))

(add-display
 (py "int=>nat")
 (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=? "ContuMod"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 1 (length args)))
	 (let ((arg (car args)))
	   (list
	    'postfix-op "uMod"
	    (term-to-token-tree arg)))
	 #f))))
 
(add-computation-rule (pt "(ContConstr a0 b0 h al om)uMod") (pt "al"))

(add-program-constant "ContuModCont" (py "cont=>int=>int") t-deg-one 'const 1)

(add-token
 "uModCont"
 'postfix-op
 (lambda (x)
   (mk-term-in-app-form
    (make-term-in-const-form (pconst-name-to-pconst "ContuModCont"))
    x)))

(add-display
 (py "int=>int")
 (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=? "ContuModCont"
			(const-to-name (term-in-const-form-to-const op)))
	      (= 1 (length args)))
	 (let ((arg (car args)))
	   (list
	    'postfix-op "uModCont"
	    (term-to-token-tree arg)))
	 #f))))
 
(add-computation-rule (pt "(ContConstr a0 b0 h al om)uModCont") (pt "om"))

(add-var-name "f" (make-alg "cont"))

; Now the (formally inductive) definition of Cont

(add-ids
 (list (list "Cont" (make-arity (make-alg "cont"))))
 '("allnc a0,b0,h,al,om(
     all a(a0<=a -> a<=b0 -> Cauchy(h a)al) --> 
     all a,b,k,n(a0<=a -> a<=b0 -> a0<=b -> b<=b0 ->
                  al k<=n -> 
                  abs(a-b)<=1/2**(om k) ->
                  abs(h a n-h b n)<=1/2**k) -->
     all k,l(k<=l -> al k<=al l) -->
     all k,l(k<=l -> om k<=om l) -->
     Cont(ContConstr a0 b0 h al om))" "ContIntro"))

; Example of a continuous function: a^2-2 on [1,2]

(pp  (nt (pt "(ContConstr 1 2([a,n]a*a-2)([k]Zero)([k]k+3))approx (14#10) 1")))

(pp
 (nt
  (simp-term
   (nt (pt "(ContConstr 1 2([a,n]a*a-2)([k]Zero)([k]k+3))approx (14#10) 1")))))


; Now the properties of Cont.

; "ContElim1"
(set-goal
 (pf "all f(Cont f ->
        all a(f doml<=a -> a<=f domr -> Cauchy(f approx a)(f uMod)))"))
(ind)
(assume "a0" "b0" "h" "al" "om")
(elim)
(search)
; Proof finished.
(save "ContElim1")

; "ContElim2"
(set-goal (pf "all f(
 Cont f -> 
 all a,b,k,n(
  f doml<=a -> 
  a<=f domr -> 
  f doml<=b -> 
  b<=f domr -> 
  f uMod k<=n -> 
  abs(a-b)<=1/2**f uModCont k -> abs(f approx a n-f approx b n)<=1/2**k))"))
(ind)
(assume "a0" "b0" "h" "al" "om")
(elim)
(search)
; Proof finished.
(save "ContElim2")

; ContElim3
(set-goal (pf "all f(Cont f -> all k,l(k<=l -> f uMod k<=f uMod l))"))
(ind)
(assume "a0" "b0" "h" "al" "om")
(elim)
(search)
; Proof finished.
(save "ContElim3")

; "ContElim4"
(set-goal (pf "all f(Cont f -> all k,l(k<=l -> f uModCont k<=f uModCont l))"))
(ind)
(assume "a0" "b0" "h" "al" "om")
(elim)
(search)
; Proof finished.
(save "ContElim4")

; All this could be done automatically by evaluating

; (add-record
;  "Cont" "f"
;  (list "doml" "rat")
;  (list "domr" "rat")
;  (list "approx" "rat=>nat=>rat")
;  (list "uMod" "pos=>pos")
;  (list "uModCont" "pos=>pos")
;  "all a.f doml<=a -> a<=f domr -> Cauchy(f approx a)(f uMod)"
;  "all a,b,k,n.f doml<=a -> a<=f domr -> f doml<=b -> b<=f domr ->
;               f uMod k<=n -> 
;               abs(a-b)<=(1#2**(f uModCont k)) ->
;               abs(f approx a n-f approx b n)<=1/2**k)"
;  "all m,n.m<=n -> f uMod m<=f uMod n"
;  "all m,n.m<=n -> f uModCont m<=f uModCont n")

; However, for the time being it is done by hand.

; Recall the intermediate value theorem, now written as follows:

; (pf "all f,M.Cont f -> f app f doml<=0 -> 0<=f app f domr ->
;      (all x,y,k.RealLt x y k -> RealLt(f app x)(f app y)(M k)) -> 
;      ex z.Real z & f app z===0")

; We aim at an application notation: (f x) instead of (f app x), so

; (pf "all f,M.Cont f -> f(f doml)<=0 -> 0<=f(f domr) ->
;      (all x,y,k.RealLt x y k -> RealLt(f x)(f y)(M k)) -> 
;      ex z.Real z & f z===0")

; For an application notation (f x) we must from (x seq) and (x mod)
; produce the real whose Cauchy sequence is [n]f approx(x seq n)n and
; whose modulus is \max(\alpha_f(k+2), \alpha(\omega_f(k+1)-1)) or
; formally [k]f uMod(IntS(IntS k))max x mod(IntPred(f uModCont(IntS k)))

; (pp (pt "[n]f approx(x seq n)n"))

; (pp (pt "[k]f uMod(k+2)max x mod(f uModCont(k+1)-1)"))

(define (make-term-in-cont-app-form f x)
  (let ((n (type-to-new-var (py "nat")))
	(k (type-to-new-var (py "int"))))
    (mk-term-in-app-form
     (make-term-in-const-form (constr-name-to-constr "RealConstr"))
     (make-term-in-abst-form
      n (mk-term-in-app-form
	 (make-term-in-const-form (pconst-name-to-pconst "ContApprox"))
	 f (mk-term-in-app-form
	    (make-term-in-const-form (pconst-name-to-pconst "RealSeq"))
	    x (make-term-in-var-form n))
	 (make-term-in-var-form n)))
     (make-term-in-abst-form
      k (mk-term-in-app-form
	 (make-term-in-const-form
	  (pconst-name-to-pconst "NatMax"))
	 (mk-term-in-app-form
	  (make-term-in-const-form (pconst-name-to-pconst "ContuMod"))
	  f (make-term-in-app-form
	     (make-term-in-const-form (pconst-name-to-pconst "IntS"))
	     (make-term-in-app-form
	      (make-term-in-const-form (pconst-name-to-pconst "IntS"))
	      (make-term-in-var-form k))))
	 (mk-term-in-app-form
	  (make-term-in-const-form (pconst-name-to-pconst "RealMod"))
	  x (mk-term-in-app-form
	     (make-term-in-const-form (pconst-name-to-pconst "IntPred"))
	     (mk-term-in-app-form
	      (make-term-in-const-form (pconst-name-to-pconst "ContuModCont"))
	      f (make-term-in-app-form
		 (make-term-in-const-form (pconst-name-to-pconst "IntS"))
		 (make-term-in-var-form k))))))))))

; (pp (nt (make-term-in-cont-app-form (pt "f") (pt "x"))))

(add-new-application
 (lambda (type) (equal? type (make-alg "cont")))
 make-term-in-cont-app-form) 

; A term is in cont-app-form if it is in application form with
; operator RealConstr, with seq field of the form [n]f approx(x seq
; n)n.  It should then be displayed as f x, where f and x can be read
; off.

(define (term-in-cont-app-form? term)
  (and
   (term-in-app-form? term)
   (let ((op (term-in-app-form-to-final-op term))
	 (args (term-in-app-form-to-args term)))
     (and
      (term-in-const-form? op)
      (string=? "RealConstr" (const-to-name (term-in-const-form-to-const op)))
      (= 2 (length args))
      (equal? (py "int=>nat") (term-to-type (cadr args)))
      (term-in-abst-form? (car args))
      (let* ((var (term-in-abst-form-to-var (car args)))
	     (kernel (term-in-abst-form-to-kernel (car args)))
	     (op1 (term-in-app-form-to-final-op kernel))
	     (args1 (term-in-app-form-to-args kernel)))
	(and
	 (term-in-const-form? op1)
	 (string=? "ContApprox"
		   (const-to-name (term-in-const-form-to-const op1)))
	 (= 3 (length args1))
	 (let ((arg1 (car args1)) ;this is f
	       (arg2 (cadr args1)) ;this is x seq n
	       (arg3 (caddr args1))) ;this is n
	   (and
	    (term-in-var-form? arg3)
	    (equal? var (term-in-var-form-to-var arg3))
	    (let ((op2 (term-in-app-form-to-final-op arg2))
		  (args2 (term-in-app-form-to-args arg2)))
	      (and
	       (term-in-const-form? op2)
	       (string=? "RealSeq"
			 (const-to-name (term-in-const-form-to-const op2)))
	       (= 2 (length args2))
	       (let ((arg21 (car args2)) ;this is x
		     (arg22 (cadr args2))) ;this is n
		 (and
		  (term-in-var-form? arg22)
		  (equal? var (term-in-var-form-to-var arg22))))))))))))))

; (term-in-cont-app-form? (make-term-in-cont-app-form (pt "f") (pt "x")))

(define (term-in-cont-app-form-to-op term)
  (let* ((args (term-in-app-form-to-args term))
	 (kernel (term-in-abst-form-to-kernel (car args)))
	 (args1 (term-in-app-form-to-args kernel)))
    (car args1)))

(define (term-in-cont-app-form-to-arg term)
  (let* ((args (term-in-app-form-to-args term))
	 (kernel (term-in-abst-form-to-kernel (car args)))
	 (args1 (term-in-app-form-to-args kernel))
	 (arg2 (cadr args1)) ;this is x seq n
	 (args2 (term-in-app-form-to-args arg2)))
    (car args2)))

; (term-in-cont-app-form-to-op (make-term-in-cont-app-form (pt "f") (pt "x")))
; (term-in-cont-app-form-to-arg (make-term-in-cont-app-form (pt "f") (pt "x")))

(add-display
 (py "real")
 (lambda (x)
   (if (term-in-cont-app-form? x)
       (list 'appterm ""
	     (term-to-token-tree
	      (term-in-cont-app-form-to-op x))
	     (term-to-token-tree
	      (term-to-original (term-in-cont-app-form-to-arg x))))
       #f)))

; (pp (pt "f x"))
; (pp (pt "(f x)mod"))
; (pp (nt (pt "(f x)seq")))
; (pp (nt (pt "(f x)mod")))

(add-global-assumption
 "ContReal"
 (pf "all f,x(Cont f -> Real x -> f doml<<=x -> x<<=f domr -> Real(f x))"))

(add-global-assumption
 "ContRealRat"
 (pf "all f,c(Cont f -> f doml<<=c -> c<<=f domr -> Real(f c))"))

; Approximate splitting principle.

; We will make use of some lemmata, that can be proved easily:

(add-global-assumption
 "RealLeCrit"
 (pf "all x,y,n0(
       Real x -> Real y -> all n(n0<=n -> x seq n<=y seq n) -> x<<=y)"))

; For the proof we can use

(add-global-assumption
 "RealLeChar1"
 (pf "all x,y(Real x -> Real y ->
              all k ex n0 all n(n0<=n -> 1/2**k<=y seq n-x seq n) ->
              x<<=y)"))

(add-global-assumption
 "CauchyEstPlus"
 (pf "all as,M(Cauchy as M ->
               all k,n,m(M k<=n -> M k<=m ->
                         as n<=as m+1/2**k))"))

(add-global-assumption
 "CauchyEstMinus"
 (pf "all as,M(Cauchy as M ->
               all k,n,m(M k<=n -> M k<=m ->
                         as n-1/2**k<=as m))"))

(add-global-assumption
 "RatMinusLe2"
 (pf "all a1,a2,b1,b2(a1<=a2 -> b2<=b1 -> a1-b1<=a2-b2)"))

(add-global-assumption
 "RatLeLin"
 (pf "all a,b((a<=b -> Pvar) -> (b<=a -> Pvar) -> Pvar)"))


(add-var-name "L" (py "int=>nat"))

; We now prove "ApproxSplit", the Approximate Splitting Principle.

; "ApproxSplit"
(set-goal
 (pf "all x1,x2,x3,k(Real x1 -> Real x2 -> Real x3 ->
                    RealLt x1 x2 k -> ex boole(
                    (boole -> x3<<=x2) & ((boole -> F) -> x1<<=x3)))"))
(ind)
(assume "as" "M")
(ind)
(assume "bs" "N")
(ind)
(assume "cs" "L")
(assume "k" "Real x1" "Real x2" "Real x3" "x1<x2")

; We introduce a definition M(k+2)max N(k+2)=m
(cut (pf "all m(M(k+2)max N(k+2)=m -> ex boole(
           (boole -> RealConstr cs L<<=RealConstr bs N) & 
           ((boole -> F) -> RealConstr as M<<=RealConstr cs L)))"))
  (assume "mImp")
  (use "mImp" (pt "M(k+2)max N(k+2)"))
  (use "Truth-Axiom")
  (assume "m" "m-Def")

(ex-intro (pt "cs(m max L(k+2))<=(as m+bs m)/2"))
(split)

; Case cs(m max L(k+2))<=(as m+bs m)/2
(assume "CaseHyp")
(use "RealLeCrit" (pt "m max L(k+2)"))
(auto)
(assume "n" "m max L(k+2)<=n")
(cut (pf "RealLt(RealConstr as M)(RealConstr bs N)k"))
(drop "x1<x2")
(ng)
(simp "m-Def")
(assume "Hyp") ;x1<x2
(cut (pf "(1/2**(k+2))<=(bs m-as m)/4"))
(assume "Hyp/4")

; cs n<=bs n
(use "RatLeTrans" (pt "cs(m max L(k+2))+1/2**(k+2)"))

; cs n<=cs(m max L(k+2))+1/2**(k+2)
(use "CauchyEstPlus" (pt "L"))
(auto 1 '("RealElimVariant1" 1))
(use "NatLeTrans" (pt "m max L(k+2)"))
(use "NatMaxUB2")
(use "m max L(k+2)<=n")
(use "NatMaxUB2")

; cs(m max L(k+2))+1/2**(k+2)<=bs n
(use "RatLeTrans" (pt "(as m+bs m)/2 + (bs m-as m)/4"))

; cs(m max L(k+2))+1/2**(k+2)<=(as m+bs m)/2+(bs m-as m)/4
(use "RatPlusLe2")
(use "CaseHyp")
(use "Hyp/4")

; (as m+bs m)/2+(bs m-as m)/4<=cs(m max L(k+2))+1/2**(k+2)
(use "RatEqLe" (pt "bs m-(bs m-as m)/4"))
(ord-field-simp-bwd)

; bs m-(bs m-as m)/4<=bs n
(use "RatLeTrans" (pt "bs m-1/2**(k+2)"))

; bs m-(bs m-as m)/4<=bs m-1/2**(k+2)
(use "RatMinusLe2")
(use "Truth-Axiom")
(use "Hyp/4")

; bs m-1/2**(k+2)<=bs n
(use "CauchyEstMinus" (pt "N"))
(auto 1 '("RealElimVariant1" 1))
(cut (pf "N(k+2)<=M(k+2)max N(k+2)"))
(ng #t)
(simp "m-Def")
(prop)
(use "NatMaxUB2")
(use "NatLeTrans" (pt "M(k+2)max N(k+2)"))
(use "NatMaxUB2")
(ng #t)
(simp "m-Def")
(use "NatLeTrans" (pt "m max L(k+2)"))
(use "NatMaxUB1")
(use "m max L(k+2)<=n")

; 1/2**(k+2)<=(bs m-as m)/4
(use "RatEqLe" (pt "1/2**k/4"))
(add-global-assumption
 "ApproxSplitAux1" (pf "all k 1/2**(k+2)==1/2**k/4"))
(use "ApproxSplitAux1")
(add-global-assumption
 "RatDivLe" (pf "all a,b,c,d(a<=b -> 0<d -> d<=c -> a/c<=b/d)"))
(use "RatDivLe")
(use "Hyp")
(use "Truth-Axiom")
(use "Truth-Axiom")

; RealLt(RealConstr as M)(RealConstr bs N)
(use "x1<x2")

; (cs(m max L(k+2))<=(as m+bs m)/2 -> F) -> RealConstr as M<<=RealConstr cs L
(assume "CaseHyp")
(use "RealLeCrit" (pt "m max L(k+2)"))
(auto)
(assume "n" "m max L(k+2)<=n")
(cut (pf "RealLt(RealConstr as M)(RealConstr bs N)k"))
(drop "x1<x2")
(ng #t)
(simp "m-Def")
(assume "Hyp") ;x1<x2
(cut (pf "1/2**(k+2)<=(bs m-as m)/4"))
(assume "Hyp/4")

; as n<=cs n
(use "RatLeTrans" (pt "as m+1/2**(k+2)"))

; as n<=as m+1/2**(k+2)
(use "CauchyEstPlus" (pt "M"))
(auto 1 '("RealElimVariant1" 1))
(use "NatLeTrans" (pt "m max L(k+2)"))
(use "NatLeTrans" (pt "M(k+2)max N(k+2)"))
(use "NatMaxUB1")
(simp "m-Def")
(use "NatMaxUB1")
(use "m max L(k+2)<=n")
(use "NatLeTrans" (pt "M(k+2)max N(k+2)"))
(use "NatMaxUB1")
(simp "m-Def")
(use "Truth-Axiom")

;: as m+1/2**(k+2)<=cs n
(use "RatLeTrans" (pt "as m+(bs m-as m)/4"))

; as m+1/2**(k+2)<=as m+(bs m-as m)/4
(use "RatPlusLe2")
(use "Truth-Axiom")
(use "Hyp/4")

; as m+(bs m-as m)/4<=cs n
(use "RatEqLe" (pt "(as m+bs m)/2-(bs m-as m)/4"))

; as m+(bs m-as m)/4==(as m+bs m)/2-(bs m-as m)/4
(ord-field-simp-bwd)

; (as m+bs m)/2-(bs m-as m)/4<=cs n
(use "RatLeTrans" (pt "cs(m max L(k+2))-1/2**(k+2)"))

; (as m+bs m)/2-(bs m-as m)/4<=cs(m max L(k+2))-1/2**(k+2)
(use "RatMinusLe2")
(use "RatLeLin" (pt "(as m+bs m)/2") (pt "cs(m max L(k+2))"))
 (assume "H1")
 (use "H1")
 (assume "H2")
 (use "Efq")
 (use "CaseHyp")
 (use "H2")
(use "Hyp/4")

; cs(m max L(k+2))-1/2**(k+2)<=cs n
(use "CauchyEstMinus" (pt "L"))
(auto 1 '("RealElimVariant1" 1))
(use "NatMaxUB2")
(use "NatLeTrans" (pt "m max L(k+2)"))
(use "NatMaxUB2")
(use "m max L(k+2)<=n")

; 1/2**(k+2)<=(bs m-as m)/4
(use "RatEqLe" (pt "1/2**k/4"))
(use "ApproxSplitAux1")
(use "RatDivLe")
(use "Hyp")
(use "Truth-Axiom")
(use "Truth-Axiom")

; RealLt(RealConstr as M)(RealConstr bs N)k
(use "x1<x2")
; Proof finished.
(save "ApproxSplit")

(define ApproxSplit-eterm
  (proof-to-extracted-term (theorem-name-to-proof "ApproxSplit")))
(define ApproxSplit-neterm (nt ApproxSplit-eterm))

(pp ApproxSplit-neterm)

#|
[x0,x1,x2,k3]
 [if x0
   ([as4,M5]
    [if x1
      ([as6,M7]
       [if x2
         ([as8,M9]
          as8(M5(IntS(IntS k3))max M7(IntS(IntS k3))max M9(IntS(IntS k3)))<=
          (as4(M5(IntS(IntS k3))max M7(IntS(IntS k3)))+
           as6(M5(IntS(IntS k3))max M7(IntS(IntS k3))))/
          2)])])]
|#

; Intermediate value theorem, with 1/2^l a lower bound on the slope:

; We first prove an auxiliary lemma IVTAux, for the construction step.

; First we define a (formally inductive) correctness predicate:

(add-ids
 (list (list "Corr" (make-arity (py "cont") (py "rat") (py "rat") (py "int"))))
 '("allnc f,c,d,k.
     f doml<=c --> d<=f domr --> 1/2**k<=d-c -->
     f c<<=0 --> 0<<=f d -->
     Corr f c d k" "CorrIntro"))

; (pp (pf "Corr f c d k"))

; Now the properties of Corr.

; (set-goal
;  (pf "all f,c,d,n.
;       f doml<=c -> d<=f domr -> (1/2**n)<=d-c ->
;       f c<<=0 -> 0<<=f d ->
;       Corr f c d n"))
; (strip)
; (intro 0)            
; (auto 1)
; (save "CorrIntro")

(set-goal (pf "all f,c,d,k(Corr f c d k -> f doml<=c)"))
(assume "f" "c" "d" "k")
(elim)
(search)
(save "CorrElim1")

(set-goal (pf "all f,c,d,k(Corr f c d k -> d<=f domr)"))
(assume "f" "c" "d" "k")
(elim)
(search)
(save "CorrElim2")

(set-goal (pf "all f,c,d,k(Corr f c d k -> 1/2**k<=d-c)"))
(assume "f" "c" "d" "k")
(elim)
(search)
(save "CorrElim3")

(set-goal (pf "all f,c,d,k(Corr f c d k -> f c<<=0)"))
(assume "f" "c" "d" "k")
(elim)
(search)
(save "CorrElim4")

(set-goal (pf "all f,c,d,k(Corr f c d k -> 0<<=f d)"))
(assume "f" "c" "d" "k")
(elim)
(search)
(save "CorrElim5")

; To unclutter the proof of IVTAux, we first prove two easy lemmata
; concerning correctness.  First IVTAux1:

; (pp (pt "f((1#3)*c+(2#3)*d)"))
; (pp (pt "1#3"))

; "IVTAux1"
(set-goal
 (pf "all f,c,d,k(Cont f -> Corr f c d k -> 0<<=f((1#3)*c+(2#3)*d) ->
                  Corr f c((1#3)*c+(2#3)*d)(IntS k))"))
(assume "f" "c" "d" "k" "Cont f" "Corr f c d k" "0<<=f d1")
(cut (pf "f doml<=c"))
(assume "a<=c")
(cut (pf "d<=f domr"))
(assume "d<=b")
(cut (pf "1/2**k<=d-c"))
(assume "c<_k d")
(cut (pf "f c<<=0"))
(assume "f c<<=0")
(cut (pf "0<<=f d"))
(assume "0<<=f d")

; Corr f c((1#3)*c+(2#3)*d)(IntS k)
(use "CorrIntro")
(auto)

; (1#3)*c+(2#3)*d<=f domr
(use "RatLeTrans" (pt "d"))

; (1#3)*c+(2#3)*d<=d
(ord-field-simp-bwd)

; c<=d
(use "RatLeAux1")
(use "RatLeTrans" (pt "1/2**k"))
(ord-field-simp-bwd)
(auto)

; (1/2**(IntS k))<=(1#3)*c+(2#3)*d-c 
(add-global-assumption "RatLeTimes" (pf "all a,b,c(0<=a -> b<=c -> a*b<=a*c)"))
(add-global-assumption
 "RatLeTimes2" (pf "all a,b,c,d(0<=a -> a<=b -> 0<=c -> c<=d -> a*c<=b*d)"))
(use "RatEqLe" (pt "(1/2)*(1/2**k)"))
(ord-field-simp-bwd)(undo)

(add-global-assumption
 "ExpTwoSuc" (pf "all k(1/2**IntS k==1/2*(1/2**k))"))
(use "ExpTwoSuc")

; (1/2)*(1/2**k)<=(1#3)*c+(2#3)*d-c
(use "RatLeEq" (pt "(2#3)*(d-c)"))
(use "RatLeTimes2")
(use "Truth-Axiom")
(use "Truth-Axiom")
(ord-field-simp-bwd)
(auto)

; (2#3)*(d-c)==(1#3)*c+(2#3)*d-c
(ord-field-simp-bwd)

; f c<<=0
(use-with "CorrElim4" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
(auto)

; 0<<=f d
(use-with "CorrElim5" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")

; f c<<=0
(use-with "CorrElim4" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")

(use-with "CorrElim3" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
(use-with "CorrElim2" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
(use-with "CorrElim1" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
; Proof finished.
(save "IVTAux1")


; "IVTAux2"
(set-goal
 (pf "all f,c,d,k(Cont f -> Corr f c d k -> f((2#3)*c+(1#3)*d)<<=0 ->
                  Corr f((2#3)*c+(1#3)*d)d(IntS k))"))
(assume "f" "c" "d" "k" "Cont f" "Corr f c d k" "f c1<<=0")
(cut (pf "f doml<=c"))
(assume "a<=c")
(cut (pf "d<=f domr"))
(assume "d<=b")
(cut (pf "(1/2**k)<=d-c"))
(assume "c<_k d")
(cut (pf "f c<<=0"))
(assume "f c<<=0")
(cut (pf "0<<=f d"))
(assume "0<<=f d")

; Corr f((2#3)*c+(1#3)*d)d(IntS k)
(use "CorrIntro")

; f doml<=(2#3)*c+(1#3)*d
(use "RatLeTrans" (pt "c"))
(auto)

; c<=(2#3)*c+(1#3)*d
(ord-field-simp-bwd)

; c<=d
(use "RatLeAux1")
(use "RatLeTrans" (pt "1/2**k"))
(ord-field-simp-bwd)
(auto)

; 1/2**(IntS k)<=d-((2#3)*c+(1#3)*d)
(use "RatEqLe" (pt "(1/2)*(1/2**k)"))
(use "ExpTwoSuc")

; (1/2)*(1/2**k)<=d-((2#3)*c+(1#3)*d)
(use "RatLeEq" (pt "(2#3)*(d-c)"))
(use "RatLeTimes2")
(auto)
(ord-field-simp-bwd)
(auto)

; (2#3)*(d-c)==d-((2#3)*c+(1#3)*d)
(ord-field-simp-bwd)
(auto)

; 0<<=f d
(use-with "CorrElim5" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")

; f c<<=0
(use-with "CorrElim4" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")

(use-with "CorrElim3" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
(use-with "CorrElim2" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
(use-with "CorrElim1" (pt "f") (pt "c") (pt "d") (pt "k") "Corr f c d k")
; Proof finished.
(save "IVTAux2")

; Now we prove IVTAux

(add-var-name "cd" (make-star (py "rat") (py "rat")))

; (pp (pf "Corr f(left cd)(right cd)k"))

"IVTAux"
(set-goal
 (pf "all f,l(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 all k,cd(
  Corr f(left cd)(right cd)k -> 
  ex cd1(
   Corr f(left cd1)(right cd1)(IntS k) & 
   (left cd<=left cd1 & right cd1<=right cd & 
    right cd1-left cd1=(2#3)*(right cd-left cd)))))"))
(assume "f" "l" "Cont f" "f a<<=0" "0<<=f b" "HypSlope" "k")
(use "Id")
(assume "cd" "Corr f c d k")
(cut (pf "f doml<=left cd"))
(assume "a<=c")
(cut (pf "right cd<=f domr"))
(assume "d<=b")
(cut (pf "left cd<=right cd"))
(assume "c<=d")

(cut (pf "ex cd0(left cd0=(2#3)*left cd+(1#3)*right cd &
                 right cd0=(1#3)*left cd+(2#3)*right cd)"))
(use "Id")
(assume "ExHyp")
(by-assume-with "ExHyp" "cd0" "cd0-Def")
(inst-with-to "cd0-Def" 'left "c0-Def")
(inst-with-to "cd0-Def" 'right "d0-Def")
(drop "cd0-Def")

(cut
 (pf "ex boole((boole -> 0<<=f(right cd0)) &
               ((boole -> F) -> f(left cd0)<<=0))"))
(assume "ExBooleHyp")
(by-assume-with "ExBooleHyp" "boole" "ExKernel")
(cases (pt "boole"))

; Case 1
(assume "Left")
(cut (pf "0<<=f(right cd0)"))
(assume "0<<=f d0")
(ex-intro (pt "left cd@right cd0"))
(split)
(ng)

; Corr f(left cd)(right cd0)(IntS k)
(simp "d0-Def")
(use "IVTAux1")
(auto)
(cut (pf "0<<=RealConstr(f approx right cd0)([k1]f uMod(IntS(IntS k1)))"))
(simp "d0-Def")
(ng)
(prop)
(use "0<<=f d0")

(split)
(split)
(use "Truth-Axiom")

; right(left cd@right cd0)<=right cd
(ng)
(simp "d0-Def")
(ord-field-simp-bwd)
(use "c<=d")

; right(left cd@right cd0)-left(left cd@right cd0)=(2#3)*(right cd-left cd)
(ng)
(simp "d0-Def")
(ord-field-simp-bwd)
(search)

; Case 2
(assume "Right")
(cut (pf "f(left cd0)<<=0"))
(assume "f c0<<=0")
(ex-intro (pt "left cd0@right cd"))
(split)
(ng)

; Corr f(left cd0)(right cd)(IntS k)
(simp "c0-Def")
(use "IVTAux2")
(auto)
(cut (pf "RealConstr(f approx left cd0)([k1]f uMod(IntS(IntS k1)))<<=0"))
(simp "c0-Def")
(ng)
(prop)
(use "f c0<<=0")

(split)
(split)

; left cd<=left(left cd0@right cd)
(ng)
(simp "c0-Def")
(ord-field-simp-bwd)
(auto)

; right(left cd0@right cd)-left(left cd0@right cd)=(2#3)*(right cd-left cd)
(ng)
(simp "c0-Def")
(ord-field-simp-bwd)
(auto)

; ex boole.(boole -> 0<<=f(right cd0)) & ((boole -> F) -> f(left cd0)<<=0)
(cut (pf "f doml<=left cd0"))
(assume "a<=c0")
(cut (pf "left cd0<=f domr"))
(assume "c0<=b")
(cut (pf "f doml<=right cd0"))
(assume "a<=d0")
(cut (pf "right cd0<=f domr"))
(assume "d0<=b")

(use "ApproxSplit" (pt "k+2+l"))

; Real(f(left cd0))
(add-global-assumption
 "ContValsReal"
 (pf "all f,x(Cont f -> Real x -> f doml<<=x -> x<<=f domr -> Real(f x))"))
(add-global-assumption
 "ContRatValsReal"
 (pf "all f,c(Cont f -> f doml<=c -> c<=f domr -> Real(f c))"))
(use "ContRatValsReal")
(auto)

; Real(f(right cd0))
(use "ContRatValsReal")
(auto)

; Real(0)
(add-global-assumption "RatReal" (pf "all a Real a"))
(use "RatReal")

; RealLt(f(left cd0))(f(right cd0))(k+2+l)
(use "HypSlope")
(auto)

; (1/2**(n+2))<=right cd0-(left cd0)
(use "RatLeTrans" (pt "(right cd-left cd)*(1/2**2)"))

; (1/2**(n+2))<=(right cd-left cd)*(1/2**2)
(add-global-assumption
 "IvtAuxAux2"
 (pf "all k,a.(1/2**k)<=a -> (1/2**(k+2))<=a*(1/2**2)"))
(use "IvtAuxAux2")
(use "CorrElim3" (pt "f"))
(use "Corr f c d k")

; (right cd-left cd)*(1/2**2)<=right cd0-left cd0
(simp "c0-Def")
(simp "d0-Def")
(ord-field-simp-bwd)
(ng)
(ord-field-simp-bwd)
(auto) 

; Now we need to prove the 4 estimates cut in earlier.

; right cd0<=f domr
(use "RatLeTrans" (pt "right cd"))

; right cd0<=right cd
(simp "d0-Def")
(ord-field-simp-bwd)
(auto)

; f doml<=right cd0
(simp "d0-Def")
(use "RatLeTrans" (pt "left cd"))
(auto)

; left cd<=(1#3)*left cd+(2#3)*right cd
(ord-field-simp-bwd)
(use "c<=d")

; left cd0<=f domr
(use "RatLeTrans" (pt "right cd"))

; left cd0<=right cd
(simp "c0-Def")
(ord-field-simp-bwd)
(auto)

; f doml<=left cd0
(use "RatLeTrans" (pt "left cd"))
(auto)

; left cd<=left cd0
(simp "c0-Def")
(ord-field-simp-bwd)
(use "c<=d")

; ex cd0.left cd0=(2#3)*left cd+(1#3)*right cd & right cd0=(1#3)*left cd+(2#3)*right cd
(ex-intro (pt "((2#3)*left cd+(1#3)*right cd)@((1#3)*left cd+(2#3)*right cd)"))
(prop)

; left cd<=right cd
(use "RatLeAux1")
(use "RatLeTrans" (pt "1/2**k"))
(ord-field-simp-bwd)
(auto)
(use-with
 "CorrElim3" (pt "f") (pt "left cd") (pt "right cd") (pt "k") "Corr f c d k")

; right cd<=f domr
(use-with
 "CorrElim2" (pt "f") (pt "left cd") (pt "right cd") (pt "k") "Corr f c d k")

; f doml<=left cd
(use-with
 "CorrElim1" (pt "f") (pt "left cd") (pt "right cd") (pt "k") "Corr f c d k")
; Proof finished.
(save "IVTAux")

(define IVTAux-eterm
  (proof-to-extracted-term (theorem-name-to-proof "IVTAux")))
(define IVTAux-neterm (nt IVTAux-eterm))

(pp IVTAux-neterm)

#|
[f0,k1,k2]
 (cId rat@@rat=>rat@@rat)
 ([cd4]
   [let cd5
     ((2#3)*left cd4+(1#3)*right cd4@(1#3)*left cd4+(2#3)*right cd4)
     [if (cApproxSplit
          (RealConstr(f0 approx left cd5)([k6]f0 uMod(IntS(IntS k6))))
          (RealConstr(f0 approx right cd5)([k6]f0 uMod(IntS(IntS k6))))
          0
          (IntS(IntS(k2+k1))))
      (left cd4@right cd5)
      (left cd5@right cd4)]])
|#

(pp (term-to-type IVTAux-neterm))


; We now want prove the existence of the sequence of cds.

; It seems most direct to make use of the (valid) axiom of dependent choice:

(add-var-name "xx" "yy" (py "alpha"))
(add-var-name "xxs" (py "nat=>alpha"))
(add-pvar-name "RR" (make-arity (py "nat") (py "alpha")))
(add-pvar-name "SS" (make-arity (py "nat") (py "alpha") (py "alpha")))

; (remove-var-name "xxs")
; (remove-pvar-name "RR")
; (remove-pvar-name "SS")

; For the moment we add DC as a global assumption, animated by the
; appropriate recursion operator.  Later, it should be added as an
; axiom.  For simplicity we choose a formulation of DC using a
; predicate variable without computational content.

(pp (pf "all xx0.RR^ Zero xx0 -> 
      (all n,xx.RR^ n xx -> ex yy.RR^(Succ n)yy & SS^ n xx yy) -> 
      ex xxs.Equal(xxs Zero)xx0 & 
             all n RR^ n(xxs n) & all n SS^ n(xxs n)(xxs(Succ n))"))

(add-global-assumption
 "DC"
 (pf "all xx0(
 RR^ Zero xx0 -> 
 all n,xx(RR^ n xx -> ex yy(RR^(Succ n)yy & SS^ n xx yy)) -> 
 ex xxs(
  Equal(xxs Zero)xx0 & all n RR^ n(xxs n) & all n SS^ n(xxs n)(xxs(Succ n))))")
 3)

; (remove-global-assumption "DC")

(define et-type (formula-to-et-type
		 (aconst-to-uninst-formula
		  (global-assumption-name-to-aconst "DC"))))

(pp et-type)
; alpha=>(nat=>alpha=>alpha)=>nat=>alpha

(add-var-name "init" (py "alpha"))
(add-var-name "step" (py "nat=>alpha=>alpha"))

(add-computation-rule (pt "(cDC alpha) init step Zero") (pt "init"))
(add-computation-rule
 (pt "(cDC alpha) init step(Succ n)")
 (pt "step(Succ n)((cDC alpha) init step n)"))

(display-program-constant "cDC")

(add-var-name "cds" (py "nat=>rat@@rat"))

(pp (pf "all f,l,k0.Cont f -> f f doml<<=0 -> 0<<=f f domr ->
     (1/2**(k0+1))<=f domr-f doml ->
     (all c,d,k.f doml<=c -> d<=f domr ->
                (1/2**k)<=d-c -> RealLt(f c)(f d)(k+l)) ->     
     ex cds.Equal(cds Zero)(f doml@f domr) &
            all n Corr f(left(cds n))(right(cds n))(k0+n) &
            all n.left(cds n)<=left(cds(Succ n)) & 
                  right(cds(Succ n))<=right(cds n) &
                  right(cds(Succ n))-left(cds(Succ n))=
                  (2#3)*(right(cds n)-left(cds n))"))

; "Ivtcds"
(set-goal 
 (pf "all f,l,k0(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 ex cds(
  Equal(cds Zero)(f doml@f domr) & 
  all n Corr f(left(cds n))(right(cds n))(k0+n) & 
  all n(
   left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
   right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n)))))"))
(assume "f" "l" "k0" "Cont f" "f a<<=0" "0<<=f b" "a <_k0 b" "HypSlope")

; ex cds(
;       Equal(cds Zero)(f doml@f domr) & 
;       all n Corr f(left(cds n))(right(cds n))(k0+n) & 
;       all n(
;        left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
;        right(cds(Succ n))-left(cds(Succ n))=
;        (2#3)*(right(cds n)-left(cds n)))) from
;   f  l  k0  Cont f:Cont f
;   f a<<=0:f f doml<<=0
;   0<<=f b:0<<=f f domr
;   a <_k0 b:1/2**k0<=f domr-f doml
;   HypSlope:all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l))
(cut
 (pf "ex cds(
 Equal(cds Zero)(f doml@f domr) & 
 all n Corr f(left(cds n))(right(cds n))(k0+n) & 
 all n(
  left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
  right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n))))"))
(assume "DCInst")
(by-assume-with "DCInst" "cds" "H")
(ex-intro (pt "cds"))
(search)

; Now we prove the cut formula by instantiating DC
(use-with
 "DC"
 (py "rat@@rat")
 (make-cterm (pv "n") (pv "cd") (pf "Corr f(left cd)(right cd)(k0+n)"))
 (make-cterm (pv "n") (pv "cd") (pv "cd1")
	     (pf "left cd<=left cd1 & right cd1<=right cd &
                  right cd1-left cd1=(2#3)*(right cd-left cd)"))
 (pt "f doml@f domr") "?" "?")

; Corr f(left(f doml@f domr))(right(f doml@f domr))(k0+Zero)
(use "CorrIntro")
(auto)

; Now the step hypothesis, to be proved by means of IVTAux
(assume "n" "cd" "Corr-Hyp")

; ?_17: ex cd5041(
;        Corr f(left cd5041)(right cd5041)(k0+Succ n) & 
;        (left cd<=left cd5041 & right cd5041<=right cd & 
;         right cd5041-left cd5041=(2#3)*(right cd-left cd))) from
;   f  l  k0  Cont f:Cont f
;   f a<<=0:f f doml<<=0
;   0<<=f b:0<<=f f domr
;   a <_k0 b:1/2**k0<=f domr-f doml
;   HypSlope:all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l))
;   n  cd  Corr-Hyp:Corr f(left cd)(right cd)(k0+n)
(use "IVTAux" (pt "l"))
(auto)
; Proof finished.
(save "IVTcds")

(define IVTcds-eterm
  (proof-to-extracted-term (theorem-name-to-proof "IVTcds")))
(define IVTcds-neterm (nt IVTcds-eterm))

(pp IVTcds-neterm)
; [f0,k1,k2](cDC rat@@rat)(f0 doml@f0 domr)([n4]cIVTAux f0 k1(k2+n4))

; We now prove that [k]left(cds n+k) increases.

; "IVTLeftIncr"
(set-goal 
 (pf "all f,l,k0(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 all cds(
  Equal(cds Zero)(f doml@f domr) & 
  all n Corr f(left(cds n))(right(cds n))(k0+n) & 
  all n(
   left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
   right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n))) -> 
  all n,m left(cds n)<=left(cds(n+m))))"))
(assume "f" "l" "k0" "Cont f" "f a<<=0" "0<<=f b" "a <_k0 b" "HypSlope"
	"cds" "Hcds" "n")
(ind)
  (use "Truth-Axiom")
(assume "m" "IH")
(use "RatLeTrans" (pt "left(cds(n+m))"))
(use "IH")
(use "Hcds")
; Proof finished.
(save "IVTLeftIncr")

; The corresponding proof of d(n+k)<=dn:

; "IVTRightDecr"
(set-goal 
 (pf "all cds(
 all n right(cds(Succ n))<=right(cds n) -> 
 all n,m right(cds(n+m))<=right(cds n))"))
(assume "cds" "Step" "n")
(ind)
  (use "Truth-Axiom")
(assume "m" "IH")
(use "RatLeTrans" (pt "right(cds(n+m))"))
(auto)
; Proof finished.
(save "IVTRightDecr")


; Now what we wanted to do:

; "IVTDiff"
(set-goal 
 (pf "all f,cds(
 Equal(cds Zero)(f doml@f domr) -> 
 all n right(cds(Succ n))-left(cds(Succ n))=
       (2#3)*(right(cds n)-left(cds n)) -> 
 all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml))"))
(assume "f" "cds" "EqZero" "Step")
(ind)
  (simp "EqZero")
  (use "Truth-Axiom")
(assume "n" "IH")
(simp "Step")
(simp "IH")
(ng)
(ord-field-simp-bwd)
; Proof finished.
(save "IVTDiff")

; Proof that (left(cds n)) is a Cauchy sequence with modulus 2*(n+k0)

; (add-global-assumption
;  "RatMinusLe2"
;  (pf "all a1,a2,b1,b2.a1<=a2 -> b2<=b1 -> a1-b1<=a2-b2"))

; We will need a general criterion for Cauchyness, in order to avoid
; doing a symmetric argument twice, in a concrete case.  To be called
; CauchyCrit.

(add-global-assumption "RatAbsSymm" (pf "all a,b(abs(a-b)==abs(b-a))"))
(add-global-assumption "RatAbsNNeg" (pf "all a(0<=a -> abs a==a)"))
(add-global-assumption "RatAbsNPos" (pf "all a,b(a<=b -> abs(a-b)==b-a)"))


; "CauchyCrit"
(set-goal
 (pf "all as,M(all k,n,m(M k<=n -> n<=m -> abs(as n-as m)<=1/2**k) ->
               Cauchy as M)"))
(assume "as" "M" "Hyp")
(use "CauchyIntro")

; all k,n,m(M k<=n -> M k<=m -> abs(as n-as m)<=1/2**k)
(assume "k" "n" "m" "M k<=n" "M k<=m")
(use "NatLeLin" (pt "n") (pt "m"))

; n<=m -> abs(as n-as m)<=1/2**k
(assume "n<=m")
(auto)

; m<=n -> abs(as n-as m)<=1/2**k
(assume "m<=n")
(use "RatEqLe" (pt "abs(as m-as n)"))

; abs(as n-as m)==abs(as m-as n)
(use "RatAbsSymm")
(auto)
; Proof finished.
(save "CauchyCrit")


; For the Cauchy modulus we need

(add-program-constant "IntToNat" (py "int=>nat") t-deg-one)

(add-computation-rules
 "IntToNat IntZero" "Zero"
 "IntToNat IntP pos" "PosToNat pos"
 "IntToNat IntN pos" "Zero")

(add-global-assumption
 "IntToNatMon"
 (pf "all int1,int2(int1<=int2 -> IntToNat int1<=IntToNat int2)"))


; "IVTRealLeft"
(set-goal 
 (pf "all a,b,k1(
 b-a<=2**k1 -> 
 all cds(
  all n,m(n<=m -> left(cds n)<=left(cds m)) -> 
  all n,m(n<=m -> right(cds m)<=right(cds n)) -> 
  all n left(cds n)<=right(cds n) -> 
  all n right(cds n)-left(cds n)=(2#3)**n*(b-a) -> 
  Real(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))))"))
(assume "a" "b" "k1" "IntBound" "cds" "cIncr" "dDecr" "cs<=ds" "cdDiff")
(use "RealIntro")

; Cauchyness
(use "CauchyCrit")
(ng)

; all k,n,m(
;   abs(2*(k+k1))<=n -> n<=m -> abs(left(cds n)-left(cds m))<=1/2**k)
(assume "k" "n" "m" "Mk<=n" "n<=m")

; abs(left(cds n)-left(cds m))<=1/2**k
(use "RatEqLe" (pt "left(cds m)-left(cds n)"))

; abs(left(cds n)-left(cds m))==left(cds m)-left(cds n)
(use "RatAbsNPos")
(auto)

; left(cds m)-left(cds n)<=1/2**k
(use "RatLeTrans" (pt "right(cds m)-left(cds n)"))

; left(cds m)-left(cds n)<=right(cds m)-left(cds n)
(use "RatMinusLe2")
(auto)

; right(cds m)-left(cds n)<=1/2**k
(use "RatLeTrans" (pt "right(cds n)-left(cds n)"))

; right(cds m)-left(cds n)<=right(cds n)-left(cds n)
(use "RatMinusLe2")
(auto)

; right(cds n)-left(cds n)<=1/2**k
(inst-with-to "cdDiff" (pt "n") "cdDiffn")
(add-global-assumption
 "IVTRealAux1"
 (pf "all a,b,c,d,n,k,k1(b-a<=2**k1 -> IntToNat(2*(k+k1))<=n -> 
                         d-c=(2#3)**n*(b-a) ->
                         d-c<=1/2**k)"))
; Proof: d-c =  (2#3)**n*(b-a)
;            <= (2#3)**n*2**k1
;            <= (2#3)**(2*(k+k1))*2**k1
;            <= (2**3)**k* (2**3)*k1 / (3**2)**k* (3**2)*k1 *(1/2**k)
;            =  exp(1/2)k
(use "IVTRealAux1" (pt "a") (pt "b") (pt "n") (pt "k1"))
(auto)

; Mon((RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))mod)
(ng)

; Mon([k2]IntToNat(2*(k2+k1)))
(use "MonIntro")
(ng)
(assume "k" "l" "k<=l")
(use "IntToNatMon")
(ord-field-simp-bwd)
(use "k<=l")
; Proof finished.
(save "IVTRealLeft")

; The final goal, split into parts:

; "IVTFinalRealLeft"
(set-goal 
 (pf "all f,l,k0,k1(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 all cds(
  Equal(cds Zero)(f doml@f domr) -> 
  all n Corr f(left(cds n))(right(cds n))(k0+n) -> 
  all n left(cds n)<=left(cds(Succ n)) -> 
  all n right(cds(Succ n))<=right(cds n) -> 
  all n 
   right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n)) -> 
  Real(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))))"))
(assume "f" "l" "k0" "k1" "Cont f" "f a<<=0" "0<<=f b"
	"a <_k0 b" "b-a<=2**k1" "HypSlope" 
        "cds" "cdsProp1" "cdsProp2" "cdsProp3" "cdsProp4" "cdsProp5")
(use "IVTRealLeft" (pt "f doml") (pt "f domr"))
(use "b-a<=2**k1")

; ?_4: all n,m.n<=m -> left(cds n)<=left(cds m)
(add-global-assumption
 "IVTFinalAux1"
 (pf "all cs.all n cs n<=cs(Succ n) -> all n,m.n<=m -> cs n<=cs m"))
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux1" (pt "[n]left(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(use "cdsProp3")

; ?_5: all n,m.n<=m -> right(cds m)<=right(cds n)
(add-global-assumption
 "IVTFinalAux2"
 (pf "all ds.all n ds(Succ n)<=ds n -> all n,m.n<=m -> ds m<=ds n"))
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux2" (pt "[n]right(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(use "cdsProp4")

; ?_6: all n left(cds n)<=right(cds n)
(add-global-assumption
 "IVTFinalAux3"
 (pf "all f,c,d,k(Corr f c d k -> c<=d)"))
(assume "n")
(cut (pf "Corr f(left(cds n))(right(cds n))(k0+n)"))
(assume "CorrHyp")
(use-with "IVTFinalAux3" (pt "f") (pt "(left(cds n))") (pt "right(cds n)")
	  (pt "k0+n") "CorrHyp")
(use "cdsProp2")

; ?_7: all n (2#3)*(right(cds n)-left(cds n))=(2#3)**n*(f domr-f doml)
; Here we need IVTDiff (display-theorems "IVTDiff")
(use "IVTDiff")
(use "cdsProp1")
(use "cdsProp5")
; Proof finished.
(save "IVTFinalRealLeft")


; "IVTRealAppLeft"
(set-goal 
 (pf "all f,l,k0,k1(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 all cds(
  Equal(cds Zero)(f doml@f domr) -> 
  all n Corr f(left(cds n))(right(cds n))(k0+n) -> 
  all n left(cds n)<=left(cds(Succ n)) -> 
  all n right(cds(Succ n))<=right(cds n) -> 
  all n 
   right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n)) -> 
  Real(f(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1)))))))"))
(assume "f" "l" "k0" "k1" "Cont f" "f a<<=0" "0<<=f b"
	"a <_k0 b" "b-a<=2**k1" "HypSlope" 
        "cds" "cdsProp1" "cdsProp2" "cdsProp3" "cdsProp4" "cdsProp5")
(add-global-assumption
 "ContAppReal"
 (pf "all f,x.Cont f -> Real x -> 
              all n f doml<=x seq n -> all n x seq n<=f domr -> Real(f x)"))
(use "ContAppReal")
(auto)
(use  "IVTFinalRealLeft" (pt "f") (pt "l") (pt "k0"))
(auto)

; ?_5: all n f doml<=(RealConstr([n]left(cds n))([k]2*(k+k1+1)))seq n
(assume "n")
(use "CorrElim1" (pt "right(cds n)") (pt "k0+n"))
(ng)
(auto)

; ?_6: all n (RealConstr([n]left(cds n))([k]2*(k+k1+1)))seq n<=f domr
(assume "n")
(ng)
(use "RatLeTrans" (pt "right(cds n)"))
(display-global-assumptions "IVTFinalAux3")
(use "IVTFinalAux3" (pt "f") (pt "k0+n"))
(auto)
(use "CorrElim2" (pt "left(cds n)") (pt "k0+n"))
(auto)
; Proof finished.
(save "IVTRealAppLeft")

; Similary for right:

; "IVTRealRight"
(set-goal 
 (pf "all a,b,k1(
 b-a<=2**k1 -> 
 all cds(
  all n,m(n<=m -> left(cds n)<=left(cds m)) -> 
  all n,m(n<=m -> right(cds m)<=right(cds n)) -> 
  all n left(cds n)<=right(cds n) -> 
  all n right(cds n)-left(cds n)=(2#3)**n*(b-a) -> 
  Real(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))))"))
(assume "a" "b" "k1" "IntBound" "cds" "cIncr" "dDecr" "cs<=ds" "cdDiff")
(use "RealIntro")

; Cauchyness
(use "CauchyCrit")
(ng)

; all k,n,m(
;       IntToNat(2*(k+k1))<=n -> 
;       n<=m -> abs(right(cds n)-right(cds m))<=1/2**k)
(assume "k" "n" "m" "Mk<=n" "n<=m")

; abs(right(cds n)-right(cds m))<=1/2**k
(use "RatEqLe" (pt "right(cds n)-right(cds m)"))

; abs(right(cds n)-right(cds m))==right(cds n)-right(cds m)
(add-global-assumption
 "RatAbsPos"
 (pf "all a,b(a<=b -> abs(b-a)==b-a)"))
(use "RatAbsPos")
(auto)

; right(cds n)-right(cds m)<=1/2**k
(use "RatLeTrans" (pt "right(cds n)-left(cds m)"))

; right(cds n)-right(cds m)<=right(cds n)-left(cds m)
(use "RatMinusLe2")
(auto)

; right(cds n)-left(cds m)<=1/2**k
(use "RatLeTrans" (pt "right(cds n)-left(cds n)"))

; right(cds n)-left(cds m)<=right(cds n)-left(cds n)
(use "RatMinusLe2")
(auto)

; right(cds n)-left(cds n)<=1/2**k
(inst-with-to "cdDiff" (pt "n") "cdDiffn")
(use "IVTRealAux1" (pt "a") (pt "b") (pt "n") (pt "k1"))
(auto)

; Mon((RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))mod)
(ng)

; Mon([k2]IntToNat(2*(k2+k1)))
(use "MonIntro")
(ng)
(assume "k" "l" "k<=l")
(use "IntToNatMon")
(ord-field-simp-bwd)
(use "k<=l")
; Proof finished.
(save "IVTRealRight")


; "IVTFinalRealRight"
(set-goal 
 (pf "all f,l,k0,k1(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 all cds(
  Equal(cds Zero)(f doml@f domr) -> 
  all n Corr f(left(cds n))(right(cds n))(k0+n) -> 
  all n left(cds n)<=left(cds(Succ n)) -> 
  all n right(cds(Succ n))<=right(cds n) -> 
  all n 
   right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n)) -> 
  Real(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))))"))
(assume "f" "l" "k0" "k1" "Cont f" "f a<<=0" "0<<=f b"
	"a <_k0 b" "b-a<=2**k1" "HypSlope" 
        "cds" "cdsProp1" "cdsProp2" "cdsProp3" "cdsProp4" "cdsProp5")
(use "IVTRealRight" (pt "f doml") (pt "f domr"))
(use "b-a<=2**k1")

; all n,m.n<=m -> left(cds n)<=left(cds m)
; (add-global-assumption
;  "IVTFinalAux1"
;  (pf "all cs.all n cs n<=cs(Succ n) -> all n,m.n<=m -> cs n<=cs m"))
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux1" (pt "[n]left(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(use "cdsProp3")

; all n,m.n<=m -> right(cds m)<=right(cds n)
; (add-global-assumption
;  "IVTFinalAux2"
;  (pf "all ds.all n ds(Succ n)<=ds n -> all n,m.n<=m -> ds m<=ds n"))
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux2" (pt "[n]right(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(use "cdsProp4")

; all n left(cds n)<=right(cds n)
; (add-global-assumption
;  "IVTFinalAux3"
;  (pf "all f,c,d,n.Corr f c d k -> c<=d"))
(assume "n")
(cut (pf "Corr f(left(cds n))(right(cds n))(k0+n)"))
(assume "CorrHyp")
(use-with "IVTFinalAux3" (pt "f") (pt "(left(cds n))") (pt "right(cds n)")
	  (pt "k0+n") "CorrHyp")
(use "cdsProp2")

; all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml)
; Here we need IVTDiff (display-theorems "IVTDiff")
(use "IVTDiff")
(use "cdsProp1")
(use "cdsProp5")
; Proof finished.
(save "IVTFinalRealRight")


; "IVTRealAppRight"
(set-goal 
 (pf "all f,l,k0,k1(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 all cds(
  Equal(cds Zero)(f doml@f domr) -> 
  all n Corr f(left(cds n))(right(cds n))(k0+n) -> 
  all n left(cds n)<=left(cds(Succ n)) -> 
  all n right(cds(Succ n))<=right(cds n) -> 
  all n 
   right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n)) -> 
  Real(f(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1)))))))"))
(assume "f" "l" "k0" "k1" "Cont f" "f a<<=0" "0<<=f b"
	"a <_k0 b" "b-a<=2**k1" "HypSlope" 
        "cds" "cdsProp1" "cdsProp2" "cdsProp3" "cdsProp4" "cdsProp5")
; (add-global-assumption
;  "ContAppReal"
;  (pf "all f,x.Cont f -> Real x -> 
;               all n f doml<=x seq n -> all n x seq n<=f domr -> Real(f x)"))
(use "ContAppReal")
(auto)
(use  "IVTFinalRealRight" (pt "f") (pt "l") (pt "k0"))
(auto)

; all n f doml<=(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))seq n
(assume "n")
(ng)
(use "RatLeTrans" (pt "left(cds n)"))
(use "CorrElim1" (pt "right(cds n)") (pt "k0+n"))
(auto)
(display-global-assumptions "IVTFinalAux3")
(use "IVTFinalAux3" (pt "f") (pt "k0+n"))
(auto)

; all n (RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))seq n<=f domr
(assume "n")
(ng)
(use "CorrElim2" (pt "left(cds n)") (pt "k0+n"))
(auto)
; Proof finished.
(save "IVTRealAppRight")


; Now the final goal
; "IVTFinal"
(set-goal 
 (pf "all f,l,k0,k1(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 ex x(Real x & f x===0))"))
(assume "f" "l" "k0" "k1" "Cont f" "f a<<=0" "0<<=f b"
	"a <_k0 b" "b-a<=2**k1" "HypSlope")
(cut (pf "ex cds(
 Equal(cds Zero)(f doml@f domr) & 
 all n Corr f(left(cds n))(right(cds n))(k0+n) & 
 all n(
  left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
  right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n))))"))
(assume "Excds")
(by-assume-with "Excds" "cds" "cdsProp")
(ex-intro (pt "RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1)))"))
(split)
(use  "IVTFinalRealLeft" (pt "f") (pt "l") (pt "k0"))
(auto)

; f(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))===0
(add-global-assumption
 "RealLeAntiSymm"
 (pf "all x,y(Real x -> Real y -> x<<=y -> y<<=x -> x===y)"))
(use "RealLeAntiSymm")

; Real(f(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1)))))
(use "IVTRealAppLeft" (pt "l") (pt "k0"))
(auto)

; Real(0)
(add-global-assumption "RealZero" (pf "Real(0)"))
(use "RealZero")

; (RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))<<=0
(add-global-assumption
 "LeContAppZero"
 (pf "all f,x.Cont f -> Real x -> all n f(x seq n)<<=0 -> f x<<=0"))
(use "LeContAppZero")
(use "Cont f")
(use  "IVTFinalRealLeft" (pt "f") (pt "l") (pt "k0"))
(auto)

; all n f((RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))seq n)<<=0
(assume "n")
(use "CorrElim4" (pt "right(cds n)") (pt "k0+n"))
(auto)

; 0<<=f(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))
(add-global-assumption
 "RealLeZeroCompat"
 (pf "all x,y(Real x -> Real y -> x===y -> 0<<=y -> 0<<=x)"))
(use "RealLeZeroCompat" (pt "f(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))"))

; Real(f(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1)))))
(use "IVTRealAppLeft" (pt "l") (pt "k0"))
(auto)

; Real(f(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1)))))
(use "IVTRealAppRight" (pt "l") (pt "k0"))
(auto)

; f(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))===
; f(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))
(add-global-assumption
 "ContAppCompat"
 (pf "all f,x,y(Cont f -> Real x -> Real y -> x===y -> f x===f y)"))
(use "ContAppCompat")
(auto)
(use "IVTRealLeft" (pt "f doml") (pt "f domr"))
(auto)

; all n,m(n<=m -> left(cds n)<=left(cds m))
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux1" (pt "[n]left(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n,m.n<=m -> right(cds m)<=right(cds n)
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux2" (pt "[n]right(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n left(cds n)<=right(cds n)
(assume "n")
(cut (pf "Corr f(left(cds n))(right(cds n))(k0+n)"))
(assume "CorrHyp")
(use-with "IVTFinalAux3" (pt "f") (pt "(left(cds n))") (pt "right(cds n)")
	  (pt "k0+n") "CorrHyp")
(auto)

; all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml)
; Here we need IVTDiff (display-theorems "IVTDiff")
(use "IVTDiff")
(auto)

; Real(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))
(use "IVTRealRight" (pt "f doml") (pt "f domr"))
(auto)

; all n,m.n<=m -> left(cds n)<=left(cds m)
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux1" (pt "[n]left(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n,m.n<=m -> right(cds m)<=right(cds n)
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux2" (pt "[n]right(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n left(cds n)<=right(cds n)
(assume "n")
(cut (pf "Corr f(left(cds n))(right(cds n))(k0+n)"))
(assume "CorrHyp")
(use-with "IVTFinalAux3" (pt "f") (pt "(left(cds n))") (pt "right(cds n)")
	  (pt "k0+n") "CorrHyp")
(auto)

; all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml)
; Here we need IVTDiff (display-theorems "IVTDiff")
(use "IVTDiff")
(auto)

; RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1)))===
; RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1)))
(use "RealEqChar2")

; Cauchy([n]left(cds n))([k]IntToNat(2*(k+k1)))
(cut (pf "Real(RealConstr([n]left(cds n))([k]IntToNat(2*(k+k1))))"))
(use "RealElimVariant1")
(use "IVTRealLeft" (pt "f doml") (pt "f domr"))
(auto)

; all n,m.n<=m -> left(cds n)<=left(cds m)
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux1" (pt "[n]left(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n,m.n<=m -> right(cds m)<=right(cds n)
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux2" (pt "[n]right(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n left(cds n)<=right(cds n)
(assume "n")
(cut (pf "Corr f(left(cds n))(right(cds n))(k0+n)"))
(assume "CorrHyp")
(use-with "IVTFinalAux3" (pt "f") (pt "(left(cds n))") (pt "right(cds n)")
	  (pt "k0+n") "CorrHyp")
(auto)

; all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml)
; Here we need IVTDiff (display-theorems "IVTDiff")
(use "IVTDiff")
(auto)

; Cauchy([n]right(cds n))([k]IntToNat(2*(k+k1)))
(cut (pf "Real(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))"))
(use "RealElimVariant1")
(use "IVTRealRight" (pt "f doml") (pt "f domr"))
(auto)

; all n,m.n<=m -> left(cds n)<=left(cds m)
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux1" (pt "[n]left(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n,m(n<=m -> right(cds m)<=right(cds n))
(assume "n" "m" "n<=m")
(use-with "IVTFinalAux2" (pt "[n]right(cds n)") "?" (pt "n") (pt "m") "n<=m")
(ng)
(auto)

; all n left(cds n)<=right(cds n)
(assume "n")
(cut (pf "Corr f(left(cds n))(right(cds n))(k0+n)"))
(assume "CorrHyp")
(use-with "IVTFinalAux3" (pt "f") (pt "(left(cds n))") (pt "right(cds n)")
	  (pt "k0+n") "CorrHyp")
(auto)

; all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml)
; Here we need IVTDiff (display-theorems "IVTDiff")
(use "IVTDiff")
(auto)

; all k ex n0 all n.n0<=n -> abs(([n]left(cds n))n-([n]right(cds n))n)<=1/2**k
(assume "k")
(ng)

; ex n0 all n.n0<=n -> abs(left(cds n)-right(cds n))<=1/2**k
(add-global-assumption
 "IVTFinalAux4"
 (pf "all f,cds.
      (all n right(cds n)-left(cds n)=(2#3)**n*(f domr-f doml)) ->
      all k ex n0 all n.n0<=n -> abs(left(cds n)-right(cds n))<=1/2**k"))
; needs an additional assumption left(cds n)<=right(cds n) to be correct
(use "IVTFinalAux4" (pt "f"))
(use "IVTDiff")
(auto)

; 0<<=f(RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))
(add-global-assumption
 "LeZeroContApp"
 (pf "all f,y.Cont f -> Real y -> all n 0<<=f(y seq n) -> 0<<=f y"))
(use "LeZeroContApp")
(use "Cont f")
(use  "IVTFinalRealRight" (pt "f") (pt "l") (pt "k0"))
(auto)

; all n 0<<=f((RealConstr([n]right(cds n))([k]IntToNat(2*(k+k1))))seq n)
(assume "n")
(display-theorems "CorrElim5")
(use "CorrElim5" (pt "left(cds n)") (pt "k0+n"))
(auto)

; ex cds.Equal(cds Zero)(f doml@f domr) & all n Corr f(left(cds n))(right(cds n))(k0+n) & (all n.left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n)))
(use "IVTcds" (pt "l"))
(auto)
; Proof finished.
(save "IVTFinal")

(define IVTFinal-eterm
  (proof-to-extracted-term (theorem-name-to-proof "IVTFinal")))
(define IVTFinal-neterm (nt IVTFinal-eterm))
(pp IVTFinal-neterm)

; [f0,k1,k2,k3]
;  RealConstr([n4]left(cIVTcds f0 k1 k2 n4))([k4]IntToNat(2*(k4+k3)))

; For to extract an approximation of sqrt 2 we prove IVTApprox
; This needs RealApprox (in real.scm)

; "IVTApprox"
(set-goal 
 (pf "all f,l,k0,k1(
 Cont f -> 
 f f doml<<=0 -> 
 0<<=f f domr -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 exnc x(Real x & f x===0 & all k ex c abs(c-x)<<=1/2**k))"))
(assume "f" "l" "k0" "k1" "Cont f" "f a<<=0" "0<<=f b"
	"a <_k0 b" "b-a<=2**k1" "HypSlope")
(cut (pf "ex x.Real x & f x===0"))
(assume "ExHyp")
(by-assume-with "ExHyp" "x" "xProp")

; exnc x.Real x & f x===0 & all k ex c abs(c-x)<<=1/2**k
(exnc-intro (pt "x"))
(split)
(use "xProp")

; all k ex c abs(c-x)<<=1/2**k
(assume "k")
(use "RealApprox")
(use "xProp")

; ex x(Real x & f x===0)
(use "IVTFinal" (pt "l") (pt "k0") (pt "k1"))
(auto)
; Proof finished.
(save "IVTApprox")

(define IVTApprox-eterm
  (proof-to-extracted-term (theorem-name-to-proof "IVTApprox")))
(define IVTApprox-neterm (nt IVTApprox-eterm))
(pp IVTApprox-neterm)

; [f0,k1,k2,k3]cRealApprox(cIVTFinal f0 k1 k2 k3)


; We now prove that every continuous monotone function with a lower
; bound on its slope has a continuous inverse.

(add-var-name "g" (make-alg "cont"))
(add-var-name "u" (make-alg "rat"))

(add-program-constant "Shift" (py "cont=>rat=>cont") 1)

(add-computation-rule
 (pt "Shift f u")
 (pt "ContConstr f doml f domr([a,n]f approx a n-u)f uMod f uModCont"))

(add-global-assumption
 "ShiftProp"
 (pf "all f,u,c.Cont f -> f doml<=c -> c<=f domr -> Shift f u c===f c-u"))

(add-global-assumption
 "ShiftPropRev"
 (pf "all f,u,c.Cont f -> f doml<=c -> c<=f domr -> f c-u===Shift f u c"))

(add-global-assumption
 "ContShift" (pf "all f,u.Cont f -> Cont(Shift f u)"))

; We will apply AC to "all u ex x.Real x & Shift f u x===0".  The left
; component of x is a Cauchy sequence, and the whole function is the
; approximation part of the continuous function to be constructed.

; (add-global-assumption
;  "AC" (pf "all alpha1^ ex alpha2^ (Pvar alpha1 alpha2)alpha1^alpha2^ ->
;             ex alpha1=>alpha2^ all alpha1^ 
;              (Pvar alpha1 alpha2)alpha1^(alpha1=>alpha2^alpha1^)"))

(add-global-assumption ;to be used instead of "IVTFinalAux4"
 "InvAux1" (pf "all a,b,k1,k,n.b-a<=2**k1 -> 2*(k1+k)<=n -> 
                (2#3)**n*(b-a)<=1/2**k"))

(add-global-assumption
 "RealLeRefl"
 (pf "all x.Real x -> x<<=x"))

; "Inv"
(set-goal
 (pf "all f,l,k0,k1,a1,b1(
 Cont f -> 
 f f doml<<=a1 -> 
 b1<<=f f domr -> 
 a1<b1 -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 ex g(
  Cont g & a1==g doml & b1==g domr & all y(a1<<=y -> y<<=b1 -> f(g y)===y) & 
  all x(f doml<<=x -> x<<=f domr -> g(f x)===x)))"))
(assume "f" "l" "k0" "k1" "a1" "b1" "Cont f" "f a<=a1" "b1<=f b" "a1<b1"
	"a <_k0 b" "b-a<=2**k1" "HypSlope")
(assert
 (pf "all u.a1<=u -> u<=b1 -> 
      ex cds.Equal(cds Zero)((Shift f u)doml@(Shift f u)domr) &
            all n Corr(Shift f u)(left(cds n))(right(cds n))(k0+n) &
            all n.left(cds n)<=left(cds(Succ n)) & 
                  right(cds(Succ n))<=right(cds n) &
                  right(cds(Succ n))-left(cds(Succ n))=
                  (2#3)*(right(cds n)-left(cds n))"))
 (assume "u" "a1<=u" "u<=b1")
 (use "IVTcds" (pt "l") (pt "k0+1") (pt "k1"))
 (use "ContShift")
 (use "Cont f")

; Shift f u(Shift f u)doml<<=0 from
 (add-global-assumption
  "InvAux2"
  (pf "all f,u.Cont f -> Shift f u(f doml)===(f doml-u)"))
 (simp (pf "(Shift f u)doml=f doml"))
 (add-global-assumption
  "RealEqLe"
  (pf "all x1,x2,x3.x1===x2 -> x2<<=x3 -> x1<<=x3"))
 (use "RealEqLe" (pt "f f doml-u"))
 (use "ShiftProp")
 (auto)

; f doml<=f domr ;should be part of the def on Cont
 (add-global-assumption
  "ContDom" (pf "all f.Cont f -> f doml<=f domr"))
 (use "ContDom")
 (auto)
 (ord-field-simp-bwd)
 (add-global-assumption
  "RealLeTrans"
  (pf "all x1,x2,x3(
       Real x1 -> Real x2 -> Real x3 -> x1<<=x2 -> x2<<=x3 -> x1<<=x3)"))
 (use "RealLeTrans" (pt "RealConstr([n]a1)([k]Zero)"))
 (add-global-assumption
  "ContAppRat"
  (pf "all f,c.Cont f -> f doml<=c -> c<=f domr -> Real(f c)"))
 (use "ContAppRat")
 (auto)
 (use "ContDom")
 (auto)
 (add-global-assumption
  "RealRat" (pf "all a Real a"))
 (use "RealRat")
 (use "RealRat")

; f f doml<<=a1 (with f a<=a1:f f doml<<=a1 in context)
 (use "f a<=a1")
 (auto)

; a1<<=u
 (add-global-assumption
  "RatRealLe" (pf "all a,b.a<=b -> a<<=b"))
 (use "RatRealLe")
 (auto)

; 0<<=Shift f u(Shift f u)domr
 (simp (pf "(Shift f u)domr=f domr"))
 (add-global-assumption
  "RealLeEq"
  (pf "all x,x2,x3.x<<=x2 -> x2===x3 -> x<<=x3"))
 (use "RealLeEq" (pt "f f domr-u"))
 (ord-field-simp-bwd)
 (use "RealLeTrans" (pt "RealConstr([n]b1)([k]Zero)"))
 (use "RealRat")
 (use "RealRat")
 (use "ContAppRat")
 (auto)

; f doml<=f domr
 (use "ContDom")
 (auto)
 (use "RatRealLe")
 (auto)

; f f domr-u===Shift f u f domr 
 (use "ShiftPropRev")
 (auto)

; ?_48: f doml<=f domr
 (use "ContDom")
 (auto)

; ?_10: all c,d,k(
;        (Shift f u)doml<=c -> 
;        d<=(Shift f u)domr -> 
;        1/2**k<=d-c -> RealLt(Shift f u c)(Shift f u d)(k+l))
(assume "c" "d" "k" "a<=c" "d<=b" "(1/2**k)<=d-c")
(add-global-assumption
 "InvAux3"
 (pf "all f,u,c,d,k.Cont f -> RealLt(f c)(f d)k -> 
                    RealLt(Shift f u c)(Shift f u d)k"))
(use "InvAux3")
(auto)

; all u(
;       a1<=u -> 
;       u<=b1 -> 
;       ex cds(
;        Equal(cds Zero)((Shift f u)doml@(Shift f u)domr) & 
;        all n Corr(Shift f u)(left(cds n))(right(cds n))(k0+n) & 
;        all n(
;         left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
;         right(cds(Succ n))-left(cds(Succ n))=
;         (2#3)*(right(cds n)-left(cds n))))) -> 
;      ex g(
;       Cont g & a1==g doml & b1==g domr & 
;       all y(a1<<=y -> y<<=b1 -> f(g y)===y) & 
;       all x(f doml<<=x -> x<<=f domr -> g(f x)===x))
(assume "IVTcdsHyp")
(add-var-name "pcds" (py "rat=>nat=>rat@@rat")) ;parametized cds
(assert
 (pf "all u ex cds.
       a1<=u -> 
       u<=b1 ->        
        Equal(cds Zero)((Shift f u)doml@(Shift f u)domr) & 
        all n Corr(Shift f u)(left(cds n))(right(cds n))(k0+n) & 
        all n.
         left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
         right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n))"))
 (assume "u")
; Here we could use cases on a1<=u etc, if we want to avoid IP.
; However, this would bring the case distinctions in the extracted
; term.  On the other hand, IP is completely harmless for decidable
; premises.

; (add-global-assumption
;  "IP" (pf "(Pvar -> ex alpha^ (Pvar alpha)alpha^) -> 
;            ex alpha^(Pvar -> (Pvar alpha)alpha^)"))
; Problem with alpha^ for cds.  Hence: alpha

(add-global-assumption
 "IP" (pf "(Pvar^ -> ex alpha (Pvar alpha)^alpha) -> 
            ex alpha.Pvar^ -> (Pvar alpha)^alpha"))

(use-with
 "IP" (py "nat=>rat@@rat")
 (make-cterm (pf "a1<=u"))
 (make-cterm (pv "cds")
	     (pf "u<=b1 -> 
     Equal(cds Zero)((Shift f u)doml@(Shift f u)domr) & 
     all n Corr(Shift f u)(left(cds n))(right(cds n))(k0+n) & 
     all n.
      left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
      right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n))"))
 "?")
(assume "a1<=u")
(use-with
 "IP" (py "nat=>rat@@rat")
 (make-cterm (pf "u<=b1"))
 (make-cterm (pv "cds")
	     (pf "
     Equal(cds Zero)((Shift f u)doml@(Shift f u)domr) & 
     all n Corr(Shift f u)(left(cds n))(right(cds n))(k0+n) & 
     all n.
      left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
      right(cds(Succ n))-left(cds(Succ n))=(2#3)*(right(cds n)-left(cds n))"))
 "?")
(assume "u<=b1")
(use "IVTcdsHyp")
(auto)

(drop "IVTcdsHyp")
(assume "IVTcdsHAC")
(assert
 (pf "ex pcds
      all u.
  a1<=u -> 
  u<=b1 -> 
   Equal(pcds u Zero)((Shift f u)doml@(Shift f u)domr) & 
   all n Corr(Shift f u)(left(pcds u n))(right(pcds u n))(k0+n) & 
   all n.
    left(pcds u n)<=left(pcds u(Succ n)) & right(pcds u(Succ n))<=right(pcds u n) & 
    right(pcds u(Succ n))-left(pcds u(Succ n))=
    (2#3)*(right(pcds u n)-left(pcds u n))"))
(add-global-assumption
 "AC"
 (pf "all alpha1 ex alpha2 (Pvar alpha1 alpha2)^alpha1 alpha2 -> 
      ex alpha1=>alpha2 
      all alpha1 (Pvar alpha1 alpha2)^alpha1(alpha1=>alpha2 alpha1)"))
(use-with
 "AC"
 (py "rat") (py "nat=>rat@@rat")
 (make-cterm
  (pv "u") (pv "cds")
  (pf "a1<=u -> 
               u<=b1 -> 
               Equal(cds Zero)((Shift f u)doml@(Shift f u)domr) & 
               all n Corr(Shift f u)(left(cds n))(right(cds n))(k0+n) & 
               all n.
                left(cds n)<=left(cds(Succ n)) & right(cds(Succ n))<=right(cds n) & 
                right(cds(Succ n))-left(cds(Succ n))=
                (2#3)*(right(cds n)-left(cds n))"))
 "?")
(use "IVTcdsHAC")

(drop "IVTcdsHAC")
(assume "Expcds")
(by-assume-with "Expcds" "pcds" "Hpcds")
(ex-intro
 (pt "ContConstr a1 b1 ([u,n]left(pcds u n))
                       ([k]IntToNat(2*(f uModCont(k+l+2))+k1+k1))([k]k+l+2)"))
; (ex-intro (pt "ContConstr a1 b1 ([u,n]left(pcds u n))
;                           ([k]2*(k1+f uModCont(k+l+2)))([k]k+l+2)"))
(split)
(split)
(split)
(split)

; Cont (ContConstr a1 b1([u,n]left(pcds u n))
;        ([k]IntToNat(2*f uModCont(k+l+2)+k1+k1))
;        ([k]k+l+2))

; Now we must verify that the construction of g indeed gives a
; continuos function, following the informal proof.  However, all this
; will not affect the extracted term.  So for the moment we use (admit)

(admit)
(admit)
(admit)
(admit)
(admit)
; Proof finished.
(save "Inv")

(pp (nt (proof-to-extracted-term (theorem-name-to-proof "Inv"))))

#|
[f0,k1,k2,k3,a4,a5]
 ContConstr a4 a5
 ([a6,n7]
   left((cAC rat nat=>rat@@rat)
        ([a8]
          (cIP nat=>rat@@rat)
          ((cIP nat=>rat@@rat)
           (cIVTcds
            (ContConstr f0 doml f0 domr([a12,n13]f0 approx a12 n13-a8)
             f0 uMod 
             f0 uModCont)
            k1 
            k2)))
        a6 
        n7))
 ([k6]IntToNat(2*f0 uModCont(IntS(IntS(k6+k1)))+k3+k3))
 ([k6]IntS(IntS(k6+k1)))
|#

; For to use "Inv" for numerical computations we prove InvApprox.
; This needs RealApprox (in real.scm)

; "InvApprox"
(set-goal 
 (pf "all f,l,k0,k1,a1,b1(
 Cont f -> 
 f f doml<<=a1 -> 
 b1<<=f f domr -> 
 a1<b1 -> 
 1/2**k0<=f domr-f doml -> 
 f domr-f doml<=2**k1 -> 
 all c,d,k(f doml<=c -> d<=f domr -> 1/2**k<=d-c -> RealLt(f c)(f d)(k+l)) -> 
 exnc g(
  Cont g & a1==g doml & b1==g domr & all y(a1<<=y -> y<<=b1 -> f(g y)===y) & 
  all x(f doml<<=x -> x<<=f domr -> g(f x)===x) & 
  all u(a1<=u -> u<=b1 -> all k ex c abs(c-g u)<<=1/2**k)))"))
(assume "f" "l" "k0" "k1" "a1" "b1" "Cont f" "f a<=a1" "b1<=f b" "a1<b1"
	"a <_k0 b" "b-a<=2**k1" "HypSlope")
(cut (pf "ex g.Cont g & a1==g doml & b1==g domr &
             (all y.a1<<=y -> y<<=b1 -> f(g y)===y) &
             (all x.f doml<<=x -> x<<=f domr -> g(f x)===x)"))
(assume "ExHyp")
(by-assume-with "ExHyp" "g" "gProp")

; exnc g. ...
(exnc-intro (pt "g"))
(split)
(use "gProp")

; all u(a1<=u -> u<=b1 -> all k ex c abs(c-g u)<<=1/2**k)
(assume "u" "a1<=u" "u<=b1" "k")
(use "RealApprox")

; Real(g u)
(use "ContReal")
(use "gProp")
(use "RealRat")
(use "RatRealLe")
(use "RatEqLe" (pt "a1"))
(add-global-assumption
 "RatEqSymm" (pf "all a,b.a==b -> b==a"))
(use "RatEqSymm")
(use "gProp")
(use "a1<=u")
(use "RatRealLe")
(use "RatLeEq" (pt "b1"))
(use "u<=b1")
(use "gProp")

; ex g.
;       Cont g & a1==g doml & b1==g domr & 
;       all y.a1<<=y -> y<<=b1 -> f(g y)===y & 
;       all x.f doml<<=x -> x<<=f domr -> g(f x)===x
(use "Inv"  (pt "l") (pt "k0") (pt "k1"))
(auto)
; Proof finished.
(save "InvApprox")

(define InvApprox-eterm
  (proof-to-extracted-term (theorem-name-to-proof "InvApprox")))
(define InvApprox-neterm (nt InvApprox-eterm))
(pp InvApprox-neterm)

#|
[f0,k1,k2,k3,a4,a5,a6]
 cRealApprox
 (RealConstr((cInv f0 k1 k2 k3 a4 a5)approx a6)
  ([k8](cInv f0 k1 k2 k3 a4 a5)uMod(IntS(IntS k8))))
|#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Brainstorming: necessary and useful properties of Real, Cont, Corr,
; Cauchy, Mon, RealNNeg, RealPos, RealLt, RealLe <<=

; "RealPlus"
(set-goal (pf "all x,y.Real x -> Real y -> Real(x+y)"))

; 04-06-05

(add-var-name "xs" (py "nat=>real"))

(add-ids (list (list "RealCauchy"
		     (make-arity (py "nat=>real") (py "int=>nat"))))
	 '("allnc xs,M(all n Real(xs n) -->
                       all k,n,m(M k<=n -> M k<=m ->
                                 abs(xs n-xs m)<<=1/2**k) -->
                       RealCauchy xs M)" "RealCauchyIntro"))

; "RealCauchyElim1"
(set-goal (pf "all xs,M(RealCauchy xs M -> all n Real(xs n))"))
(assume "xs" "M")
(elim)
(search)
; Proof finished.
(save "RealCauchyElim1")

; "RealCauchyElim2"
(set-goal
 (pf "all xs,M(RealCauchy xs M -> 
               all k,n,m.M k<=n ->  M k<=m ->
                       abs(xs n-xs m)<<=1/2**k)"))
(assume "xs" "M")
(elim)
(search)
; Proof finished.
(save "RealCauchyElim2")

(add-ids
 (list (list "RealConv"
	     (make-arity (py "nat=>real") (py "real") (py "int=>nat"))))
 '("allnc xs,x,M(all n Real(xs n) --> Real x --> 
                 all k,n(M k<=n -> abs(xs n-x)<<=1/2**k) -->
                 RealConv xs x M)" "RealConvIntro"))

; "RealConvElim1"
(set-goal (pf "all xs,x,M(RealConv xs x M -> all n Real(xs n))"))
(assume "xs" "x" "M")
(elim)
(search)
; Proof finished.
(save "RealConvElim1")

; "RealConvElim2"
(set-goal (pf "all xs,x,M.RealConv xs x M -> Real x"))
(assume "xs" "x" "M")
(elim)
(search)
; Proof finished.
(save "RealConvElim2")

; "RealConvElim3"
(set-goal
 (pf "all xs,x,M.RealConv xs x M ->
                 all k,n.M k<=n -> abs(xs n-x)<<=1/2**k"))
(assume "xs" "x" "M")
(elim)
(search)
; Proof finished.
(save "RealConvElim3")

; "RealLeChar1"
(set-goal
 (pf "all as,M,bs,N.Cauchy as M -> Cauchy bs N ->
                    RealConstr as M<<=RealConstr bs N ->
                    all k ex n0 all n.n0<=n -> as n<=bs n+1/2**k")) 

; "RealLeChar2"
(set-goal
 (pf "all as,M,bs,N.Cauchy as M -> Cauchy bs N ->
                    (all k ex n0 all n.n0<=n -> as n<=bs n+1/2**k) ->
                    RealConstr as M<<=RealConstr bs N")) 

; "RatCauchyConvMod"
(set-goal
 (pf "all as,M,k,n.Cauchy as M -> M k<=n ->
                   abs(as n-RealConstr as M)<<=1/2**k"))

; "RealComplete"
(set-goal
 (pf "all xs,M.RealCauchy xs M -> 
               RealConv xs(RealConstr([n](xs n)seq((xs n)mod n))
                                     ([k]IntToNat(M(k+1)max(k+2))))
                        ([k]IntToNat(M(k+2)max(k+3)))"))

; "RealCauchyConvMod"
(set-goal
 (pf "all xs,M,k,n.RealCauchy xs M -> M k<=n ->
                   abs(xs n-RealConstr
                            ([n](xs n)seq((xs n)mod n))
                            ([k]IntToNat(M(k+1)max(k+2))))<<=1/2**k"))

; "ContLim"
(set-goal
 (pf "all f,xs,M,y.Cont f -> RealCauchy xs M ->
       all p ex n0 all n.n0<=n -> 
       abs(f(xs n)-f(RealConstr([n](xs n)seq((xs n)mod n))
                               ([k]IntToNat(M(k+1)max(k+2)))))<<=(1/2**p)"))

; "RealNNegLim"
(set-goal
 (pf "all xs,M.RealCauchy xs M -> all n 0<<=(xs n) ->
               0<<=(RealConstr ([n](xs n)seq((xs n)mod n))
                              ([k]IntToNat(M(k+1)max(k+2))))"))

