(in-package "RTL")

(include-book "harrison")

(local-defthm ne-1
  (implies (and (rationalp x)
                (not (zerop x)))
           (<= (/ (expt 2 (expo x)) (abs x)) 1))
  :rule-classes ()
  :hints (("Goal" :use (expo-lower-bound))))

(local-defthm ne-2
 (implies (and (rationalp x)
               (rationalp y)
               (rationalp z)
               (> x 0)
               (<= (abs y) z))
          (<= (abs (/ y x)) (/ z x)))
  :rule-classes ())

(local-defthm ne-3
    (implies (and (integerp n) 
		  (> n 0)
		  (rationalp x)
                  (not (zerop x)))
	     (<= (abs (/ (- x (near x n)) x))
		 (/ (expt 2 (- (expo x) n)) (abs x))))
  :rule-classes ()
  :hints (("Goal" :use (near-est
                        (:instance ne-2 (x (abs x)) (y (- x (near x n))) (z (expt 2 (- (expo x) n))))))))

(local-defthm ne-4
  (implies (and (integerp n)
                (rationalp r)
                (<= r 1))
           (<= (* (expt 2 n) r) (expt 2 n)))
  :rule-classes ())

(local-defthm ne-5
    (implies (and (integerp n) 
		  (> n 0)
		  (rationalp x)
                  (not (zerop x)))
	     (<= (/ (expt 2 (- (expo x) n)) (abs x))
                 (expt 2 (- n))))
  :rule-classes ()
  :hints (("Goal" :use (ne-1
                        (:instance ne-4 (n (- n)) (r (/ (expt 2 (expo x)) (abs x))))))))

(local-defthm ne-6
    (implies (and (integerp n) 
		  (> n 0)
		  (rationalp x)
                  (not (zerop x)))
	     (<= (abs (/ (- x (near x n)) x))
		 (expt 2 (- n))))
  :rule-classes ()
  :hints (("Goal" :use (ne-3 ne-5)
                  :in-theory (theory 'minimal-theory))))

(local-defthm ne-7
    (implies (and (integerp n) 
		  (> n 0)
		  (rationalp x)
                  (not (zerop x)))
	     (<= (abs (/ (- (near x n) x) x))
		 (expt 2 (- n))))
  :rule-classes ()
  :hints (("Goal" :use (ne-6))))

(local-defthm ne-8
    (implies (and (integerp n) 
		  (> n 0)
		  (rationalp x))
	     (<= (abs (/ (- (near x n) x) x))
		 (expt 2 (- n))))
  :rule-classes ()
  :hints (("Goal" :use (ne-7))))

(local-defund uu (b y) (- 1 (* b y)))

(local-defund v (u p) (/ (- (near u p) u) u))

(local-defthmd rr-1
  (implies (rationalp u)
           (equal (near u p)
                  (* u (1+ (v u p)))))
  :hints (("Goal" :in-theory (enable v))))

(local-defthm rr-2
  (implies (and (integerp p) 
		(> p 0)
                (rationalp u))
           (<= (abs (v u p)) (expt 2 (- p))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable v)
                  :use ((:instance ne-8 (n p) (x u))))))

(local-defthm rr-3
  (let* ((e1 (near (uu b y1) p))
         (y3p (+ y1 (* e1 y2))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (integerp p) 
                  (> p 0))
             (= (- 1 (* b y3p))
                (* (uu b y1)
                   (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1)))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable rr-1 uu))))

(local-defthm rr-4
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p) 
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (- (uu b y2) 1)) (1+ ep2)))
  :rule-classes ())

(local-defthm rr-5
  (implies (and (rationalp v)
                (rationalp u)
                (rationalp e)
                (<= (abs u) e))
           (<= (abs (* v u)) (* (abs v) e)))
  :rule-classes ())

(local-defthm rr-6
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (rationalp (v (uu b y1) p))
                (rationalp (- (uu b y2) 1))
                (rationalp (1+ ep2)) 
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (* (v (uu b y1) p) (- (uu b y2) 1)))
               (* (abs (v (uu b y1) p)) (1+ ep2))))
  :rule-classes ()
  :hints (("Goal" :use (rr-4
                        (:instance rr-5 (v (v (uu b y1) p)) (u (- (uu b y2) 1)) (e (1+ ep2)))))))

(local-defthm rr-7
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (* (v (uu b y1) p) (- (uu b y2) 1)))
               (* (abs (v (uu b y1) p)) (1+ ep2))))
  :rule-classes ()
  :hints (("Goal" :use (rr-6)
                  :in-theory (enable uu v))))

(local-defthm rr-8
  (implies (and (rationalp v)
                (rationalp x)
                (rationalp e)
                (>= e 0)
                (<= v x))
           (<= (* v e) (* x e)))
  :rule-classes ())

(local-defthm rr-9
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (rationalp (abs (v (uu b y1) p)))
                (rationalp (uu b y1))
                (rationalp (1+ ep2)) 
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (* (abs (v (uu b y1) p)) (1+ ep2))
               (* (expt 2 (- p)) (1+ ep2))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance rr-8 (v (abs (v (uu b y1) p))) (x (expt 2 (- p))) (e (1+ ep2)))
                        (:instance rr-2 (u (uu b y1)))))))

(local-defthm rr-10
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (* (abs (v (uu b y1) p)) (1+ ep2))
               (* (expt 2 (- p)) (1+ ep2))))
  :rule-classes ()
  :hints (("Goal" :use (rr-9)
                  :in-theory (enable uu v))))

(local-defthm rr-11
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (* (v (uu b y1) p) (- (uu b y2) 1)))
               (* (expt 2 (- p)) (1+ ep2))))
  :rule-classes ()
  :hints (("Goal" :use (rr-7 rr-10))))

(local-defthm rr-12
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1))))
               (+ ep2 (* (expt 2 (- p)) (1+ ep2)))))
  :rule-classes ()
  :hints (("Goal" :use (rr-11))))

(local-defthm rr-13
  (implies (and (rationalp x1)
                (rationalp x2)
                (rationalp y1)
                (rationalp y2)
                (<= (abs x1) y1)
                (<= (abs x2) y2))
           (and (<= (abs (* x1 x2)) (abs (* x1 y2)))
                (<= (abs (* x1 y2)) (* y1 y2))))
  :rule-classes ())

(local-defthm rr-14
  (implies (and (rationalp x1)
                (rationalp x2)
                (rationalp y1)
                (rationalp y2)
                (<= (abs x1) y1)
                (<= (abs x2) y2))
           (<= (abs (* x1 x2)) (* y1 y2)))
  :rule-classes ()
  :hints (("Goal" :use (rr-13))))

(local-defthm rr-15
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (rationalp (uu b y1))
                (rationalp (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1))))
                (rationalp (+ ep2 (* (expt 2 (- p)) (1+ ep2))))
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (* (uu b y1) (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1)))))
               (* ep1 (+ ep2 (* (expt 2 (- p)) (1+ ep2))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-12
                        (:instance rr-14 (x1 (uu b y1))
                                         (y1 ep1)
                                         (x2 (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1))))
                                         (y2 (+ ep2 (* (expt 2 (- p)) (1+ ep2)))))))))

(local-defthm rr-16
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (and (rationalp (uu b y1))
                (rationalp (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1))))
                (rationalp (+ ep2 (* (expt 2 (- p)) (1+ ep2))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-15)
                  :in-theory (enable uu v))))

(local-defthm rr-17
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (* (uu b y1) (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1)))))
               (* ep1 (+ ep2 (* (expt 2 (- p)) (1+ ep2))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-15 rr-16))))

(local-defund ep3p (ep1 ep2 p)
  (* ep1 (+ ep2 (* (expt 2 (- p)) (1+ ep2)))))

(local-defthm rr-18
  (implies (and (rationalp y1)
                (rationalp y2)
                (rationalp b)
                (rationalp ep1)
                (rationalp ep2)
                (integerp p)
                (> p 0)
                (<= (abs (uu b y1)) ep1)
                (<= (abs (uu b y2)) ep2))
           (<= (abs (* (uu b y1) (+ (uu b y2) (* (v (uu b y1) p) (- (uu b y2) 1)))))
               (ep3p ep1 ep2 p)))
  :rule-classes ()
  :hints (("Goal" :use (rr-17)
                  :in-theory (enable ep3p))))

(local-defthm rr-19
  (let* ((e1 (near (uu b y1) p))
         (y3p (+ y1 (* e1 y2))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (uu b y1)) ep1)
                  (<= (abs (uu b y2)) ep2))
             (<= (abs (- 1 (* b y3p)))
                 (ep3p ep1 ep2 p))))
  :rule-classes ()
  :hints (("Goal" :use (rr-3 rr-18))))

(local-defthm rr-19-a
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (- 1 (* b y3p)))
                 (ep3p ep1 ep2 p))))
  :rule-classes ()
  :hints (("Goal" :use (rr-19)
                  :in-theory (enable uu))))

(defthm recip-refine-1
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (ep3p (* ep1 (+ ep2 (* (expt 2 (- p)) (1+ ep2))))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (- 1 (* b y3p)))
                 ep3p)))
  :rule-classes ()
  :hints (("Goal" :use (rr-19-a)
                  :in-theory (enable ep3p))))

(local-defthm ne-9
  (implies (and (rationalp x)
                (rationalp y)
                (rationalp z)
                (>= z 0)
                (<= y x))
           (<= (* y z) (* x z)))
  :rule-classes ())

(local-defthm ne-10
  (implies (and (rationalp x)
                (integerp n)
                (rationalp (abs x))
                (not (= x 0))
                (rationalp (expt 2 (expo x)))
                (rationalp (expt 2 (- n)))
                (>= (expt 2 (- n)) 0)
                (> n 0))
           (<= (* (expt 2 (expo x)) (expt 2 (- n)))
               (* (abs x) (expt 2 (- n)))))
  :rule-classes ()
  :hints (("Goal" :use (expo-lower-bound
                        (:instance ne-9 (y (expt 2 (expo x))) (x (abs x)) (z (expt 2 (- n)))))
                  :in-theory (theory 'minimal-theory))))

(local-defthm ne-11
  (implies (and (rationalp x)
                (not (= x 0))
                (integerp n)
                (> n 0))
           (<= (expt 2 (- (expo x) n))
               (* (abs x) (expt 2 (- n)))))
  :rule-classes ()
  :hints (("Goal" :use (ne-10))))

(local-defthm ne-12
    (implies (and (integerp n) 
		  (> n 0)
                  (not (= x 0))
		  (rationalp x))
	     (<= (abs (- x (near x n)))
		 (* (abs x) (expt 2 (- n)))))
  :rule-classes ()
  :hints (("Goal" :use (near-est ne-11)
                  :in-theory (theory 'minimal-theory))))

(local-defthm near-est-2
    (implies (and (integerp n) 
		  (> n 0)
		  (rationalp x))
	     (<= (abs (- x (near x n)))
		 (* (abs x) (expt 2 (- n)))))
  :rule-classes ()
  :hints (("Goal" :use (ne-12))))

(local-defthm rr-20
  (implies (and (rationalp x)
                (rationalp y)
                (rationalp b))
           (<= (abs (+ x (* b y))) (+ (abs x) (abs (* b y)))))
  :rule-classes ())

(local-defthm rr-21
  (let ((y3 (near y3p p)))
    (implies (and (rationalp b)
                  (rationalp y3p)
                  (integerp p)
                  (> p 0))
             (<= (abs (- 1 (* b y3)))
                 (+ (abs (- 1 (* b y3p))) (abs (* b (- y3p y3)))))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance rr-20 (x (- 1 (* b y3p))) (y (- y3p (near y3p p))))))))

(local-defthm rr-22
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (* b y3p))
                 (1+ (ep3p ep1 ep2 p)))))
  :rule-classes ()
  :hints (("Goal" :use (rr-19-a))))

(local-defthm rr-23
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (* (abs (* b y3p)) (expt 2 (- p)))
                 (* (1+ (ep3p ep1 ep2 p)) (expt 2 (- p))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-22))))

(local-defthm rr-24
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0))
             (<= (abs (- y3p y3))
                 (* (abs y3p) (expt 2 (- p))))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance near-est-2 (x (+ y1 (* (near (- 1 (* b y1)) p) y2))) (n p))))))

(local-defthm rr-25-a
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0))
             (<= (* (abs b) (abs (- y3p y3)))
                 (* (* (abs b) (abs y3p)) (expt 2 (- p))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-24))))

(local-defthm rr-25-b
  (implies (and (rationalp b)
                (rationalp x))
           (= (* (abs b) (abs x))
              (abs (* b x))))
  :rule-classes ()) 


(local-defthm rr-25-c
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (rationalp (- (+ y1 (* e1 y2)) (near (+ y1 (* e1 y2)) p)))
                  (rationalp (+ y1 (* e1 y2)))
                  (integerp p)
                  (> p 0))
             (<= (abs (* b (- y3p y3)))
                 (* (abs (* b y3p)) (expt 2 (- p))))))
  :rule-classes ()
  :hints (("Goal" :in-theory (theory 'minimal-theory)
                  :use (rr-25-a
                        (:instance rr-25-b (x (- (+ y1 (* (near (- 1 (* b y1)) p) y2)) (near (+ y1 (* (near (- 1 (* b y1)) p) y2)) p))))
                        (:instance rr-25-b (x (+ y1 (* (near (- 1 (* b y1)) p) y2))))))))

(local-defthm rr-25
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0))
             (<= (abs (* b (- y3p y3)))
                 (* (abs (* b y3p)) (expt 2 (- p))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-25-c))))

(local-defthm rr-26
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (* b (- y3p y3)))
                 (* (1+ (ep3p ep1 ep2 p)) (expt 2 (- p))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-23 rr-25)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rr-27
  (implies (and (rationalp x)
                (rationalp y1)
                (rationalp y2)
                (rationalp z1)
                (rationalp z2)
                (<= x (+ y1 z1))
                (<= y1 y2)
                (<= z1 z2))
            (<= x (+ y2 z2)))
  :rule-classes ())

(local-defthm rr-28
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (rationalp y3p)
                  (rationalp (abs (- 1 (* b y3))))
                  (rationalp (ep3p ep1 ep2 p))
                  (rationalp (* (1+ (ep3p ep1 ep2 p)) (expt 2 (- p))))
                  (rationalp (abs (- 1 (* b y3p))))
                  (rationalp (abs (* b (- y3p y3))))
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (- 1 (* b y3)))
                 (+ (ep3p ep1 ep2 p) (* (1+ (ep3p ep1 ep2 p)) (expt 2 (- p)))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-26 rr-19-a
                        (:instance rr-21 (y3p (+ y1 (* (near (- 1 (* b y1)) p) y2))))
                        (:instance rr-27 (x (abs (- 1 (* b (near (+ y1 (* (near (- 1 (* b y1)) p) y2)) p)))))
                                         (y1 (abs (- 1 (* b (+ y1 (* (near (- 1 (* b y1)) p) y2))))))
                                         (z1 (abs (* b (- (+ y1 (* (near (- 1 (* b y1)) p) y2))
                                                          (near (+ y1 (* (near (- 1 (* b y1)) p) y2)) p)))))
                                         (y2 (ep3p ep1 ep2 p))
                                         (z2 (* (1+ (ep3p ep1 ep2 p)) (expt 2 (- p))))))
                  :in-theory (theory 'minimal-theory))))

(local-defthm rr-29
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p)))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (- 1 (* b y3)))
                 (+ (ep3p ep1 ep2 p) (* (1+ (ep3p ep1 ep2 p)) (expt 2 (- p)))))))
  :rule-classes ()
  :hints (("Goal" :use (rr-28)
                  :in-theory (enable ep3p))))

(defthm recip-refine-2
  (let* ((e1 (near (- 1 (* b y1)) p))
         (y3p (+ y1 (* e1 y2)))
         (y3 (near y3p p))
         (ep3p (* ep1 (+ ep2 (* (expt 2 (- p)) (1+ ep2)))))
         (ep3 (+ ep3p (* (expt 2 (- p)) (1+ ep3p)))))
    (implies (and (rationalp y1)
                  (rationalp y2)
                  (rationalp b)
                  (rationalp ep1)
                  (rationalp ep2)
                  (integerp p)
                  (> p 0)
                  (<= (abs (- 1 (* b y1))) ep1)
                  (<= (abs (- 1 (* b y2))) ep2))
             (<= (abs (- 1 (* b y3)))
                 ep3)))
  :rule-classes ()
  :hints (("Goal" :use (rr-28)
                  :in-theory (enable ep3p))))

;;---------------------------------------------------------------------

(local-defthm ia-1
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (* b (abs y)) (1+ ep)))
  :rule-classes ())

(local-defthm ia-2
  (implies (and (rationalp b)
                (rationalp x)
                (rationalp y)
                (> b 0)
                (<= x y))
           (<= (* b x) (* b y)))
  :rule-classes ())

(local-defthm ia-3
  (implies (and (rationalp b)
                (rationalp (* b x))
                (rationalp y)
                (rationalp (/ b))
                (> (/ b) 0)
                (> b 0)
                (<= (* b x) y))
           (<= (* (/ b) (* b x)) (* (/ b) y)))
  :rule-classes ()
  :hints (("Goal" :use ((:instance ia-2 (b (/ b)) (x (* b x))))
                  :in-theory (theory 'minimal-theory))))

(local-defthm ia-4
  (implies (and (rationalp b)
                (rationalp x)
                (rationalp y)
                (> b 0)
                (<= (* b x) y))
           (<= x (/ y b)))
  :rule-classes ()
  :hints (("Goal" :use (ia-3))))

(local-defthm ia-5
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (* b (abs y)) (1+ ep)))
  :rule-classes ())

(local-defthm ia-6
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (abs y) (/ (1+ ep) b)))
  :rule-classes ()
  :hints (("Goal" :use ((:instance ia-4 (x (abs y)) (y (1+ ep)))))))

(local-defthm ia-7
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (* (expt 2 (- p)) (abs (* a y))) (* (expt 2 (- p)) a (/ (1+ ep) b))))
  :rule-classes ()
  :hints (("Goal" :use (ia-6))))

(local-defthm ia-8
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (abs (- (* a y) (near (* a y) p)))
               (* (expt 2 (- p)) (abs (* a y))))) 
  :rule-classes ()
  :hints (("Goal" :use ((:instance near-est-2 (x (* a y)) (n p))))))

(local-defthm ia-9
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (abs (- (* a y) (near (* a y) p)))
               (* (expt 2 (- p)) a (/ (1+ ep) b))))
  :rule-classes ()
  :hints (("Goal" :use (ia-7 ia-8)
                  :in-theory (theory 'minimal-theory))))

(local-defthm ia-10
  (implies (and (rationalp (- 1 (* b y)))
                (rationalp (- (near (* a y) p) (* a y)))
                (rationalp (/ b a)))
           (<= (abs (+ (- 1 (* b y)) (* (/ b a) (- (* a y) (near (* a y) p)))))
               (+ (abs (- 1 (* b y))) (abs (* (/ b a) (- (* a y) (near (* a y) p)))))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance rr-20 (x (- 1 (* b y))) (y (- (* a y) (near (* a y) p))) (b (/ b a)))))))

(local-defthm ia-11
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (not (zp p))
                (> a 0)
                (> b 0))
           (<= (abs (- 1 (* (/ b a) (near (* a y) p))))
               (+ (abs (- 1 (* b y))) (abs (* (/ b a) (- (* a y) (near (* a y) p)))))))
  :rule-classes ()
  :hints (("Goal" :use (ia-10)
                  :in-theory (disable abs))))

(local-defthm ia-12
 (implies (and (rationalp x)
               (rationalp y)
               (rationalp z)
               (>= x 0)
               (<= y z))
          (<= (* x y) (* x z)))
  :rule-classes ())

(local-defthm ia-13
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (rationalp (/ b a))
                (> (/ b a) 0)
                (rationalp (abs (- (* a y) (near (* a y) p))))
                (rationalp (* (expt 2 (- p)) a (/ (1+ ep) b)))
                (<= (abs (- 1 (* b y))) ep))
           (<= (* (/ b a) (abs (- (* a y) (near (* a y) p))))
               (* (/ b a) (* (expt 2 (- p)) a (/ (1+ ep) b)))))
  :rule-classes ()
  :hints (("Goal" :use (ia-9
                        (:instance ia-12 (x (/ b a)) (y (abs (- (* a y) (near (* a y) p)))) (z (* (expt 2 (- p)) a (/ (1+ ep) b))))))))

(local-defthm ia-14
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (* (/ b a) (abs (- (* a y) (near (* a y) p))))
               (* (expt 2 (- p)) (1+ ep))))
  :rule-classes ()
  :hints (("Goal" :use (ia-13))))

(local-defthm ia-15
  (implies (and (rationalp x)
                (rationalp y)
                (> x 0))
           (= (abs (* x y)) (* x (abs y))))
  :rule-classes ())

(local-defthm ia-16
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (not (zp p))
                (> a 0)
                (> b 0))
           (= (* (/ b a) (abs (- (* a y) (near (* a y) p))))
              (abs (* (/ b a) (- (* a y) (near (* a y) p))))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance ia-15 (x (/ b a)) (y (- (* a y) (near (* a y) p))))))))

(local-defthm ia-17
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (abs (- 1 (* (/ b a) (near (* a y) p))))
               (+ ep (abs (* (/ b a) (- (* a y) (near (* a y) p)))))))
  :rule-classes ()
  :hints (("Goal" :use (ia-11))))

(defthm abs-rat
  (implies (rationalp x)
           (rationalp (abs x)))
  :rule-classes (:type-prescription :rewrite))

(defthm initial-approximation
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp ep)
                (not (zp p))
                (> a 0)
                (> b 0)
                (<= (abs (- 1 (* b y))) ep))
           (<= (abs (- 1 (* (/ b a) (near (* a y) p))))
               (+ ep (* (expt 2 (- p)) (1+ ep)))))
  :rule-classes ()
  :hints (("Goal" :use (ia-14 ia-17 ia-16))))


;;-----------------------------------------------------------------------------------

(local-defund u0 (b y) (- 1 (* b y)))

(local-defund v0 (a b q0) (- 1 (* (/ b a) q0)))

(local-defthm u0-rat
  (implies (and (rationalp b)
                (rationalp y))
           (rationalp (u0 b y)))
  :rule-classes (:rewrite :type-prescription)
  :hints (("Goal" :in-theory (enable u0))))

(local-defthm v0-rat
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp q0))
           (rationalp (v0 a b q0)))
  :rule-classes (:rewrite :type-prescription)
  :hints (("Goal" :in-theory (enable v0))))

(local-defthm rq-1
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0)))
              (and (<= (abs u) ep)
                   (<= (abs v) de))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable u0 v0))))

(local-defthm rq-2
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (= qp (+ (* (/ a b) (- 1 (* u v))) (* (- r rp) y)))))
  :rule-classes ()
  :hints (("Goal" :in-theory (enable u0 v0))))

(local-defthm rq-3
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p)))
              (<= (abs (- r rp)) (* (expt 2 (- p)) (abs rp)))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance near-est-2 (x (* a (v0 a b q0))) (n p))))))

(local-defthm rq-4
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v)))
              (<= (abs rp) (* a de))))
  :rule-classes ()
  :hints (("Goal" :use (rq-1))))

(local-defthm rq-5
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v)))
              (<= (* (expt 2 (- p)) (abs rp)) (* (expt 2 (- p)) a de))))
  :rule-classes ()
  :hints (("Goal" :use (rq-4))))

(local-defthm rq-6
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p)))
              (<= (abs (- r rp)) (* (expt 2 (- p)) a de))))
  :rule-classes ()
  :hints (("Goal" :use (rq-3 rq-5)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-7
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p)))
              (<= (abs (* (- r rp) y)) (* (expt 2 (- p)) a de (abs y)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-6))))

(local-defthm rq-8
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
           (<= (* (expt 2 (- p)) a de (abs y))
               (* (expt 2 (- p)) a de (/ (1+ ep) b))))
  :rule-classes ()
  :hints (("Goal" :use (ia-6))))

(local-defthm rq-9
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p)))
              (<= (abs (* (- r rp) y)) (* (expt 2 (- p)) a de (/ (1+ ep) b)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-7 rq-8)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-10
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (rationalp (abs (u0 b y)))
                (rationalp (abs (v0 a b q0)))
                (= (* (abs (u0 b y)) de) (* de (abs (u0 b y))))
                (= (* ep de) (* de ep))
                (>= (abs (u0 b y)) 0)
                (>= de 0)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0)))
              (<= (* (abs u) (abs v)) (* ep de))))
  :rule-classes ()
  :hints (("Goal" :use (rq-1
                        (:instance ia-12 (x (abs (u0 b y))) (y (abs (v0 a b q0))) (z de))
                        (:instance ia-12 (y (abs (u0 b y))) (z ep) (x de)))
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-11
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0)))
              (<= (abs (* u v)) (* ep de))))
  :rule-classes ()
  :hints (("Goal" :use (rq-10))))

(local-defthm rq-12
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0)))
              (<= (abs (- 1 (* u v))) (1+ (* ep de)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-11))))

(local-defthm rq-13
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0)))
              (<= (abs (* (/ a b) (- 1 (* u v)))) (* (/ a b) (1+ (* ep de))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-12))))

(local-defthm rq-14
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0)))
              (<= (abs (* (/ a b) u v)) (* (/ a b) ep de))))
  :rule-classes ()
  :hints (("Goal" :use (rq-11))))

(local-defthm rq-15
   (implies (and (rationalp x) (rationalp y))
            (<= (abs (+ x y)) (+ (abs x) (abs y))))
  :rule-classes ())

(local-defthm rq-16
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (<= (abs qp)
                  (+ (* (/ a b) (1+ (* ep de)))
                     (* (expt 2 (- p)) a de (/ (1+ ep) b))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-2 rq-13 rq-9
                        (:instance rq-15 (x (* (/ a b) (- 1 (* (u0 b y) (v0 a b q0)))))
                                         (y (* (- (near (* a (v0 a b q0)) p) (* a (v0 a b q0))) y))))
                  :in-theory (disable abs))))

(local-defthm rq-17
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((u (u0 b y))
                   (v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (= (- qp (/ a b))
                 (- (* (- r rp) y) (* (/ a b) (* u v))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-2))))

(local-defthm rq-18
   (implies (and (rationalp x) (rationalp y))
            (<= (abs (- x y)) (+ (abs x) (abs y))))
  :rule-classes ())

(local-defthm rq-19
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (<= (abs (- qp (/ a b)))
                  (+ (* (/ a b) ep de)
                     (* (expt 2 (- p)) a de (/ (1+ ep) b))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-17 rq-14 rq-9
                        (:instance rq-18 (y (* (/ a b) (u0 b y) (v0 a b q0)))
                                         (x (* (- (near (* a (v0 a b q0)) p) (* a (v0 a b q0))) y))))
                  :in-theory (disable abs))))

(local-defthm rq-20
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p)))
              (<= (abs (- q qp)) (* (expt 2 (- p)) (abs qp)))))
  :rule-classes ()
  :hints (("Goal" :use (:instance near-est-2 (x (+ q0 (* (near (* a (v0 a b q0)) p) y))) (n p)))))

(local-defthm rq-21
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (<= (* (expt 2 (- p)) (abs qp))
                  (* (expt 2 (- p))
                     (+ (* (/ a b) (1+ (* ep de)))
                        (* (expt 2 (- p)) a de (/ (1+ ep) b)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-16))))

(local-defthm rq-22
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p)))
              (<= (abs (- q qp))
                  (* (expt 2 (- p))
                     (+ (* (/ a b) (1+ (* ep de)))
                        (* (expt 2 (- p)) a de (/ (1+ ep) b)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-21 rq-20)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-23
  (implies (and (rationalp x)
                (rationalp y)
                (rationalp a)
                (rationalp b)
                (<= (abs x) a)
                (<= (abs y) b))
           (<= (abs (+ x y)) (+ a b)))
  :rule-classes ())

(defthm refine-quotient-1
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((r (near (- a (* b q0)) p))
                   (q (near (+ q0 (* r y)) p)))
              (<= (abs (- q (/ a b)))
                  (* (/ a b)
                     (+ (expt 2 (- p))
                        (* (1+ (expt 2 (- p))) de ep)
                        (* (expt 2 (- p)) de (1+ ep))
                        (* (expt 2 (- (* 2 p))) de (1+ ep)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-19 rq-22
                        (:instance rq-23 (x (- (near (+ q0 (* (near (* a (v0 a b q0)) p) y)) p) (+ q0 (* (near (* a (v0 a b q0)) p) y))))
                                         (y (- (+ q0 (* (near (* a (v0 a b q0)) p) y)) (/ a b)))
                                         (a (* (expt 2 (- p)) (+ (* (/ a b) (1+ (* ep de))) (* (expt 2 (- p)) a de (/ (1+ ep) b)))))
                                         (b (+ (* (/ a b) ep de) (* (expt 2 (- p)) a de (/ (1+ ep) b))))))
                  :in-theory (e/d (v0) (abs)))))

(local-defthm rq-24
  (implies (and (rationalp a)
                (rationalp b)
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2))
            (let ((e (if (> a b) 0 -1)))
              (<= (abs (/ a b)) (expt 2 (1+ e)))))
  :rule-classes ()
  :hints (("Goal" :use (r-exactp-5 r-exactp-39
                        (:instance expo-upper-bound (x (/ a b)))))))

(local-defthm rq-25
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (<= (abs (- qp (/ a b)))
                  (* (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (/ a b)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-19))))

(local-defthm rq-26
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let ((e (if (> a b) 0 -1)))
              (<= (* (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (/ a b))
                  (* (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (1+ e))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-24
                        (:instance ia-12 (x (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))))
                                         (y (/ a b))
                                         (z (expt 2 (1+ (if (> a b) 0 -1)))))))))

(local-defthm rq-27
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (<= (abs (- qp (/ a b)))
                  (* (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (1+ e))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-25 rq-26)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-28
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let ((e (if (> a b) 0 -1)))
              (< (* (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (1+ e)))
                 (* (expt 2 (- (1+ p))) (expt 2 (1+ e))))))
  :rule-classes ())

(local-defthm rq-29
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (< (abs (- qp (/ a b)))
                 (* (expt 2 (- (1+ p))) (expt 2 (1+ e))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-27 rq-28)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-30
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (< (abs (- qp (/ a b)))
                 (expt 2 (- e p)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-29))))

(local-defthm rq-31
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p)))
              (<= (abs (- q qp)) (expt 2 (- (expo qp) p)))))
  :rule-classes ()
  :hints (("Goal" :use ((:instance near-est (x (+ q0 (* (near (* a (v0 a b q0)) p) y))) (n p))))))

(local-defthm rq-32
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p))
                   (e (if (> a b) 0 -1)))
              (< (abs (- q (/ a b)))
                 (+ (expt 2 (- (expo qp) p))
                    (expt 2 (- e p))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-30 rq-31))))

(local-defthm rq-33
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (<= (expt 2 (- (expo qp) p)) (expt 2 (- e p)))
                       (<= (+ (expt 2 (- (expo qp) p))
                              (expt 2 (- e p)))
                           (+ (expt 2 (- e p))
                              (expt 2 (- e p)))))))
  :rule-classes ()
  :hints (("Goal" :in-theory #!acl2(disable |(< (expt x n) (expt x m))| NORMALIZE-FACTORS-GATHER-EXPONENTS abs))))

(local-defthm rq-34
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p))
                   (e (if (> a b) 0 -1)))
              (implies (<= (expt 2 (- (expo qp) p)) (expt 2 (- e p)))
                       (< (abs (- q (/ a b)))
                          (+ (expt 2 (- e p))
                             (expt 2 (- e p)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-32 rq-33)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-35
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p))
                   (e (if (> a b) 0 -1)))
              (implies (<= (expt 2 (- (expo qp) p)) (expt 2 (- e p)))
                       (< (abs (- q (/ a b)))
                          (expt 2 (- (1+ e) p))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-34))))

(local-defthm rq-36
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p))
                   (e (if (> a b) 0 -1)))
              (implies (<= (expo qp) e)
                       (< (abs (- q (/ a b)))
                          (expt 2 (- (1+ e) p))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-35))))

(local-defthm rq-37
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((e (if (> a b) 0 -1)))
              (<= (expt 2 (- e p)) 1/2)))
  :rule-classes ()
  :hints (("Goal" :use (:instance expo<= (x (+ q0 (* (near (* a (v0 a b q0)) p) y))) (n (if (> a b) 0 -1))))))

(local-defthm rq-38
  (implies (and (rationalp x)
                (rationalp y)
                (> x 1/2)
                (<= (abs (- y x)) 1/2))
           (> y 0))
  :rule-classes ())

(local-defthm rq-39
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (rationalp (/ a b))
                (rationalp (+ q0 (* (near (* a (v0 a b q0)) p) y)))
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (> qp 0)))
  :rule-classes ()
  :hints (("Goal" :use (r-exactp-3 rq-37 rq-30
                        (:instance rq-38 (x (/ a b)) (y (+ q0 (* (near (* a (v0 a b q0)) p) y)))))
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-40
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y))))
              (> qp 0)))
  :rule-classes ()
  :hints (("Goal" :use (rq-39))))

(local-defthm rq-41
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (>= qp (expt 2 (1+ e))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-40
                        (:instance expo<= (x (+ q0 (* (near (* a (v0 a b q0)) p) y))) (n (if (> a b) 0 -1)))))))

(local-defthm rq-42
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (<= qp (+ (/ a b) (abs (- qp (/ a b))))))))
  :rule-classes ())

(local-defthm rq-43
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp x)
                (rationalp y)
                (<= a x)
                (<= b y))
           (<= (+ a b) (+ x y)))
  :rule-classes ())

(local-defthm rq-44
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (and (rationalp (abs (/ a b)))
                            (rationalp (abs (- qp (/ a b))))
                            (rationalp (expt 2 (1+ e)))
                            (rationalp (expt 2 (- e p))))
                       (<= (+ (abs (/ a b)) (abs (- qp (/ a b))))
                           (+ (expt 2 (1+ e)) (expt 2 (- e p)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-24 rq-30
                        (:instance rq-43 (a (abs (/ a b)))
                                         (b (abs (- (+ q0 (* (near (* a (v0 a b q0)) p) y)) (/ a b))))
                                         (x (expt 2 (1+ (if (> a b) 0 -1))))
                                         (y (expt 2 (- (if (> a b) 0 -1) p)))))
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-45
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (<= (+ (abs (/ a b)) (abs (- qp (/ a b))))
                  (+ (expt 2 (1+ e)) (expt 2 (- e p))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-44))))

(local-defthm rq-46
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (<= qp (+ (expt 2 (1+ e)) (expt 2 (- e p)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-45 rq-42))))

(local-defthm rq-47
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((e (if (> a b) 0 -1)))
              (< (expt 2 (- e p))
                 (expt 2 (- (1+ e) p)))))
  :rule-classes ())

(local-defthm rq-48
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((e (if (> a b) 0 -1)))
              (< (+ (expt 2 (1+ e)) (expt 2 (- e p)))
                 (+ (expt 2 (1+ e)) (expt 2 (- (1+ e) p))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-47)
                  :in-theory #!acl2(disable NORMALIZE-FACTORS-GATHER-EXPONENTS SIMPLIFY-PRODUCTS-GATHER-EXPONENTS-<
                                      EXPT-IS-INCREASING-FOR-BASE->-1 |(< (expt x n) (expt x m))|))))

(local-defthm rq-49
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (< qp (+ (expt 2 (1+ e)) (expt 2 (- (1+ e) p)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-46 rq-48))))

(local-defthm rq-50
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (= (near qp p) (expt 2 (1+ e))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-49 rq-41
                        (:instance exactp-2**n (n (if (> a b) 1 0)) (m p))
                        (:instance near-down (a (expt 2 (1+ (if (> a b) 0 -1))))
                                             (x (+ q0 (* (near (* a (v0 a b q0)) p) y)))
                                             (n p))))))

(local-defthm rq-51
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (<= (abs (- (near qp p) (/ a b)))
                           (abs (- qp (/ a b)))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-50 rq-41 rq-24))))

(local-defthm rq-52
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (e (if (> a b) 0 -1)))
              (implies (> (expo qp) e)
                       (< (abs (- (near qp p) (/ a b)))
                          (expt 2 (- (1+ e) p))))))
  :rule-classes ()
  :hints (("Goal" :use (rq-51 rq-30 rq-47)
                  :in-theory (theory 'minimal-theory))))

(local-defthm rq-53
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((v (v0 a b q0))
                   (rp (* a v))
                   (r (near rp p))
                   (qp (+ q0 (* r y)))
                   (q (near qp p))
                   (e (if (> a b) 0 -1)))
              (< (abs (- q (/ a b)))
                 (expt 2 (- (1+ e) p)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-52 rq-36)
                  :in-theory (theory 'minimal-theory))))

(defthm refine-quotient-2
  (implies (and (rationalp a)
                (rationalp b)
                (rationalp y)
                (rationalp q0)
                (rationalp ep)
                (rationalp de)
                (not (zp p))
                (<= 1 a)
                (< a 2)
                (<= 1 b)
                (< b 2)
                (<= (abs (- 1 (* b y))) ep)
                (<= (abs (- 1 (* (/ b a) q0))) de)
                (< (+ (* ep de) (* (expt 2 (- p)) de (1+ ep))) (expt 2 (- (1+ p)))))
            (let* ((r (near (- a (* b q0)) p))
                   (q (near (+ q0 (* r y)) p))
                   (e (if (> a b) 0 -1)))
              (< (abs (- q (/ a b)))
                 (expt 2 (- (1+ e) p)))))
  :rule-classes ()
  :hints (("Goal" :use (rq-53)
                  :in-theory (enable v0))))

