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

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


; variable names
(add-var-name "i" "j" "l" (py "nat"))

; f(i,n) = 
;    a binary function, which has an index as a first argument
(add-var-name "f" (py "nat=>nat=>nat"))


; The set is encoded as a ternary predicate,
; taking as arguments the binary function above,
; an index and the element which belongs to the set ...
(add-predconst-name "R" 
   (make-arity (py "nat=>nat=>nat") (py "nat") (py "nat")))

; ... and is defined inductively as follows:
; R(f,1,m) =
;    all n. m<n -> f(1,m)<=f(1,n)

; R(f,Succ k,m) =
;    R(f,k,m) & 
;    all n. R(f,k,m) -> m<n -> f(k,m)<=f(k,n)


; Base case
(aga "Rright0" 
 (pf "all f, m. 
        all n. m<n -> f 1 m <= f 1 n
        -> R f 1 m"))

(aga "Rleft0" 
 (pf "all f, m. 
        R f 1 m
        -> all n. m<n -> f 1 m <= f 1 n"))

; Step
(aga "Rright" 
 (pf "all f, m, k. 
       (R f k m & 
        all n.R f k n -> m<n -> 
               f (Succ k) m <= f (Succ k) n)
       -> R f (Succ k) m"))

(aga "Rleft" 
 (pf "all f, m, k. 
        R f (Succ k) m
        -> (R f k m &
           all n.R f k n -> m<n -> 
                  f (Succ k) m <= f (Succ k) n)"))


; alternatively
; define the predicate R inductively

; (add-ids
;  (list (list "R" (make-arity (py "nat=>nat") (py "nat") (py "nat"))))
;  '("all m. 
;       (all n. m < n -> f 1 m < f 1 n) ->
;       R f 1 m")
;  '("all k,m.
;       (R f k m ! 
;         all n.R f k n -> m<n -> 
;                f (Succ k) m <f (Succ k) n)
;        -> R f (Succ k) m")
; )


; Convention:
; Let R f 0 m = Q f, i.e. the initial unbounded set Q

; Remark:
; Since in the lemmas k starts from 1,
; we will formulate them here as being valid for Succ k


; First show the following additional lemma

(set-goal (pf "all m,n. (m < n -> bot) -> n <= m"))
(ind) (ind)
(assume "F") (prop)
(assume "n") (assume "IHi")  (strip) (use "Efq-Log") (use 2) (prop)
(assume "k" "IHk")
(ind) (strip) (prop)
(assume "n" "IHn") (strip) 
(use "IHk") (use 3)
(save "AuxLemma")



; Lemma 6.2.

; The Lemma has two parts: 
; the I-st refers to the fact that R is unbounded
; the II-nd relates to the functions increasing on R

(set-goal 
 (pf "all k. ((all n. excl l. n < l ! R f 0 l) ->
              all m. excl l. m < l ! R f (Succ k) l) &
             all n,m. 
               (R f (Succ k) m -> R f (Succ k) n -> m<n -> 
                all i. i <= k -> f (Succ i) m <= f (Succ i) n)"))

; For the part that R is unbounded, we start from the assumption
; that the initial set Q, upon which R is built, is unbounded

(assume "f")

(ind) ; on k


; Base case: k=0

(split) ; split the proof into I and II


; I. R is unbounded

; Lemma6.1 is embeded in the proof of Lemma 6.2

(assume "unboundedQ")
(assume "m")
(by-assume-minimal-wrt
 (pf "excl n. m < n ! R f 0 n") "l" 
 (pt "f 1") "min_H" "min_P1" "min_P2")
(use "unboundedQ" (pt "m")) 

(exc-intro (pt "l"))
(use "min_P1")
(use "Rright")
(split)
(use "min_P2")
(assume "n" "R0n" "H")
(use "AuxLemma")
(assume "negG")
(use "min_H" (pt "n"))
(use "negG")
(use "NatLtTrans" (pt "l"))
(use "min_P1")
(use "H")
(use "R0n")


; II On R f1 increase

(assume "n" "m")
(assume "R1m" "R1n")
(assume "Hnm")
(assume "i" "Hi")

; Make a case distinction on i
(use "NatLtSuccCases" (pt "0") (pt "i"))

; applicable due to the Hyp: i<=0
(use  "NatLeToLtSucc") 
(use "Hi")

; Case: i<0
(assume "Absurd") (strip) (use "Efq") (use "Absurd")

; Case: i=0
(assume "i0")
(simp-with "i0")
(use "Rleft0") 
(use "R1m") 
(use "Hnm") 



; Ind. step: k -> Succ k

(assume "k" "IHk")
(split) ; split again the proof into its two parts, I and II


; I. R is unbounded

(assume "unboundedQ")
(assume "i")

(by-assume-minimal-wrt
 (pf "excl j. 
       i<j !
      R f (Succ k) j")
 "j" (pt "f (Succ (Succ k))") "min_H2" "min_P2_1" "min_P2_2")

(use "IHk")
(use "unboundedQ")
(exc-intro (pt "j"))

(use "min_P2_1")
(use "Rright" (pt "k"))
(split)
(use "min_P2_2") 
(assume "l")
(assume "H1" "H2")
(use "AuxLemma")
(assume "negG")
(use "min_H2" (pt "l"))
(use "negG")
(use "NatLtTrans" (pt "j"))
(use "min_P2_1")
(use "H2")
(use "H1")


; II On R all functions increase

(assume "n" "m" "Rkn" "Rkm" "H")
(assume "i" "Hi")

; Make, as above, a case distinction on i
(use "NatLtSuccCases" (pt "Succ k") (pt "i"))

; based on the Hyp: i <= Succ k
(use  "NatLeToLtSucc") 
(use "Hi")

; Case i < Succ k
(assume "H1i") 
(use "IHk")
(use "Rleft" (pt "m") (pt "k"))
(use "Rkn") 
(use "Rleft" (pt "m") (pt "k"))
(use "Rkm") 
(use "H")
(use  "NatLtSuccToLe") 
(use "H1i")


; Case i = Succ k
(assume "H2i") 
(simp-with "H2i")
(use "Rleft") 
(use "Rkn") 
(use "Rleft")
(use "Rkm") 
(use "H")
(save "Lemma6.2")



; Corrollary 6.3 (Dickson's Lemma)


(set-goal 
  (pf "all k, f. 
           (all m. excl l. m < l ! R f 0 l) ->
           excl i0,i1.i0<i1 !
                      (all j. j <= k -> 
                         (f (Succ j) i0 <= f (Succ j) i1)) 
  "))


(assume "k" "f")

; Since from Lemma 6.2 I one can derive a weaker statement,
; i.e. that in an unbounded set there are at least 3 elems
; the first part follows from of the first part Lemma 6.2

(assume "unboundedQ")
(assume "negG")
(use "Lemma6.2" (pt "f") (pt "k") (pt "0"))
(use "unboundedQ")
(assume "i0" "Hi0" "Ri0")
(use "Lemma6.2" (pt "f") (pt "k") (pt "i0"))
(use "unboundedQ")
(assume "i1" "rel_i0i1" "Ri1")
;(use "Lemma6.2" (pt "f") (pt "k") (pt "i1"))
;(use "unboundedQ")
;(assume "i2" "rel_i1i2" "Ri2")
(use "negG" (pt "i0") (pt"i1")); (pt "i2"))
(use "rel_i0i1")
;(use "rel_i1i2")


; The second part is given by Lemma 6.2 II, respectively

(assume "j" "Hj")
;(split)

(use "Lemma6.2" (pt "k"))
(use "Ri0")
(use "Ri1")
(use "rel_i0i1")
(use "Hj")

; (use "Lemma6.2" (pt "k"))
; (use "Ri1")
; (use "Ri2")
; (use "rel_i1i2")
; (use "Hj")

(save "DicksonGen2")


;(set! UNFOLDING-FLAG #f)

(define dickson
  (np
   (expand-theorems
    (theorem-name-to-proof "DicksonGen2"))))

;(dpe dickson)


(define reduced-dickson 
  (np
   (reduce-efq-and-stab dickson)))

(mload "../modules/atr.scm")


(define term
  (atr-min-excl-proof-to-structured-extracted-term reduced-dickson))

(define nterm (nt term))
(pp nterm)

