; $Id: sqrttwo.scm,v 1.7 2009-11-13 23:05:49 logik Exp $

; For Freek Wiedijk's "stamp collection" of formal proofs that sqrt(2)
; is irrational.  We prove that "all n,m(n*n=D(m*m) -> n=0)", using
; CVInd: "all n(all m(m<n -> Q m) -> Q n) -> all n Q n".

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

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

; (display-program-constants "NatPlus" "NatTimes" "NatLt" "NatLe")
; NatPlus
;   comprules
; 	nat+0	nat
; 	nat1+Succ nat2	Succ(nat1+nat2)
;   rewrules
; 	0+nat	nat
; 	Succ nat1+nat2	Succ(nat1+nat2)
; 	nat1+(nat2+nat3)	nat1+nat2+nat3

; NatTimes
;   comprules
; 	nat*0	0
; 	nat1*Succ nat2	nat1*nat2+nat1
;   rewrules
; 	0*nat	0
; 	Succ nat1*nat2	nat1*nat2+nat2
; 	nat1*(nat2+nat3)	nat1*nat2+nat1*nat3
; 	(nat1+nat2)*nat3	nat1*nat3+nat2*nat3
; 	nat1*(nat2*nat3)	nat1*nat2*nat3

; NatLt
;   comprules
; 	nat<0	False
; 	0<Succ nat	True
; 	Succ nat1<Succ nat2	nat1<nat2
;   rewrules
; 	nat<Succ nat	True
; 	nat<nat	False
; 	Succ nat<nat	False

; NatLe
;   comprules
; 	0<=nat	True
; 	Succ nat<=0	False
; 	Succ nat1<=Succ nat2	nat1<=nat2
;   rewrules
; 	nat<=nat	True
; 	nat1<=nat1+nat2	True
; 	Succ nat<=nat	False
; 	nat<=Succ nat	True

; "Even" and "Odd"
(add-program-constant "Even" (py "nat=>boole") t-deg-one)
(add-program-constant "Odd" (py "nat=>boole") t-deg-one)

(add-computation-rule (pt "Even 0") (pt "True"))
(add-computation-rule (pt "Odd 0") (pt "False"))
(add-computation-rule (pt "Even(Succ n)") (pt "Odd n"))
(add-computation-rule (pt "Odd(Succ n)") (pt "Even n"))

; "NatEvenOddPlusRev"
(set-goal (pf "all n,m((Even(n+m+m) -> Even n)&(Odd(n+m+m) -> Odd n))"))
(assume "n")
(ind)
(auto)
; Proof finished.
(save "NatEvenOddPlusRev")

; "NatEvenOddSquareRev"
(set-goal (pf "all n((Even(n*n) -> Even n)&(Odd(n*n) -> Odd n))"))
(ind)
(prop)
(assume "n" "IHn")
(split)

(ng)
(assume "Odd(n*n+n+n)")
(use "IHn")
(use "NatEvenOddPlusRev" (pt "n"))
(use "Odd(n*n+n+n)")

(ng)
(assume "Even(n*n+n+n)")
(use "IHn")
(use "NatEvenOddPlusRev" (pt "n"))
(use "Even(n*n+n+n)")
; Proof finished.
(save "NatEvenOddSquareRev")

; "Double"
(add-program-constant "D" (py "nat=>nat") t-deg-one)

(add-computation-rule (pt "D 0") (pt "0"))
(add-computation-rule (pt "D(Succ n)") (pt "Succ(Succ(D n))"))

; "Half"
(add-program-constant "H" (py "nat=>nat") t-deg-one)

(add-computation-rule (pt "H 0") (pt "0"))
(add-computation-rule (pt "H 1") (pt "0"))
(add-computation-rule (pt "H(Succ(Succ n))") (pt "Succ(H n)"))

; "NatEvenDouble"
(set-goal (pf "all n Even(D n)"))
(ind)
(auto)
; Proof finished.
(save "NatEvenDouble")

; "NatEvenOddDoubleHalf"
(set-goal (pf "all n((Even n -> D(H n)=n)&(Odd n -> D(H(Succ n))=Succ n))"))
(ind)
(auto)
; Proof finished.
(save "NatEvenOddDoubleHalf")

; "NatDouble"
(set-goal (pf "all n D n=n+n"))
(ind)
(auto)
; Proof finished.
(save "NatDouble")

; "NatDoublePlus"
(set-goal (pf "all n,m D(n+m)=D n+D m"))
(assume "n")
(ind)
(auto)
; Proof finished.
(save "NatDoublePlus")

; "NatDoubleTimes1"
(set-goal (pf "all n,m D(n*m)=D n*m"))
(assume "n")
(ind)
(use "Truth-Axiom")
(assume "m" "IHm")
(ng)
(simp "NatDoublePlus")
(simp "IHm")
(use "Truth-Axiom")
; Proof finished.
(save "NatDoubleTimes1")

; "NatDoubleTimes2"
(set-goal (pf "all n,m D(n*m)=n*D m"))
(assume "n")
(ind)
(use "Truth-Axiom")
(assume "m" "IHm")
(ng)
(simp "NatDoublePlus")
(simp "IHm")
(simp (pf "n*D m+n+n=n*D m+(n+n)"))
(simp "<-" "NatDouble")
(auto)
; Proof finished.
(save "NatDoubleTimes2")

; "NatDoubleInj"
(set-goal (pf "all n,m(D n=D m -> n=m)"))
(ind)
(cases)
(prop)
(assume "m")
(prop)
(assume "n" "IHn")
(cases)
(prop)
(assume "m")
(use "IHn")
; Proof finished.
(save "NatDoubleInj")

; "NatLeDouble"
(set-goal (pf "all n n<=D n"))
(ind)
(prop)
(assume "n" "IHn")
(ng)
(use "NatLeTrans" (pt "D n"))
(use "IHn")
(use "Truth-Axiom")
; Proof finished.
(save "NatLeDouble")

; "NatLtDouble"
(set-goal (pf "all n(0<n -> n<D n)"))
(ind)
(prop)
(assume "n" "IHn")
(assume "Trivial")
(ng)
(use "NatLeLtTrans" (pt "D n"))
(use "NatLeDouble")
(use "Truth-Axiom")
; Proof finished.
(save "NatLtDouble")

; "NatDoublePos"
(set-goal (pf "all n(0<D n -> 0<n)"))
(cases)
(auto)
; Proof finished.
(save "NatDoublePos")

(add-pvar-name "Q" (make-arity (py "nat")))

; "CVInd"
(set-goal (pf "all n(all m(m<n -> Q m) -> Q n) -> all n Q n"))
(assume "Prog")
(cut (pf "all n,m(m<n -> Q m)"))
(assume "QHyp" "n")
(use "QHyp" (pt "Succ n"))
(use "Truth-Axiom")

(ind)
(assume "m" "Absurd")
(use "Efq")
(use "Absurd")

(assume "n" "IHn")
(assume "m" "m<Succ n")
(use "NatLtSuccCases" (pt "n") (pt "m"))
(use "m<Succ n")
(use "IHn")
(assume "m=n")
(simp "m=n")
(use "Prog")
(use "IHn")
; Proof finished.
(save "CVInd")

; "LemmaOneAux"
(set-goal (pf "all n,m(n*n=D(m*m) -> m*m=D(H n*H n))"))
(assume "n" "m" "n*n=D(m*m)")
(simp "NatDoubleTimes1")
(use "NatDoubleInj")
(simp "<-" "n*n=D(m*m)")
(simp "NatDoubleTimes2")
(simp (pf "D(H n)=n"))
(use "Truth-Axiom")
(use "NatEvenOddDoubleHalf")
(use "NatEvenOddSquareRev")
(simp "n*n=D(m*m)")
(use "NatEvenDouble")
; Proof finished
(save "LemmaOneAux")

; "NatNotPosImpZero"
(set-goal (pf "all n((0<n -> F) -> n=0)"))
(ind)
(auto)
; Proof finished.
(save "NatNotPosImpZero")

; "NatZeroSquare"
(set-goal (pf "all n(n*n=0 -> n=0)"))
(ind)
(auto)
; Proof finished.
(save "NatZeroSquare")

; "NatSquarePos"
(set-goal (pf "all n(0<n -> 0<n*n)"))
(cases)
(auto)
; Proof finished.
(save "NatSquarePos")

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

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

; "NatLeMonPlus"
(set-goal (pf "all n1,n2,m1,m2(n1<=n2 -> m1<=m2 -> n1+m1<=n2+m2)"))
(assume "n1" "n2")
(ind)
(ind)
(prop)
(assume "m2" "IHm2")
(assume "n1<=n2" "Trivial")
(use "NatLeTrans" (pt "n2+m2"))
(use "IHm2")
(use "n1<=n2")
(use "Truth-Axiom")
(use "Truth-Axiom")
(assume "m1" "IHm1")
(cases)
(prop)
(use "IHm1")
; Proof finished.
(save "NatLeMonPlus")

; "NatLeSquare"
(set-goal (pf "all n,m(n<=m -> n*n<=m*m)"))
(ind)
(assume "m")
(prop)
(assume "n" "IHn")
(cases)
(prop)
(assume "m")
(ng)
(assume "n<=m")
(use "NatLeMonPlus")
(use "NatLeMonPlus")
(auto)
; Proof finished.
(save "NatLeSquare")

; "NatLtSquareRev"
(set-goal (pf "all m,n(m*m<n*n -> m<n)"))
(assume "m" "n" "m*m<n*n")
(use "NatNotLeImpLt")
(assume "n<=m")
(cut (pf "n*n<=m*m"))
(assume "n*n<=m*m")
(use-with "NatLtLeTrans" (pt "m*m") (pt "n*n") (pt "m*m")
	  "m*m<n*n" "n*n<=m*m")
(use "NatLeSquare")
(use "n<=m")
; Proof finished.
(save "NatLtSquareRev")

; "LemmaOne"
(set-goal (pf "all n,m(n*n=D(m*m) -> n=0)"))
(use-with "CVInd"
	  (make-cterm (pv "m") (pf "all n(m*m=D(n*n) -> m=0)")) "?")
(assume "n" "IHn" "m"  "n*n=D(m*m)")
(cases (pt "0<n"))
(assume "0<n")
(use "NatZeroSquare")
(simp "n*n=D(m*m)")
(cut (pf "m=0"))
(assume "m=0")
(simp "m=0")
(use "Truth-Axiom")
(use "IHn" (pt "H n"))
(use "NatLtSquareRev")
(simp "n*n=D(m*m)")
(use "LtDouble")
(use "NatDoublePos")
(simp "<-" "n*n=D(m*m)")
(use "NatSquarePos")
(use "0<n")

(use "LemmaOneAux")
(use "n*n=D(m*m)")
(use "NatNotPosImpZero")
; Proof finished.
(save "LemmaOne")

