; $Id: wftest.scm 2156 2008-01-25 13:25:12Z schimans $

; We prove the existence of a "least" element in a well-founded set.

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

(set! COMMENT-FLAG #f)
(libload "nat.scm")
(set! COMMENT-FLAG #t)
(set! DOT-NOTATION #f)

(add-var-name "f" (py "nat=>nat"))

; "WfTest"
(set-goal (pf "all f(all m(m<0 -> bot) -> excl k(f(k+1)<f k -> bot))"))
(assume "f" 1)
(by-assume-minimal-wrt (pf "excl k T") "k" (pt "f") "k-Min" "k-Hyp")

(exc-intro (pt "0"))
(use "Truth-Axiom")

(assume "H1")
(use "H1" (pt "k"))
(assume "H2")
(use "k-Min" (pt "k+1"))
(use "H2")
(use "Truth-Axiom")
; Proof finished
(save "WfTest")

(define nproof (np (theorem-name-to-proof "WfTest")))

; (proof-to-expr nproof)

; (lambda (f)
;   (lambda (u651)
;     (((|ExclElimTwoOne| f)
;        (lambda (u653)
;          (((|ExclIntroOneOne| 0) |Truth-Axiom|)
;            (lambda (n1309)
;              ((u653 n1309)
;                (lambda (n1283)
;                  ((((|GInd| f) n1283) u653) (< (f n1283) (f n1309)))))))))
;       (lambda (n1308)
;         (lambda (u661)
;           (lambda (u662)
;             (lambda (u663)
;               ((u663 n1308)
;                 (lambda (u664)
;                   (((u661 (+ n1308 1)) u664) |Truth-Axiom|))))))))))

; (cdp nproof)

(define nproof-without-exc (rm-exc nproof))

(define et (atr-min-excl-proof-to-structured-extracted-term
	    (np (reduce-efq-and-stab (expand-theorems nproof-without-exc)))))
(define net (nt et))

(pp net)
; [f0]
;  [if (f0 1<f0 0)
;    [if (f0 2<f0 1)
;     ((GRecGuard nat nat)f0 2([n1,f2][if (f0(Succ n1)<f0 n1) (f2(Succ n1)) n1]
;     (f0 2<f0 1))
;     1]
;    0]

; Was
; [f0]
;  [if (f0 1<f0 0)
;    ((Rec nat=>nat=>nat)(f0 0)([n1]0)
;    ([n1,f2,n3][if (f0(Succ n3)<f0 n3) (f2(Succ n3)) n3])
;    1)
;    0]

; Discussion: Rec defines a function h of type nat=>nat=>nat.  Let f :=
; f0.  After an initial check whether f 1<f 0, in the positive case a
; recursively defined binary function is applied to f 0 and 1.  This
; avoids applying h to 0 (and hence using dummy, where 0 =: dummy).
; More readable description of the algorithm:

; Point-of-increase f := [if (f 1<f 0) (h(f 0)1) 0] with

; h 0 := [m]dummy
; h(n+1) := [m] [if (f(m+1)<f m) (h n(m+1)) m]

; Notice that n is not used in the definition of h.  Reason: induction
; is used in the form of a minimum principle only.

(define arg (pt "[n][if (n=0) 2 n]"))
(pp (nt (make-term-in-app-form net arg)))
; 1

(define arg (pt "[n][if (n=0) 4 [if (n=1) 3 n]]"))
(pp (nt (make-term-in-app-form net arg)))
; 2
