Library Veltkamp

Require Export AllFloat.

Section Generic.
Variable b : Fbound.
Variable radix : Z.
Variable p : nat.

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix p.

Theorem FboundedMbound2Pos :
 (0 < p) ->
 forall z m : Z,
 (0 <= m)%Z ->
 (m <= Zpower_nat radix p)%Z ->
 (- dExp b <= z)%Z ->
 exists c : float, Fbounded b c /\ c = (m * powerRZ radix z)%R :>R /\ (z <= Fexp c)%Z.

Theorem FboundedMbound2 :
 (0 < p) ->
 forall z m : Z,
 (Zabs m <= Zpower_nat radix p)%Z ->
 (- dExp b <= z)%Z ->
 exists c : float, Fbounded b c /\ c = (m * powerRZ radix z)%R :>R /\ (z <= Fexp c)%Z.

Hypothesis precisionGreaterThanOne : 1 < p.

Variable z:R.
Variable f:float.
Variable e:Z.

Hypothesis Bf: Fbounded b f.
Hypothesis Cf: Fcanonic radix b f.
Hypothesis zGe: (powerRZ radix (e+p-1) <= z)%R.
Hypothesis zLe: (z <= powerRZ radix (e+p))%R.
Hypothesis fGe: (powerRZ radix (e+p-1) <= f)%R.
Hypothesis eGe: (- dExp b <= e)%Z.

Theorem ClosestSuccPred: (Fcanonic radix b f)
 -> (Rabs(z-f) <= Rabs(z-(FSucc b radix p f)))%R
 -> (Rabs(z-f) <= Rabs(z-(FPred b radix p f)))%R
 -> Closest b radix z f.

Theorem ImplyClosest: (Rabs(z-f) <= (powerRZ radix e)/2)%R
  -> Closest b radix z f.

Theorem ImplyClosestStrict: (Rabs(z-f) < (powerRZ radix e)/2)%R
  -> (forall g: float, Closest b radix z g -> (FtoRradix f=g)%R ).

Theorem ImplyClosestStrict2: (Rabs(z-f) < (powerRZ radix e)/2)%R
  -> (Closest b radix z f) /\ (forall g: float, Closest b radix z g -> (FtoRradix f=g)%R ).

End Generic.

Section Generic2.
Variable b : Fbound.
Variable radix : Z.
Variable p : nat.

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Hypothesis precisionGreaterThanOne : 1 < p.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix p.

Variable z m:R.
Variable f h:float.

Theorem ClosestImplyEven: (EvenClosest b radix p z f) ->
   (exists g: float, (z=g+(powerRZ radix (Fexp g))/2)%R /\ (Fcanonic radix b g) /\ (0 <= Fnum g)%Z)
       -> (FNeven b radix p f).

Theorem ClosestImplyEven_int: (Even radix)%Z
   -> (EvenClosest b radix p z f) -> (Fcanonic radix b f) -> (0 <= f)%R
   -> (z=(powerRZ radix (Fexp f))*(m+1/2))%R -> (exists n:Z, IZR n=m)
   -> (FNeven b radix p f).

End Generic2.
Section Velt.

Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.
Variables p x q hx: float.

Let b' := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
    (dExp b).

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Hypothesis pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 <= s)%nat.
Hypothesis SGe: (s <= t-2)%nat.
Hypothesis Fx: Fbounded b x.
Hypothesis pDef: (Closest b radix (x*((powerRZ radix s)+1))%R p).
Hypothesis qDef: (Closest b radix (x-p)%R q).
Hypothesis hxDef:(Closest b radix (q+p)%R hx).
Hypothesis xPos: (0 < x)%R.
Hypothesis Np: Fnormal radix b p.
Hypothesis Nq: Fnormal radix b q.
Hypothesis Nx: Fnormal radix b x.

Lemma p'GivesBound: Zpos (vNum b')=(Zpower_nat radix (minus t s)).

Lemma p'GivesBound2: (powerRZ radix (Zminus t s)=Zpos (vNum b'))%R.

Lemma pPos: (0 <= p)%R.

Lemma qNeg: (q <= 0)%R.

Lemma RleRRounded: forall (f : float) (z : R),
   Fnormal radix b f -> Closest b radix z f -> (Rabs z <= (Rabs f)*(1+(powerRZ radix (1-t))/2))%R.

Lemma hxExact: (FtoRradix hx=p+q)%R.

Lemma eqLeep: (Fexp q <= Fexp p)%Z.

Lemma epLe: (Fexp p <=s+1+Fexp x)%Z.

Theorem eqLe2: (radix=2)%Z -> (Fexp q <= s+ Fexp x)%Z.

Lemma eqLe: (Fexp q <= s+ Fexp x)%Z \/
  ((FtoRradix q= - powerRZ radix (t+s+Fexp x))%R /\(Rabs (x - hx) <= (powerRZ radix (s + Fexp x))/2)%R).

Lemma eqGe: (s+ Fexp x <= Fexp q)%Z.

Lemma eqEqual: (Fexp q=s+Fexp x)%Z \/
  ((FtoRradix q= - powerRZ radix (t+s+Fexp x))%R /\
     (Rabs (x - hx) <= (powerRZ radix (s + Fexp x))/2)%R).

Lemma Veltkamp_aux_aux: forall v:float, (FtoRradix v=hx) -> Fcanonic radix b' v ->
  (Rabs (x-v) <= (powerRZ radix (s+Fexp x)) /2)%R
  -> (powerRZ radix (t-1+Fexp x) <= v)%R.

Lemma Veltkamp_aux:
   (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
   (exists hx':float, (FtoRradix hx'=hx) /\ (Closest b' radix x hx')
    /\ (s+Fexp x <= Fexp hx')%Z).

Hypothesis pDefEven: (EvenClosest b radix t (x*((powerRZ radix s)+1))%R p).
Hypothesis qDefEven: (EvenClosest b radix t (x-p)%R q).
Hypothesis hxDefEven:(EvenClosest b radix t (q+p)%R hx).

Lemma VeltkampEven1: (Even radix)
   ->(exists hx':float, (FtoRradix hx'=hx)
    /\ (EvenClosest b' radix (t-s) x hx')).

Lemma VeltkampEven2: (Odd radix)
   -> (exists hx':float, (FtoRradix hx'=hx) /\ (EvenClosest b' radix (t-s) x hx')).

End Velt.
Section VeltN.

Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.

Let b' := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
    (dExp b).

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Hypothesis pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 <= s)%nat.
Hypothesis SGe: (s <= t-2)%nat.

Lemma Veltkamp_pos: forall x p q hx:float,
     Fnormal radix b x -> Fcanonic radix b p -> Fcanonic radix b q
  -> (0 < x)%R
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
     (exists hx':float, (FtoRradix hx'=hx) /\ (Closest b' radix x hx')
       /\ (s+Fexp x <= Fexp hx')%Z).

Lemma VeltkampN_aux: forall x p q hx:float,
      Fnormal radix b x -> Fcanonic radix b p -> Fcanonic radix b q
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
     (exists hx':float, (FtoRradix hx'=hx) /\ (Closest b' radix x hx')
       /\ (s+Fexp x <= Fexp hx')%Z).

Lemma VeltkampN: forall x p q hx:float,
      Fnormal radix b x
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
     (exists hx':float, (FtoRradix hx'=hx) /\ (Closest b' radix x hx')
       /\ (s+Fexp x <= Fexp hx')%Z).

Lemma VeltkampEven_pos: forall x p q hx:float,
      Fnormal radix b x -> Fcanonic radix b p -> Fcanonic radix b q
  -> (0 < x)%R
  -> (EvenClosest b radix t (x*((powerRZ radix s)+1))%R p)
  -> (EvenClosest b radix t (x-p)%R q)
  -> (EvenClosest b radix t (q+p)%R hx)
  -> (exists hx':float, (FtoRradix hx'=hx) /\ (EvenClosest b' radix (t-s) x hx')).

Lemma VeltkampEvenN_aux: forall x p q hx:float,
      Fnormal radix b x -> Fcanonic radix b p -> Fcanonic radix b q
  -> (EvenClosest b radix t (x*((powerRZ radix s)+1))%R p)
  -> (EvenClosest b radix t (x-p)%R q)
  -> (EvenClosest b radix t (q+p)%R hx)
  -> (exists hx':float, (FtoRradix hx'=hx) /\ (EvenClosest b' radix (t-s) x hx')).

Lemma VeltkampEvenN: forall x p q hx:float,
      Fnormal radix b x
  -> (EvenClosest b radix t (x*((powerRZ radix s)+1))%R p)
  -> (EvenClosest b radix t (x-p)%R q)
  -> (EvenClosest b radix t (q+p)%R hx)
  -> (exists hx':float, (FtoRradix hx'=hx) /\ (EvenClosest b' radix (t-s) x hx')).

End VeltN.
Section VeltS.

Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.

Let b' := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
    (dExp b).

Definition plusExp (b:Fbound):=
   Bound
     (vNum b)
     (Nplus (dExp b) (Npos (P_of_succ_nat (pred (pred t))))).

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Hypothesis pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 <= s)%nat.
Hypothesis SGe: (s <= t-2)%nat.

Lemma bimplybplusNorm: forall f:float,
   Fbounded b f -> (FtoRradix f <> 0)%R ->
    (exists g:float, (FtoRradix g=f)%R /\
      Fnormal radix (plusExp b) g).

Lemma Closestbplusb: forall b0:Fbound, forall z:R, forall f:float,
   (Closest (plusExp b0) radix z f) -> (Fbounded b0 f) -> (Closest b0 radix z f).

Lemma Closestbbplus: forall b0:Fbound, forall n:nat, forall fext f:float,
    Zpos (vNum b0)=(Zpower_nat radix n) -> (1 < n) ->
   (-dExp b0 <= Fexp fext)%Z ->
    (Closest b0 radix fext f) -> (Closest (plusExp b0) radix fext f).

Lemma EvenClosestbplusb: forall b0:Fbound, forall n:nat, forall fext f:float,
    Zpos (vNum b0)=(Zpower_nat radix n) -> (1 < n) ->
   (-dExp b0 <= Fexp fext)%Z ->
   (EvenClosest (plusExp b0) radix n fext f) -> (Fbounded b0 f)
      -> (EvenClosest b0 radix n fext f).

Lemma ClosestClosest: forall b0:Fbound, forall n:nat, forall z:R, forall f1 f2:float,
    Zpos (vNum b0)=(Zpower_nat radix n) -> (1 < n) ->
    (Closest b0 radix z f1) -> (Closest b0 radix z f2)
    -> Fnormal radix b0 f2 -> (Fexp f1 <= Fexp f2 -2)%Z
    -> False.

Lemma EvenClosestbbplus: forall b0:Fbound, forall n:nat, forall fext f:float,
    Zpos (vNum b0)=(Zpower_nat radix n) -> (1 < n) ->
   (-dExp b0 <= Fexp fext)%Z ->
    (EvenClosest b0 radix n fext f) -> (EvenClosest (plusExp b0) radix n fext f).

Lemma VeltkampS: forall x p q hx:float,
     Fsubnormal radix b x
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
     (exists hx':float, (FtoRradix hx'=hx) /\ (Closest b' radix x hx')).

Lemma VeltkampEvenS: forall x p q hx:float,
      Fsubnormal radix b x
  -> (EvenClosest b radix t (x*((powerRZ radix s)+1))%R p)
  -> (EvenClosest b radix t (x-p)%R q)
  -> (EvenClosest b radix t (q+p)%R hx)
  -> (exists hx':float, (FtoRradix hx'=hx) /\ (EvenClosest b' radix (t-s) x hx')).

End VeltS.
Section VeltUlt.

Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.

Let b' := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
    (dExp b).

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Hypothesis pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 <= s)%nat.
Hypothesis SGe: (s <= t-2)%nat.

Theorem Veltkamp: forall x p q hx:float,
     (Fbounded b x)
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
      (exists hx':float, (FtoRradix hx'=hx) /\ (Closest b' radix x hx')
         /\ ((Fnormal radix b x) -> (s+Fexp x <= Fexp hx')%Z)).

Theorem VeltkampEven: forall x p q hx:float,
     (Fbounded b x)
  -> (EvenClosest b radix t (x*((powerRZ radix s)+1))%R p)
  -> (EvenClosest b radix t (x-p)%R q)
  -> (EvenClosest b radix t (q+p)%R hx)
  -> (exists hx':float, (FtoRradix hx'=hx) /\ (EvenClosest b' radix (t-s) x hx')).

End VeltUlt.
Section VeltTail.

Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.

Let b' := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
    (dExp b).

Let bt := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix s))))
    (dExp b).

Let bt2 := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus s 1)))))
    (dExp b).

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Hypothesis pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 <= s)%nat.
Hypothesis SGe: (s <= t-2)%nat.

Theorem Veltkamp_tail_aux: forall x p q hx tx:float,
     (Fcanonic radix b x)
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Closest b radix (x-hx)%R tx)
  -> (exists v:float, (FtoRradix v=hx) /\
     (Fexp (Fminus radix x v) = Fexp x) /\
      (Zabs (Fnum (Fminus radix x v)) <= (powerRZ radix s)/2)%R).

Theorem Veltkamp_tail: forall x p q hx tx:float,
     (Fbounded b x)
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Closest b radix (x-hx)%R tx)
  -> (exists tx':float, (FtoRradix tx'=tx) /\
         (hx+tx'=x)%R /\ (Fbounded bt tx') /\
         (Fexp (Fnormalize radix b t x) <= Fexp tx')%Z).

Theorem Veltkamp_tail2: forall x p q hx tx:float,
     (radix=2)%Z
  -> (Fbounded b x)
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Closest b radix (x-hx)%R tx)
  -> (exists tx':float, (FtoRradix tx'=tx) /\
         (hx+tx'=x)%R /\ (Fbounded bt2 tx') /\
         (Fexp (Fnormalize radix b t x) <= Fexp tx')%Z).

End VeltTail.

Section VeltUtile.
Variable radix : Z.
Variable b : Fbound.
Variables s t:nat.

Let b' := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix (minus t s)))))
    (dExp b).

Let bt := Bound
    (P_of_succ_nat (pred (Zabs_nat (Zpower_nat radix s))))
    (dExp b).

Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Hypothesis pGivesBound: Zpos (vNum b)=(Zpower_nat radix t).
Hypothesis SLe: (2 <= s)%nat.
Hypothesis SGe: (s <= t-2)%nat.

Theorem VeltkampU: forall x p q hx tx:float,
     (Fcanonic radix b x)
  -> (Closest b radix (x*((powerRZ radix s)+1))%R p)
  -> (Closest b radix (x-p)%R q)
  -> (Closest b radix (q+p)%R hx)
  -> (Closest b radix (x-hx)%R tx)
  -> (Rabs (x-hx) <= (powerRZ radix (s+Fexp x)) /2)%R /\
     (FtoRradix x=hx+tx)%R /\

     (exists hx':float, (FtoRradix hx'=hx)%R
                     /\ (Fbounded b' hx')
                     /\ ((Fnormal radix b x) -> (s+Fexp x <= Fexp hx')%Z)) /\

     (exists tx':float, (FtoRradix tx'=tx)%R
                     /\ (Fbounded bt tx')
                     /\ (Fexp x <= Fexp tx')%Z).

End VeltUtile.