; gcd.tac
; 95-09-29

; renewed 06-02-27; diana ratiu
(set! COMMENT-FLAG #f)
(libload "nat.scm")
(set! COMMENT-FLAG #t)

(add-var-name "a" "b" "c" "r" (py "nat"))


;quot und rem sind quotient bzw. rest der Division zweier natuerlicher Zahlen
;lin(k1 k2) hat die Bedeutung |a1*k1-a2*k2|, für a1, a2 fixiert
;fun ist eine Funktion mit Bedeutung:
;    fun(a1 a2 k1 k2 q) = q*k1-1 falls k2*a2<k1*a1 und 0<q
;                         q*k1+1 sonst
;div prueft, ob zwei natuerliche Zahlen dividierbar sind


;(add-var-name "quot" "rem" (py "nat=>nat=>nat"))
;(add-var-name "lin" (py "nat=>nat=>nat"))
;(add-var-name "fun" (py "nat=>nat=>nat=>nat=>nat=>nat"))
;(add-var-name "div" (py "nat=>nat=>boole"))
(add-program-constant "quot"  (py "nat=>nat=>nat") t-deg-one)
(add-program-constant "rem" (py "nat=>nat=>nat") t-deg-one)
(add-program-constant "lin" (py "nat=>nat=>nat") t-deg-one)
(add-program-constant "fun" (py "nat=>nat=>nat=>nat=>nat=>nat") t-deg-one)
(add-program-constant "div" (py "nat=>nat=>boole") t-deg-one)

;Beweis gcd

(aga "DivAlg" (pf "all a,b,c,r.a=b*c+r -> (0<r -> bot) -> div c a"))
(aga "DivAlgCor" (pf "all a,c.0<c -> a=(quot a c)*c+(rem a c)"))
(aga "RemCor" (pf "all a,c.0<c -> (rem a c)<c"))
(aga "RemRewr1" (pf "all a1,a2,k1,k2,b,r.a1=b*(lin k1 k2)+r 
                                  -> (lin (fun a1 a2 k1 k2 b) (b*k2))=r"))
(aga "RemRewr2" (pf "all a1,a2,k1,k2,b,r.a2=b*(lin k1 k2)+r 
                                  -> (lin (b*k1) (fun a2 a1 k2 k1 b))=r"))
(aga "lemlin" (pf "all a2.0<a2 -> 0<(lin 0 1)"))
; Das sagt eigentlich, dass wenn a2 > 0, |a1*0 - a2*1| > 0

(set-goal
 (pf "all a1,a2.0<a2 -> (all k1,k2.div(lin k1 k2)a1 
                                       -> div(lin k1 k2)a2 
                                       -> 0<(lin k1 k2) -> bot)
                         -> bot"))
; Das ist, wenn eine Nummer aus a1, a2 positiv ist, es gibt
; ein gcd, d.h. eine positive Nummer die beide dividiert
;(assume "div" "lin" "a1" "a2" "u1")
(assume "a1" "a2" "u1")

(by-assume-minimal-wrt (pf "excl k1,k2. 0<(lin k1 k2)") "k1" "k2" (pt "lin") "MinH" "H")
(strip)
; "lemlin":
;  all lin. all a,b.0<b -> 0<(lin 0 a 1 b)
(use 2 (pt "0") (pt "1")) 
(use-with "lemlin" (pt "a2") "u1")

; die sind k1, k2 die wir suchen 
; - die kleinste, die die lineare Kombination bilden
(exc-intro (pt "k1") (pt "k2"))

; "DivAlg":
; "all div. all a,b,c,r.a=b*c+r -> (0<r -> bot) -> div c a
(use "DivAlg"  
     (pt "quot a1(lin k1 k2)")
     (pt "rem a1(lin k1 k2)"))
; Terme geliefert für b und r

; "DivAlgCor":
;  all quot, rem. all a,c.0<c -> a=(quot a c)*c+(rem a c)
(use-with "DivAlgCor" 
	  (pt "a1") (pt "lin k1 k2") 
	  "?")
(use "H")
(assume "u2")
(use "MinH"
    (pt "fun a1 a2 k1 k2(quot a1(lin k1 k2))")
    (pt "(quot a1(lin k1 k2))*k2"))

; Ziel:  (lin(fun a1 a2 k1 k2(quot a1(lin k1 a1 k2 a2)))
;         a1((quot a1(lin k1 a1 k2 a2))*k2)a2)<(lin k1 a1 k2 a2) 

; "RemRewr1": 
;  all lin, fun. all a1,a2,k1,k2,b,r.a1=b*(lin k1 a1 k2 a2)+r
(simp-with "RemRewr1" 
	   (pt "a1") (pt "a2") (pt "k1") (pt "k2")
	   (pt "quot a1(lin k1 k2)")
	   (pt "rem a1(lin k1 k2)")
	   "?") 
; "RemCor": 
;  all rem. all a,c.0<c -> (rem a c)<c
(use-with "RemCor" 
	  (pt "a1") (pt "lin k1 k2") "H")

(use-with "DivAlgCor"
    (pt "a1") (pt "lin k1 k2") "H")

(simp-with "RemRewr1"
          (pt "a1") (pt "a2") (pt "k1") (pt "k2")
	  (pt "quot a1(lin k1 k2)")
	  (pt "rem a1(lin k1 k2)")
	  "?")
(use "u2")
(use-with "DivAlgCor" 
	  (pt "a1") (pt "lin k1 k2") 
	  "H") 

(use "DivAlg" 
     (pt "quot a2(lin k1 k2)") 
     (pt "rem a2(lin k1 k2)"))
; b durch (pt "quot a2(lin k1 a1 k2 a2)")  ersetzt
; r durch (pt "rem a2(lin k1 a1 k2 a2) ersetzt

(use-with "DivAlgCor" 
	  (pt "a2") (pt "lin k1 k2") 
	  "H")

(assume "u2")
(use "MinH" 
     (pt "(quot a2(lin k1 k2))*k1")
     (pt "fun a2 a1 k2 k1(quot a2(lin k1 k2))"))

;Ziel: (lin((quot a2(lin k1 a1 k2 a2))*k1)
;       a1(fun a2 a1 k2 k1(quot a2(lin k1 a1 k2 a2)))a2)<(lin k1 a1 k2 a2)

; "RemRewr2":
;  all lin, fun. all a1,a2,k1,k2,b,r.a2=b*(lin k1 a1 k2 a2)+r 
(simp-with "RemRewr2" 
	   (pt "a1") (pt "a2") (pt "k1") (pt "k2")
	   (pt "quot a2(lin k1 k2)")
	   (pt "rem a2(lin k1 k2)")
	   "?")
(use-with "RemCor" 
	   (pt "a2") (pt "lin k1 k2") 
	  "H")

(use-with "DivAlgCor" 
	  (pt "a2") (pt "lin k1 k2") 
	  "H")

(simp-with "RemRewr2" 
	   (pt "a1") (pt "a2") (pt "k1") (pt "k2")
	   (pt "quot a2(lin k1 k2)")
	   (pt "rem a2(lin k1 k2)")
	   "?")
(use "u2")
(use-with "DivAlgCor"  
	  (pt "a2") (pt "lin k1 k2") 
	  "H")
(use "H") 

(save "gcd")

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

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

; A-Translation
(mload "../modules/atr.scm")

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

(define nterm (nt term))
(pp nterm)
; [div0,quot1,n2,n3]0@1
(pp term)

;[a1,a2]
;  ([a1,a2]
;    ([a1410,a1411,(nat=>nat=>nat@@nat)_1685](nat=>nat=>nat@@nat)_1685 0 1)a1 
;    a2
;    ([k1,k2]([k1,n1686]k1@n1686)k1(([k2]k2)k2)))
;  a1 
;  a2
