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

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

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

; Preparatory propositions
; "NatExPred"
(set-goal (pf "all n,m.n<m -> ex k.m=k+1"))
(assume "n")
(cases)

; Zero
(assume "Falsity")
(ex-intro (pt "0"))
(use "Falsity")

; Successor
(assume "m" "Truth")
(ex-intro (pt "m"))
(use "Truth-Axiom")

(save "NatExPred")

; "NatLtLeTrans"
(set-goal (pf "all n,m,k.n<m -> m<=k -> n<k"))
(ind)

; Base n
(ind)

; Base m
(strip)
(prop)

; Step m
(assume "m" "IHm")
(cases)

; k zero
(prop)

; k successor
(assume "k")
(prop)

; Step n
(assume "n" "IHn")
(cases)

; m zero
(strip)
(prop)

; m successor
(assume "m")
(cases)

; k zero
(prop)

; k successor
(assume "k")
(use "IHn")

(save "NatLtLeTrans")

; "NatLeLtTrans"
(set-goal (pf "all n,m,k.n<=m -> m<k -> n<k"))
(ind)

; Base n
(ind)

; Base m
(strip)
(prop)

; Step m
(assume "m" "IHm")
(cases)

; k zero
(prop)

; k successor
(assume "k")
(prop)

; Step n
(assume "n" "IHn")
(cases)

; m zero
(strip)
(prop)

; m successor
(assume "m")
(cases)

; k zero
(prop)

; k successor
(assume "k")
(use "IHn")
(save "NatLeLtTrans")

; "NatLtTrans"
(set-goal (pf "all n,m,k.n<m -> m<k -> n<k"))
(ind)

; Base n
(ind)

; Base m
(strip)
(prop)

; Step m
(assume "m" "IHm")
(cases)

; k zero
(prop)

; k successor
(assume "k")
(strip)
(use "Truth-Axiom")

; Step n
(assume "n" "IHn")
(cases)

; m zero
(strip)
(prop)

; m successor
(assume "m")
(cases)

; k zero
(prop)

; k successor
(assume "k")
(use "IHn")
(save "NatLtTrans")

; "NatLtImpLeSucc"
(set-goal (pf "all n,m.n<m -> Succ n<=m"))
(ind)

; Base
(cases)
(assume "Hyp")
(use "Hyp")
(strip)
(use "Truth-Axiom")

; Step
(assume "n" "IHn")
(cases)
(assume "Hyp")
(use "Hyp")
(assume "m" "n<m")
(use "IHn")
(use "n<m")
(save "NatLtImpLeSucc")

; "NatLeSuccImpLt"
(set-goal (pf "all n,m.Succ n<=m -> n<m"))
(ind)

; Base
(cases)
(assume "Hyp")
(use "Hyp")
(strip)
(use "Truth-Axiom")

; Step
(assume "n" "IHn")
(cases)
(assume "Hyp")
(use "Hyp")
(assume "m" "S n<=m")
(use "IHn")
(use "S n<=m")
(save "NatLeSuccImpLt")

; "NatLeImpLtSucc"
(set-goal (pf "all n,m.n<=m -> n<Succ m"))
(ind)

; Base
(strip)
(use "Truth-Axiom")

; Step
(assume "n" "IHn")
(cases)
(prop)
(assume "m")
(use "IHn")
(save "NatLeImpLtSucc")

; "NatLtSuccImpLe"
(set-goal (pf "all n,m.n<Succ m -> n<=m"))
(ind)

; Base
(strip)
(use "Truth-Axiom")

; Step
(assume "n" "IHn")
(cases)
(prop)
(assume "m")
(use "IHn")
(save "NatLtSuccImpLe")

; "NatLtImpLe"
(set-goal (pf "all n,m.n<m -> n<=m"))
(ind)
(cases)
(prop)
(assume "m")
(prop)
(assume "n" "IHn")
(cases)
(prop)
(use "IHn")
(save "NatLtImpLe")

; "NatNotLtImpLe"
(set-goal (pf "all n,m.(n<m -> F) -> m<=n"))
(ind)

; Base
(cases)
(strip)
(use "Truth-Axiom")
(assume "m")
(prop)

; Step
(assume "n" "IHn")
(cases)
(strip)
(use "Truth-Axiom")
(assume "m")
(use "IHn")
(save "NatNotLtImpLe")

; "NatNotLeImpLt"
(set-goal (pf "all n,m.(n<=m -> F) -> m<n"))
(ind)

; Base
(cases)
(prop)
(strip)
(prop)

; Step
(assume "n" "IHn")
(cases)
(strip)
(use "Truth-Axiom")
(assume "m")
(use "IHn")
(save "NatNotLeImpLt")

; "NatLeCases"
(set-goal (pf "all n,m.n<=m -> (n<m -> Pvar^) -> (n=m -> Pvar^) -> Pvar^"))
(ind)

; Base
(cases)
(prop)
(strip)
(prop)

; Step
(assume "n" "IHn")
(cases)
(prop)
(assume "m")
(use "IHn")
(save "NatLeCases")

; "NatMon"
(set-goal (pf "all f.all n f n<f(n+1) -> all n,m.n<m -> f n<f m"))
(assume "f" "StrictIncr")
(assume "n")
(ind)
(prop)
(assume "m" "IHm")
(assume "n<m+1")
(use "NatLeCases" (pt "n") (pt "m"))
(use "NatLtSuccImpLe")
(use "n<m+1")
(assume "n<m")
(use "NatLtTrans" (pt "f m"))
(use-with "IHm" "n<m")
(use "StrictIncr")

(assume "n=m")
(simp "n=m")
(use "StrictIncr")
(save "NatMon")

; "NatMonLe"
(set-goal (pf "all f.all n f n<f(n+1) -> all n,m.n<=m -> f n<=f m"))
(assume "f" "StrictIncr")
(assume "n" "m" "n<=m")
(use "NatLeCases" (pt "n") (pt "m"))
(use "n<=m")
(assume "n<m")
(use "NatLtImpLe")
(use "NatMon")
(use "StrictIncr")
(use "n<m")
(assume "n=m")
(simp "n=m")
(use "Truth-Axiom")
(save "NatMonLe")

; "NatLeLtImpEq"
(set-goal (pf "all n,m.n<=m -> m<n+1 -> n=m"))
(ind)
(cases)
(prop)
(strip)
(prop)
(assume "n" "IHn")
(cases)
(prop)
(assume "m")
(use "IHn")
(save "NatLeLtImpEq")

; We want to show "all f.all n f(f n)<f(n+1) -> all n.f n=n".
; Let Hyp: "all n f(f n)<f(n+1)"

; Lemma1: "all n,k.n<=k -> n<=f k"
; Proof.  Induction on n.  Step: From S n<=k we have k=k1+1, hence n<=k1.
; By IHn n<=f k1, and again by IHn n<=f(f k1), so by Hyp n<f(k1+1)=f k.

; Lemma1: "all n,k.n<=k -> n<=f k"
(set-goal (pf "all f.all n f(f n)<f(n+1) -> all n,k.n<=k -> n<=f k"))
(assume "f" "Hyp")
(ind)

; Base
(strip)
(use "Truth-Axiom")

; Step
(assume "n" "IHn" "k" "S n<=k")
(use "NatLtImpLeSucc")
(cut (pf "n<k"))
(assume "n<k")
(inst-with-to "NatExPred"  (pt "n") (pt "k") "n<k" "NatExPredI")
(by-assume-with "NatExPredI" "k1" "Hk1")
(simp "Hk1")
(use "NatLeLtTrans" (pt "f(f k1)"))
(use "IHn")
(use "IHn")
(cut (pf "Succ n<=k"))
(simp "Hk1")
(prop)
(use "S n<=k")
(use "Hyp")
(use "NatLeSuccImpLt")
(use "S n<=k")

(save "Lemma1")

; Lemma2: "all n n<=f n"
(set-goal (pf "all f.all n f(f n)<f(n+1) -> all n n<=f n"))
(assume "f" "Hyp" "n")
(use "Lemma1")
(use "Hyp")
(use "Truth-Axiom")
(save "Lemma2")

; Lemma3: "all n f n<f(n+1)"
(set-goal (pf "all f.all n f(f n)<f(n+1) -> all n f n<f(n+1)"))
(assume "f" "Hyp" "n")
(use "NatLeLtTrans" (pt "f(f n)"))
(use "Lemma2")
(use "Hyp")
(use "Hyp")
(save "Lemma3")

(display-program-constants "NatLess")
(add-rewrite-rule (pt "n<n") (pt "F"))

; Lemma4 "all n f n<n+1"
(set-goal (pf "all f.all n f(f n)<f(n+1) -> all n f n<n+1"))
(assume "f" "Hyp" "n")
(use "NatNotLeImpLt")
(assume "n+1<=f n")
(use-with "NatLeLtTrans" (pt "f(n+1)") (pt "f(f n)") (pt "f(n+1)") "?" "?")
(use "NatMonLe")
(use "Lemma3")
(use "Hyp")
(use "n+1<=f n")
(use "Hyp")
(save "Lemma4")

; Bundeswett "all n n=f n"
(set-goal (pf "all f.all n f(f n)<f(n+1) -> all n n=f n"))
(assume "f" "Hyp" "n")
(use "NatLeLtImpEq")
(use "Lemma2")
(use "Hyp")
(use "Lemma4")
(use "Hyp")
(save "Bundeswett")

; Now a classical proof.  Here we need a logical form of the negations used.

; "NatNotLogLeImpLt"
(set-goal (pf "all n,m.(n<=m -> bot) -> m<n"))
(ind)

; Base
(cases)
(strip)
(use "Efq-Log")
(prop)
(strip)
(use "Efq-Log")
(prop)

; Step
(assume "n" "IHn")
(cases)
(strip)
(use "Truth-Axiom")
(assume "m")
(use "IHn")
(save "NatNotLogLeImpLt")

; "NatNotLogLtImpLe"
(set-goal (pf "all n,m.(n<m -> bot) -> m<=n"))
(ind)

; Base
(cases)
(strip)
(use "Truth-Axiom")
(assume "m")
(strip)
(use "Efq-Log")
(prop)

; Step
(assume "n" "IHn")
(cases)
(strip)
(use "Truth-Axiom")
(assume "m")
(use "IHn")
(save "NatNotLogLtImpLe")

; ; "NatNotLogLeImpLt"
; (set-goal (pf "all n,m.(n<=m -> bot) -> m<n"))
; (ind)

; ; Base
; (cases)
; (strip)
; (use "Efq-Log")
; (prop)
; (strip)
; (use "Efq-Log")
; (prop)

; ; Step
; (assume "n" "IHn")
; (cases)
; (strip)
; (use "Truth-Axiom")
; (assume "m")
; (use "IHn")
; (save "NatNotLogLeImpLt")

;NatLogLessEqNotEq
(set-goal (pf "all n,m.n<=m -> (n=m -> bot) -> m<n+1 -> bot"))
(ind)

; ; Base
(cases)
(prop)
(assume "m")
(prop)

; ; Step
(assume "n")
(assume "H")
(cases)
(prop)
(assume "m")
(ng)
(use "H")
(save "NatLogLessEqNotEq")


; "BundeswettClass"
(set-goal (pf "all f,n.(n=f n -> bot) -> excl n f(n+1)<=f(f n)"))
(assume "f" "n0" "n0=f n0 -> bot" "HypNeg")
(use-with "HypNeg" (pt "n0") "?")
(use "NatMonLe")
(use "Lemma3")
(assume "n")
(use "NatNotLogLeImpLt")
(use "HypNeg")
(use "NatNotLogLtImpLe")
;(assert (pf "all n,m.n<=m -> (n=m -> bot) -> m<n+1 -> bot"))
(use "NatLogLessEqNotEq")
(use "Lemma2")
(assume "n")
(use "NatNotLogLeImpLt")
(use "HypNeg")
(use "n0=f n0 -> bot")
; (assume "n" "m" "n<=m" "n=m -> bot" "n<m+1")
; (use "n=m -> bot")
; (use "NatLeLtImpEq")
; (use "n<=m")
; (use "n<m+1")
(save "BundeswettClass")

(dp)
(dpe)
(dnpe)

(define excl-proof (current-proof))
(dnpe excl-proof)
(dpe (expand-thm excl-proof "Lemma3"))
(dnpe (expand-thm (expand-thm excl-proof "Lemma3") "Lemma2"))
(dnpe (expand-thm excl-proof "NatNotLogLeImpLt" "NatNotLogLtImpLe"))
; contains 3 inductions, from the 3 occurrences of Not-Lemmata
; Try to avoid Not-Lemmata, and also induction in these.
; Modify expand-thm: allow arbitrary many names of theorems to be expanded
; Notice that the order of expansions is important.

(define (expand-thm proof . thm-names)
  (do ((l thm-names (cdr l))
       (res proof 
	    (expand-theorems proof (lambda (name) (string=? name (car l))))))
      ((null? l) res)))
	


; Discarded:
(define expproof (expand-theorems (current-proof)))
(define nexpproof (np expproof))
(dpe nexpproof) ;contains 21 inductions: all lemmata unfolded!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Previous code ;;;;;;;;;;;;;;;;;;;;;;;;
(add-global-assumption "ExistsPred" (pf "all n,k.n<k -> ex k1.k=k1+1"))

(add-global-assumption "Trans" (pf "all n,n1,n2. n<n1+1 -> n1<n2 -> n<n2"))
(add-global-assumption "AntiSymm" (pf "all n,n1.n<n1+1 -> n1<n+1 -> n1=n")) 
(add-global-assumption "Comm" (pf "all k,l. k=l ->l=k"))

(add-global-assumption
 "Monoton"
 (pf "all f.all n f n<f(n+1) -> all k,l.f k<f l -> k<l"))

(set-goal (pf "all f.(all n f(f n)<f(n+1) -> all n.f n=n)"))
(assume "f" "u")

;Beweis von (1): all n,k.n<=k -> n<=f k
(cut (pf "all n,k.n<k+1 -> n<(f k)+1")) 
(get 4)
(ind)

; base
(assume "k" "u1")
(ng)
(use "Truth-Axiom")

; step
(assume "n" "IH" "k" "u3")
; Predecessor of k: k1
(inst-with-to "ExistsPred" (pt "n") (pt "k") "u3" "ExistsPredI")
(by-assume-with "ExistsPredI" "k1" "u4")
(simp "u4")
(ng)
(inst-with-to "u" (pt "k1") "uI")
(use "Trans" (pt "f (f k1)"))
(use "IH")
(use "IH")
(cut (pf "n<k"))
(simp "u4")
(prop)
(use "u3")
(use "u")
(assume "Hyp1")

; (2) all n.n<=f n 
(cut (pf "all n.n<f n+1"))
(get 28)
(assume "n")
(use "Hyp1")
(use "Truth-Axiom")
(assume "Hyp2")

; (3) all n.f n< f(n+1)
(cut (pf "all n.f n<f(n+1)"))
(get 33)
(assume "n")
(inst-with-to "Hyp2" (pt "f n") "Hyp2I")
(inst-with-to "u" (pt "n") "uI")
(use "Trans" (pt "f(f n)"))
(use "Hyp2I")
(use "uI")
(assume "Hyp3")

; (4) all n.f n<n+1
(cut (pf "all n.f n<n+1"))
(get 43)
(assume "n")
(inst-with-to "u" (pt "n") "uI")
(use "Monoton" (pt "f"))
(use "Hyp3")
(use "uI")
(assume "Hyp4")

; Proof of all n f(n)=n
(assume "n")
(inst-with-to "Hyp2" (pt "n") "Hyp2I")
(inst-with-to "Hyp4" (pt "n") "Hyp4I")
(use "AntiSymm")
(use "Hyp2I")
(use "Hyp4I")

; adapted up to this point

; Some part can be shortened using search, e.g., the proof of all n f(n)=n
; (search 1 '(antisymm 1)) 

; Notice, however, that search does not use equality reasoning and also
; no normalization

; Application of the minimum principle
; Adapted up to this point

(set-goal (pf "all f.(all n f(f n)<f(n+1)) -> all n.f n=n"))
