Require Export AllFloat.

Section plouf.

Variable bound : Fbound.
Variable radix : Z.
Variable precision : nat.

Coercion Local FtoRradix := FtoR radix.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Hypothesis precisionMoreThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum bound) = Zpower_nat radix precision.

Lemma radixNotZero: (0 < radix)%Z.
auto with zarith.
Qed.

Lemma precisionNotZero : ~(precision = (0)).
auto with zarith.
Qed.

Lemma ClosestInfPredExp :
 forall f : float, forall x : R,
 Closest bound radix x f ->
 Fnum f = nNormMin radix precision ->
 (Fexp f <> -dExp bound)%Z ->
 (2%nat*f - powerRZ radix (Fexp f - 1) <= 2%nat*x)%R.
intros f x Hc Hm He.
assert ((Rabs (FtoR radix f - x) <= Rabs (FtoR radix (FPred bound radix precision f) - x))%R).
apply (proj2 Hc).
apply (FBoundedPred _ _ _ radixMoreThanOne precisionNotZero pGivesBound).
exact (proj1 Hc).
cut (f - x <= x - FPred bound radix precision f)%R.
intro H0.
cut (powerRZ radix (Fexp f - 1) = (f - FPred bound radix precision f))%R.
intro H1. rewrite H1. clear H1.
apply Rplus_le_reg_l with (-x - FPred bound radix precision f)%R.
simpl.
ring_simplify.
apply Rle_trans with (2:=H0); right; ring.
rewrite <- (Fminus_correct _ radixNotZero).
rewrite (FPredDiff3 _ _ _ radixMoreThanOne precisionNotZero pGivesBound _ Hm He).
unfold FtoR, Zpred; simpl; auto with real zarith.
apply Rle_trans with (Rabs (f - x))%R.
apply RRle_abs.
apply Rle_trans with (1 := H).
rewrite Rabs_left1.
auto with real.
case (Rle_or_lt (FPred bound radix precision f) x); intro H0.
apply Rplus_le_reg_l with x.
ring_simplify.
exact H0.
assert ((FPred bound radix precision f) < f)%R.
apply (FPredLt _ _ _ radixMoreThanOne precisionNotZero pGivesBound).
assert (x < f)%R.
apply Rlt_trans with (1 := H0) (2 := H1).
assert (Rabs (FtoR radix (FPred bound radix precision f) - x) < Rabs (FtoR radix f - x))%R.
repeat rewrite Rabs_right; try (apply Rle_ge; auto with real).
unfold Rminus. apply Rplus_lt_compat_r.
exact H1.
absurd (Rabs (f - x) < Rabs (f - x))%R.
auto with real.
apply Rle_lt_trans with (1 := H) (2 := H3).
Qed.

End plouf.



Section RndOdd.
Variable b : Fbound.
Variable radix : Z.
Variable precision : nat.
 
Coercion Local FtoRradix := FtoR radix.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
 
Definition To_Odd (r : R) (p : float) :=
  Fbounded b p /\ 
  ((r=p) \/
  (((isMin b radix r p) \/ (isMax b radix r p)) /\ (FNodd b radix precision p))).

Theorem To_OddTotal : TotalP To_Odd.
red in |- *; intros r.
case MinEx with (r := r) (3 := pGivesBound); auto with arith.
intros min H1.
case MaxEx with (r := r) (3 := pGivesBound); auto with arith.
intros max H2.
cut (min <= r)%R; [ intros Rl1 | apply isMin_inv1 with (1 := H1) ].
cut (r <= max)%R; [ intros Rl2 | apply isMax_inv1 with (1 := H2) ].
case H1;intros Fmin tmp; clear tmp.
case H2;intros Fmax tmp; clear tmp.
case (Req_dec min max); intros H3.
exists min; unfold To_Odd; split; [elim H1; auto|idtac].
left; cut (r <= min)%R; auto with real;rewrite H3; auto.
case (FNevenOrFNodd b radix precision min).
intros H4;exists max; unfold To_Odd; split; [elim H2; auto|idtac].
right; split;[right;auto|idtac].
apply FNoddEq with (f1 := FNSucc b radix precision min); auto.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic; auto with arith.
apply MaxEq with (b := b) (r := r); auto.
apply MinMax; auto with arith.
Contradict H3; auto.
apply (ProjectMax b radix);auto.
rewrite <- H3; auto.
apply FNevenSuc;auto.
intros H4;exists min; unfold To_Odd; split; auto.
Qed.

Theorem To_OddCompatible : CompatibleP b radix To_Odd.
red in |- *; simpl in |- *.
intros r1 r2 p q H H1 H2 H3.
unfold To_Odd; split;auto.
elim H; intros H4 H5.
case H5; intros H6.
left; rewrite <- H1; rewrite H6;auto with real.
elim H6; clear H5 H6; intros H5 H6.
case H5; clear H5; intros H5;right; split.
left; apply MinCompatible with (p := p) (r1 := r1);auto.
apply FNoddEq with p;auto.
right; apply MaxCompatible with (p := p) (r1 := r1);auto.
apply FNoddEq with p;auto.
Qed.

Theorem To_OddMinOrMax : MinOrMaxP b radix To_Odd.
red in |- *.
intros r p H; elim H; intros H1 H2; case H2; intros H3; clear H2.
right.
rewrite H3; auto with float zarith.
unfold FtoRradix; apply (RoundedModeProjectorIdem b radix (isMax b radix));auto.
apply MaxRoundedModeP with precision;auto.
elim H3;auto.
Qed.


Theorem To_OddMonotone : MonotoneP radix To_Odd.
red in |- *.
intros r1 r2 f1 f2 H1 H2 H3.
elim H2; intros B1 tmp;case tmp;intros H4; clear tmp.
elim H3; intros B2 tmp;case tmp;intros H5; clear tmp.
fold FtoRradix; rewrite <- H5; rewrite <- H4; auto with real.
elim H5; intros H6 H7; case H6; clear H5 H6 H7; intros H5.
elim H5; intros T1 T2; elim T2; intros T3 T4; clear T1 T2.
apply T4; auto; fold FtoRradix;rewrite <- H4; auto with real.
elim H5; intros T1 T2; elim T2; intros T3 T4; clear T1 T2.
apply Rle_trans with (2:=T3); fold FtoRradix;rewrite <- H4; auto with real.
elim H3; intros B2 tmp;case tmp;intros H5; clear tmp.
elim H4; intros H6 H7; case H6; clear H4 H6 H7; intros H4.
elim H4; intros T1 T2; elim T2; intros T3 T4; clear T1 T2.
apply Rle_trans with (1:=T3); fold FtoRradix;rewrite <- H5; auto with real.
elim H4; intros T1 T2; elim T2; intros T3 T4; clear T1 T2.
apply T4; auto; fold FtoRradix;rewrite <- H5; auto with real.
elim H4; clear H4; intros H6 H7; case H6; clear H6; intros H6.
elim H5; clear H5; intros H8 H9; case H8; clear H8; intros H8.
elim H8; intros T1 T2; elim T2; intros T3 T4; clear T1 T2.
apply T4; auto; apply Rle_trans with r1; auto with real.
elim H6; intros T1 T2; elim T2; intros T3' T4'; clear T1 T2;auto.
elim H6; intros T1 T2; elim T2; intros T3' T4'; clear T1 T2.
elim H8; intros T1 T2; elim T2; intros T3 T4; clear T1 T2.
apply Rle_trans with r1; auto with real.
apply Rle_trans with r2; auto with real.
elim H5; clear H5; intros H8 H9; case H8; clear H8; intros H8.
rewrite <- FNPredSuc with b radix precision f2;auto with arith.
apply FNPredProp; auto with arith.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic;auto with arith.
cut (FtoR radix f1 <= FtoR radix (FNSucc b radix precision f2))%R.
intros T; case T; auto; intros T1.
absurd (FNeven b radix precision f1).
apply FnOddNEven;auto.
apply FNevenEq with (FNSucc b radix precision f2);auto.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic;auto with arith.
apply FNoddSuc; auto.
case MaxEx with (r := r2) (3 := pGivesBound); auto with arith.
intros v H10.
apply Rle_trans with (FtoR radix v).
apply (MonotoneMax b radix) with (p := r1) (q := r2); auto.
elim H10; intros T1 T2; elim T2; intros T3 T4; clear T2.
apply T4; auto.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic;auto with arith.
clear T1 T3 T4;elim H8; intros T1 T2; elim T2; intros T3 T4; clear T2.
case (Rle_or_lt r2 (FtoR radix (FNSucc b radix precision f2)));auto; intros T.
absurd (FtoR radix (FNSucc b radix precision f2) <= FtoR radix f2)%R.
apply Rlt_not_le; apply FNSuccLt; auto with arith.
apply T4; auto with real.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic;auto with arith.
apply (MonotoneMax b radix) with (p := r1) (q := r2); auto.
Qed.

Theorem To_OddRoundedModeP : RoundedModeP b radix To_Odd.
split; try exact To_OddTotal.
split; try exact To_OddCompatible.
split; try exact To_OddMinOrMax.
exact To_OddMonotone.
Qed.

Theorem To_OddUniqueP : UniqueP radix To_Odd.
red in |- *; simpl in |- *.
intros r p q T1 T2.
elim T1; intros B1 tmp1;elim T2; intros B2 tmp2; clear tmp1 tmp2.
case (Req_dec p r); intros H.
apply RoundedProjector with (b:=b) (radix:=radix) (P:=To_Odd);auto.
apply To_OddRoundedModeP.
fold FtoRradix; rewrite H; auto.
case (Req_dec q r); intros H'.
apply sym_eq;apply RoundedProjector with (b:=b) (radix:=radix) (P:=To_Odd);auto.
apply To_OddRoundedModeP.
fold FtoRradix; rewrite H'; auto.
case T1; intros g1 g2; case g2;intros H1;clear g1 g2.
absurd ((FtoRradix p)=r)%R; auto with real.
case T2; intros g1 g2; case g2;intros H2;clear g1 g2.
absurd ((FtoRradix q)=r)%R; auto with real.
elim H1; clear H1; intros H3 H4; elim H2; clear H2; intros H1 H2. 
case H3; case H1 ; clear H1 H3; intros H1 H3.
apply (MinUniqueP b radix r); auto.
absurd (FNeven b radix precision q).
apply FnOddNEven;auto.
apply FNevenEq with (FNSucc b radix precision p);auto.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic;auto with arith.
apply (MaxUniqueP b radix r); auto.
apply MinMax; auto with zarith.
apply FNoddSuc; auto.
absurd (FNeven b radix precision p).
apply FnOddNEven;auto.
apply FNevenEq with (FNSucc b radix precision q);auto.
apply FcanonicBound with (radix := radix).
apply FNSuccCanonic;auto with arith.
apply (MaxUniqueP b radix r); auto.
apply MinMax; auto with zarith.
apply FNoddSuc; auto.
apply (MaxUniqueP b radix r); auto.
Qed.

Theorem To_OddSymmetricP : SymmetricP To_Odd.
unfold SymmetricP; intros.
elim H; intros H1 H2; case H2; intros H3; clear H2.
split; auto with float.
left; rewrite H3; unfold FtoRradix; rewrite Fopp_correct; auto with real zarith.
elim H3; intros H4 H5; case H4; intros H6; clear H3 H4.
split; auto with float.
split; auto with float.
Qed.




End RndOdd.

Section DblRndOddAux.
Variables b be :  Fbound.
Variables p k :  nat.

Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.

Hypotheses pGreaterThanOne :  (lt (S O) p).
Hypotheses kGreaterThanOne :  (lt (S O) k).
Hypotheses pGivesBound   :  (Zpos (vNum b)) = (Zpower_nat radix p).
Hypotheses pkGivesBounde :  (Zpos (vNum be)) = (Zpower_nat radix (plus p k)).


Theorem ClosestStrictPred: forall (f:float) (z:R), 
  (Fcanonic radix b f) -> (0 < f)%R -> 
    (-Fulp b radix p (FNPred b radix p f) < 2%nat *(z - f) < Fulp b radix p f)%R
 ->  Closest b radix z f /\
    (forall q : float, Closest b radix z q -> FtoR radix q = FtoR radix f).
intros f z0 H H'0 T; elim T; intros H1 H0; clear T.
assert (H2:Fbounded b f);[apply FcanonicBound with radix ;auto|idtac].
case (Req_dec z0 f); intros H'.
rewrite H'; split.
unfold FtoRradix; apply (RoundedModeProjectorIdem b radix (Closest b radix));auto.
apply ClosestRoundedModeP with p;auto with zarith.
intros g H3; apply sym_eq.
apply (RoundedProjector b radix (Closest b radix)); auto.
apply ClosestRoundedModeP with p;auto with zarith.
cut ((FNPred b radix p f) < z0)%R;[intros H3|idtac].
cut (z0 < (FNSucc b radix p f))%R;[intros H4|idtac].
cut (((Rabs (f - z0)) < (Rabs ((FNPred b radix p f) - z0)))%R /\
   ((Rabs (f - z0)) < (Rabs ((FNSucc b radix p f) - z0)))%R);[intros (H5,H6)|idtac].
cut (Closest b radix z0 f);[intros H7|idtac].
split;auto.
intros g H8.
generalize ClosestMinOrMax; unfold MinOrMaxP; intros T.
case (T b radix z0 f H7); case (T b radix z0 g H8); clear T; intros.
apply (MinUniqueP b radix z0);auto.
Contradict H6.
apply Rle_not_lt.
replace (FtoRradix  (FNSucc b radix p f)) with (FtoRradix g).
elim H8; intros; unfold FtoRradix;apply H11; auto.
apply (MaxUniqueP b radix z0); auto.
apply MinMax;auto with zarith.
Contradict H5.
apply Rle_not_lt.
replace (FtoRradix  (FNPred b radix p f)) with (FtoRradix g).
elim H8; intros; unfold FtoRradix;apply H11; auto.
apply (MinUniqueP b radix z0); auto.
apply MaxMin;auto with zarith.
apply (MaxUniqueP b radix z0); auto.
unfold Closest; split; auto.
intros g H7.
case (Rle_or_lt g f); intros H8.
case H8; clear H8; intros H8.
assert (g <= (FNPred b radix p f))%R.
unfold FtoRradix; apply FNPredProp; auto with zarith.
fold FtoRradix;apply Rlt_le; apply Rlt_le_trans with (1:=H5).
rewrite Rabs_left1; auto with real.
rewrite Rabs_left1; auto with real.
apply Rplus_le_reg_l with (-z0)%R.
apply Rle_trans with (-(FNPred b radix p f))%R;[right;ring|idtac].
apply Rle_trans with (-g)%R;[auto with real|right;ring].
apply Rle_trans with ((FNPred b radix p f)-z0)%R; auto with real.
unfold Rminus; auto with real.
fold FtoRradix; rewrite H8; auto with real.
assert ((FNSucc b radix p f) <= g)%R.
unfold FtoRradix; apply FNSuccProp; auto with zarith.
fold FtoRradix;apply Rlt_le; apply Rlt_le_trans with (1:=H6).
rewrite Rabs_right; auto with real.
rewrite Rabs_right; auto with real.
unfold Rminus; auto with real.
apply Rle_ge; auto with real.
apply Rle_trans with ((FNSucc b radix p f)-z0)%R; auto with real.
unfold Rminus; auto with real.
apply Rle_ge; auto with real.
rewrite (Rabs_left1 (FNPred b radix p f - z0)%R); auto with real.
rewrite (Rabs_right (FNSucc b radix p f - z0)%R); auto with real.
2: apply Rle_ge; auto with real.
rewrite Ropp_minus_distr.
case (Rle_or_lt 0%R (f-z0)%R); intros H5.
rewrite Rabs_right; auto with real.
split.
apply Rplus_lt_reg_r with (z0-2*f+(FNPred b radix p f))%R.
ring_simplify.
apply Rlt_le_trans with (S 1 * (z0 - f))%R;[idtac|right;simpl;ring].
apply Rle_lt_trans with (2:=H1).
unfold FtoRradix; rewrite <- FpredUlpPos with b radix p f; auto with zarith.
unfold FNPred;rewrite FcanonicFnormalizeEq; auto with zarith.
right;ring.
unfold Rminus;apply Rplus_lt_compat_r.
unfold FtoRradix; apply FNSuccLt; auto with zarith.
rewrite Rabs_left; auto with real.
rewrite Ropp_minus_distr.
split.
unfold Rminus;apply Rplus_lt_compat_l; apply Ropp_lt_contravar.
unfold FtoRradix; apply FNPredLt; auto with zarith.
apply Rplus_lt_reg_r with (z0-f)%R.
ring_simplify.
apply Rle_lt_trans with (S 1 * (z0 - f))%R;[right;simpl;ring|idtac].
apply Rlt_le_trans with (1:=H0).
unfold FtoRradix; rewrite <- FNSuccUlpPos with b radix p f; auto with zarith real.
unfold FtoRradix; rewrite Fminus_correct; auto with zarith; right;ring.
apply Rplus_lt_reg_r with (-f)%R.
apply Rle_lt_trans with (z0-f)%R;[right;ring|idtac].
apply Rmult_lt_reg_l with (2%nat)%R; auto with real.
apply Rlt_le_trans with (1:=H0).
apply Rle_trans with (2%nat * (Fulp b radix p f))%R; auto with zarith real.
simpl; unfold Fulp; auto with zarith real.
unfold FtoRradix; rewrite <- FNSuccUlpPos with b radix p f; auto with zarith real.
rewrite Fminus_correct; auto with zarith real; right;ring.
apply Rplus_lt_reg_r with (-f)%R.
apply Rlt_le_trans with (z0 - f)%R;[idtac|right;simpl;ring].
apply Rmult_lt_reg_l with (2%nat)%R; auto with real.
apply Rle_lt_trans with (2:=H1).
apply Rle_trans with (-(S 1 * (f - FNPred b radix p f)))%R;[right;ring|idtac].
apply Ropp_le_contravar.
apply Rle_trans with (2%nat * (Fulp b radix p (FNPred b radix p f)))%R; auto with zarith real.
simpl; unfold Fulp; auto with zarith real.
unfold FtoRradix; rewrite <- FpredUlpPos with b radix p f; auto with zarith real.
unfold FNPred;rewrite FcanonicFnormalizeEq; auto with zarith.
right;ring.
Qed.


Theorem ClosestStrictPos: forall (f:float) (z:R), 
  (Fcanonic radix b f) -> (0 < f)%R -> Fnum f <> nNormMin radix p
 -> (2%nat * Rabs (z - f) < Fulp b radix p f)%R
 ->  Closest b radix z f /\
    (forall q : float, Closest b radix z q -> FtoR radix q = FtoR radix f).
intros f z0 H H'0 H0 H1.
apply ClosestStrictPred; auto.
replace (Fulp b radix p (FNPred b radix p f)) with (Fulp b radix p f).
generalize (Rabs_def2 (S 1 * (z0 - f))%R (Fulp b radix p f)).
replace (Rabs (S 1 * (z0 - f)))%R with (S 1 * Rabs (z0 - f))%R.
intuition.
rewrite Rabs_mult; rewrite (Rabs_right 2%nat);auto with real.
repeat rewrite CanonicFulp; try apply FNPredCanonic; auto with zarith.
2: apply FcanonicBound with radix; auto.
replace (Fexp (FNPred b radix p f)) with (Fexp f); auto with real.
unfold FNPred; rewrite FcanonicFnormalizeEq; auto with zarith.
rewrite FPredSimpl4; auto.
cut (- pPred (vNum b) < Fnum f)%Z; auto with zarith.
apply Zlt_trans with (-0)%Z.
cut (0 < pPred (vNum b))%Z; auto with zarith.
apply pPredMoreThanOne with radix p; auto with zarith.
apply LtR0Fnum with radix; auto with zarith. 
Qed.

Theorem ClosestStrict: forall (f:float) (z0:R), 
  (Fcanonic radix b f) -> Zabs (Fnum f) <> nNormMin radix p
 -> (2%nat * Rabs (z0 - f) < Fulp b radix p f)%R
 ->  Closest b radix z0 f /\
    (forall q : float, Closest b radix z0 q -> FtoR radix q = FtoR radix f).
intros.
assert (H':(Fbounded b f));[apply FcanonicBound with radix;auto|idtac].
case (Rle_or_lt 0%R f); intros.
case H2; clear H2; intros H2.
apply ClosestStrictPos;auto.
rewrite <- (Zabs_eq (Fnum f)); auto.
apply LeR0Fnum with radix; auto with zarith real.
cut (forall (g:float), (Fbounded b g) -> (FtoRradix g)<>(FtoRradix f) ->
       (Rabs (f - z0) < Rabs (g - z0))%R).
intros T.
split; [unfold Closest|idtac].
split; [apply FcanonicBound with radix; auto|idtac].
intros; case (Req_dec f f0); intros.
fold FtoRradix; rewrite H4; auto with real.
apply Rlt_le; apply T;auto.
intros q H3.
case (Req_dec q f); intros H4; auto with real.
absurd (Rabs (f - z0) < Rabs (q - z0))%R.
apply Rle_not_lt;unfold Closest in H3.
elim H3; intros H5 H6;unfold FtoRradix; apply H6; auto.
apply T; auto.
elim H3; auto.
intros g H3 H4.
assert (f=(Float 0%Z (-(dExp b))%Z)).
apply FcanonicUnique with radix b p; auto with zarith.
right; split; auto with zarith.
split; auto with zarith.
fold FtoRradix; rewrite <- H2; unfold FtoRradix, FtoR; simpl; ring.
apply Rmult_lt_reg_l with (2%nat)%R; auto with real.
rewrite <- Rabs_Ropp.
replace (- (f - z0))%R with (z0-f)%R;[idtac|ring].
apply Rlt_le_trans with (1:=H1).
cut (2%nat * (Rabs z0) < (powerRZ radix (- (dExp b))%Z))%R;[intros H6|idtac].
rewrite CanonicFulp; auto with zarith.
rewrite H5; unfold FtoR; simpl.
apply Rle_trans with  (2%nat * (powerRZ 2 (- dExp b)) - (powerRZ 2 (- dExp b)))%R;[right;simpl;ring|idtac].
apply Rle_trans with (2%nat * (Rabs g) - 2%nat * (Rabs z0))%R.
unfold Rminus;apply Rplus_le_compat.
apply Rmult_le_compat_l; auto with real.
case (Rdichotomy f g); auto with real; rewrite <- H2; intros H7.
apply Rle_trans with (FSucc b radix p f).
rewrite H5; rewrite FSuccSimpl4; simpl; auto with zarith.
unfold FtoRradix, FtoR; simpl; right; ring.
cut (0 < pPred (vNum b))%Z; auto with zarith.
apply pPredMoreThanOne with radix p; auto with zarith.
cut (0 < nNormMin radix p)%Z; auto with zarith.
apply nNormPos; auto with zarith.
rewrite Rabs_right.
unfold FtoRradix;rewrite <- FnormalizeCorrect with radix b p g; auto with zarith.
unfold FtoRradix; apply FSuccProp; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
rewrite FnormalizeCorrect; auto with zarith real. 
fold FtoRradix; rewrite <- H2; auto with real.
apply Rle_ge; auto with real.
assert (g < 0)%R; auto with real.
rewrite Rabs_left; auto with real.
rewrite <-(Ropp_involutive (powerRZ 2 (- dExp b))%R).
apply Ropp_le_contravar.
apply Rle_trans with (FPred b radix p f).
unfold FtoRradix;rewrite <- FnormalizeCorrect with radix b p g; auto with zarith.
apply FPredProp; auto with zarith.
apply FnormalizeCanonic; auto with zarith.
rewrite FnormalizeCorrect; auto with zarith real. 
fold FtoRradix; rewrite <- H2; auto with real.
rewrite H5; rewrite FPredSimpl4; simpl; auto with zarith.
unfold FtoRradix, FtoR; simpl; right; ring.
cut (0 < pPred (vNum b))%Z; auto with zarith.
apply pPredMoreThanOne with radix p; auto with zarith.
cut (0 < nNormMin radix p)%Z; auto with zarith.
apply nNormPos; auto with zarith.
apply Ropp_le_contravar; auto with real.
apply Rle_trans with (2*((Rabs g)-(Rabs z0)))%R;[right;simpl;ring|idtac].
apply Rmult_le_compat_l; auto with real.
apply Rabs_triang_inv.
replace z0 with (z0-f)%R;[apply Rlt_le_trans with (1:=H1)|rewrite <- H2;ring].
rewrite CanonicFulp; auto with zarith;rewrite H5; unfold FtoRradix, FtoR; simpl; right;ring.
assert (Closest b radix (- z0) (Fopp f) /\
    (forall q : float,
     Closest b radix (- z0) q -> FtoR radix q = FtoR radix (Fopp f))).
apply ClosestStrictPos; auto with float zarith.
unfold FtoRradix; rewrite Fopp_correct; fold FtoRradix; auto with real.
unfold Fopp; simpl;rewrite <- (Zabs_eq (-(Fnum f))%Z).
rewrite Zabs_Zopp; auto.
cut (Fnum f <= 0)%Z;[idtac|apply R0LeFnum with radix]; auto with real zarith.
unfold FtoRradix; rewrite Fopp_correct; fold FtoRradix.
replace (- z0 - - f)%R with (-(z0 - f))%R;[rewrite Rabs_Ropp|ring].
apply Rlt_le_trans with (1:=H1);right.
unfold Fulp; rewrite Fnormalize_Fopp; auto with real.
elim H3; intros H4 H5; clear H3.
split.
replace z0 with (-(-z0))%R;[idtac|ring].
rewrite <- (Fopp_Fopp f).
apply ClosestOpp; auto.
intros;rewrite <- (Ropp_involutive (FtoR radix q)).
rewrite <- (Ropp_involutive (FtoR radix f)).
apply Ropp_eq_compat.
rewrite <- Fopp_correct;rewrite <- Fopp_correct.
apply H5.
apply ClosestOpp; auto.
Qed.

Theorem EvenNormalize:forall (f:float), (Fbounded be f) 
  -> (Even (Fnum f)) -> (FNeven be radix (p+k) f).
intros f H1 H2; unfold FNeven, Fnormalize.
case (Z_zerop (Fnum f)); intros H3.
unfold Feven; simpl; apply EvenO.
unfold Fshift, Feven; simpl.
apply EvenMult1; auto.
Qed.

Variables y z v: float.
Variables x : R.

Hypotheses By : (Fbounded be y).
Hypotheses Bz : (Fbounded b  z).
Hypotheses Bv : (Fbounded b  v).
Hypotheses Cv : (Fcanonic radix b v).

Hypotheses ydef : (To_Odd      be radix (plus p k) x y).
Hypotheses zdef : (EvenClosest b  radix p          y z).
Hypotheses vdef : (EvenClosest b  radix p          x v).

Hypotheses rangeext: (-(dExp be) <= (Zpred (Zpred (-(dExp b)))))%Z.

Hypotheses H:(Fnum v=(nNormMin radix p))%Z.
Hypotheses H':(x<>y)%R.
Hypotheses H1: (0 <= v)%R.


Theorem To_Odd_Even_is_Even_nNormMin: EvenClosest b radix p y v.
case H1; clear H1; intros H1.
elim (ClosestStrictPred v y); auto with zarith.
intros H2 H3; unfold EvenClosest.
split; auto.
split.
rewrite CanonicFulp; auto with zarith.
2: apply FNPredCanonic; auto with zarith.
unfold FNPred; rewrite FcanonicFnormalizeEq; auto with zarith.
generalize (Zle_lt_or_eq ((-(dExp b)))%Z (Fexp v)); intros H2.
case H2; auto with zarith float; clear H2; intros H2.
rewrite FPredSimpl2; auto with zarith;simpl.
apply Rle_lt_trans with (2*-(powerRZ radix (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl; unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real.
simpl; right;field.
apply Rmult_lt_compat_l; auto with real.
apply Rplus_lt_reg_r with v.
ring_simplify (v+(y-v))%R.
assert ((v + - powerRZ radix (Zpred (Zpred (Fexp v))))=
  (Float ((Zpower_nat radix (p+2))-2)%Z (Zpred (Zpred (Zpred (Fexp v))))))%R.
unfold FtoRradix, FtoR; simpl.
unfold Zminus; rewrite plus_IZR.
rewrite Zpower_nat_Z_powerRZ; rewrite H.
unfold nNormMin; simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith.
rewrite inj_plus.
unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real.
simpl; field.
assert (H'1:(Fbounded be (Float (Zpower_nat radix (p + 2) - 2) (Zpred (Zpred (Zpred (Fexp v))))))).
split; simpl.
rewrite Zabs_eq; auto with zarith.
rewrite pkGivesBounde.
apply Zlt_le_trans with (Zpower_nat radix (p + 2)); auto with zarith.
apply Zle_trans with (Zpower_nat radix (0 + 2) - 2)%Z; auto with zarith.
unfold Zminus; apply Zplus_le_compat_r; auto with zarith.
apply Zle_trans with (1:=rangeext); auto with zarith.
assert (v + - powerRZ radix (Zpred (Zpred (Fexp v))) <= y)%R.
case (Req_dec (v + - powerRZ radix (Zpred (Zpred (Fexp v))))%R  x); intros H'2.
Contradict H'.
rewrite <- H'2; rewrite H0.
generalize (To_OddUniqueP be radix (p+k)); unfold UniqueP.
intros T; unfold FtoRradix; apply T with x; auto with zarith; clear T.
rewrite <- H'2; rewrite H0;  unfold FtoRradix;apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
exact H'1.
rewrite H0.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
unfold FtoRradix; apply T with  (v +- powerRZ radix (Zpred (Zpred (Fexp v))))%R x; auto with zarith; clear T.
cut (v + - powerRZ radix (Zpred (Zpred (Fexp v))) <= x)%R.
intros T; case T; auto with real.
intros T'; Contradict T'; auto with real.
apply Rmult_le_reg_l with 2%nat; auto with real.
apply Rle_trans with (S 1 * v - powerRZ radix (Fexp v - 1))%R.
right; unfold Zpred, Zminus; repeat rewrite powerRZ_add; auto with zarith real; simpl.
field.
unfold FtoRradix;apply ClosestInfPredExp with b p; auto with zarith.
elim vdef; auto.
rewrite H0.
unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be);auto.
apply To_OddRoundedModeP; auto with zarith.
case H3; auto with real; clear H3; intros H3.
elim ydef; intros H4 H5.
case H5; intros H6.
fold FtoRradix in H6; Contradict H6; auto with real.
clear H5; elim H6; intros H7 H8; clear H6 H7.
absurd (FNeven be radix (p + k) y).
apply FnOddNEven; auto.
apply FNevenEq with (Float (Zpower_nat radix (p + 2) - 2)%Z (Zpred (Zpred (Zpred (Fexp v))))); auto with zarith.
fold FtoRradix; rewrite <- H3; auto with real.
apply EvenNormalize; auto.
simpl;unfold Zminus; apply EvenPlus1.
replace (p+2) with (S (S p)); [idtac|ring].
apply EvenExp; unfold Even.
exists 1%Z; auto with zarith.
unfold Even; exists (-1)%Z; auto with zarith.
replace (FPred b radix p v) with (FPred b radix p (Float (nNormMin radix p) (- dExp b)%Z)).
2: unfold FPred; rewrite H; rewrite <- H2; auto with zarith.
rewrite FPredSimpl3; auto with zarith;simpl.
apply Rle_lt_trans with (2*-(powerRZ radix (Zpred (Fexp v))))%R.
unfold FtoRradix, FtoR; simpl; unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real.
rewrite H2; simpl; right;field.
apply Rmult_lt_compat_l; auto with real.
apply Rplus_lt_reg_r with v.
ring_simplify (v+(y-v))%R.
assert ((v + - powerRZ radix (Zpred (Fexp v)))=
  (Float ((Zpower_nat radix (p+1))-2)%Z (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl.
unfold Zminus; rewrite plus_IZR.
rewrite Zpower_nat_Z_powerRZ; rewrite H.
unfold nNormMin; simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith.
rewrite inj_plus.
unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real.
simpl; field.
assert (H'1:(Fbounded be (Float (Zpower_nat radix (p + 1) - 2) (Zpred (Zpred (Fexp v)))))).
split; simpl.
rewrite Zabs_eq; auto with zarith.
rewrite pkGivesBounde.
apply Zlt_le_trans with (Zpower_nat radix (p + 1)); auto with zarith.
apply Zle_trans with (Zpower_nat radix (0 + 1) - 2)%Z; auto with zarith.
unfold Zminus; apply Zplus_le_compat_r; auto with zarith.
apply Zle_trans with (1:=rangeext); auto with zarith.
assert (v + - powerRZ radix (Zpred (Fexp v)) <= y)%R.
rewrite H0.
case (Req_dec (v + - powerRZ radix (Zpred (Fexp v)))%R  x); intros H'2.
Contradict H'.
rewrite <- H'2; rewrite H0.
generalize (To_OddUniqueP be radix (p+k)); unfold UniqueP.
intros T; unfold FtoRradix; apply T with x; auto with zarith; clear T.
rewrite <- H'2; rewrite H0;  unfold FtoRradix;apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
exact H'1.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
unfold FtoRradix; apply T with  (v +- powerRZ radix (Zpred (Fexp v)))%R x; auto with zarith; clear T.
cut (v + - powerRZ radix (Zpred (Fexp v)) <= x)%R; auto with real.
intros T; case T; auto with real.
intros T'; Contradict T; auto with real.
apply Rplus_le_reg_l with (-x+(powerRZ radix (Zpred (Fexp v))))%R.
ring_simplify.
apply Rle_trans with (Rabs (-x +v))%R;[apply RRle_abs|idtac].
rewrite <- Rabs_Ropp.
replace (-(-x+v))%R with (x-v)%R;[idtac|ring].
apply Rmult_le_reg_l with (2%nat)%R; auto with real.
apply Rle_trans with (Fulp b radix p v).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim vdef; auto.
rewrite CanonicFulp; auto with zarith.
right; unfold Zpred, FtoR; simpl; rewrite powerRZ_add; auto with zarith real.
simpl; field; auto with real.
rewrite H0;unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be);auto.
apply To_OddRoundedModeP; auto with zarith.
case H3; auto with real; clear H3; intros H3.
elim ydef; intros H4 H5.
case H5; intros H6.
fold FtoRradix in H6; Contradict H6; auto with real.
clear H5; elim H6; intros H7 H8; clear H6 H7.
absurd (FNeven be radix (p + k) y).
apply FnOddNEven; auto.
apply FNevenEq with (Float (Zpower_nat radix (p + 1) - 2)%Z (Zpred (Zpred (Fexp v)))); auto with zarith.
fold FtoRradix; rewrite <- H0; auto with real.
apply EvenNormalize; auto.
simpl;unfold Zminus; apply EvenPlus1.
replace (p+1) with (S p); [idtac|ring].
apply EvenExp; unfold Even.
exists 1%Z; auto with zarith.
unfold Even; exists (-1)%Z; auto with zarith.
rewrite CanonicFulp; auto with zarith.
apply Rlt_le_trans with (2*(powerRZ radix (Zpred (Fexp v))))%R.
2:unfold FtoRradix, FtoR; simpl; unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real.
2:simpl; right;field.
apply Rmult_lt_compat_l; auto with real.
apply Rplus_lt_reg_r with v.
ring_simplify (v+(y-v))%R.
assert ((v + powerRZ radix (Zpred (Fexp v)))=
  (Float ((Zpower_nat radix (p+1))+2)%Z (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl.
unfold Zminus; rewrite plus_IZR.
rewrite Zpower_nat_Z_powerRZ; rewrite H.
unfold nNormMin; simpl.
rewrite Zpower_nat_Z_powerRZ; rewrite inj_pred; auto with zarith.
rewrite inj_plus.
unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real.
simpl; field.
assert (H'1:(Fbounded be (Float (Zpower_nat radix (p + 1) + 2) (Zpred (Zpred (Fexp v)))))).
split; simpl.
rewrite Zabs_eq; auto with zarith.
rewrite pkGivesBounde.
apply Zlt_le_trans with (Zpower_nat radix (p + 2)); auto with zarith.
apply Zlt_le_trans with (Zpower_nat radix (p + 1) + (Zpower_nat radix (p + 1)))%Z; auto with zarith.
apply Zplus_lt_compat_l; replace 2%Z with (Zpower_nat radix (0 + 1))%Z; auto with zarith.
repeat rewrite Zpower_nat_is_exp; simpl; apply Zeq_le; ring_simplify.
replace (Zpower_nat radix 1) with 2%Z.
replace (Zpower_nat radix 2) with 4%Z;[ring|idtac].
unfold Zpower_nat; simpl; ring.
unfold Zpower_nat; simpl; ring.
apply Zle_trans with (1:=rangeext); auto with zarith.
elim Bv; auto with zarith.
assert (y <= v + powerRZ radix (Zpred (Fexp v)))%R.
rewrite H0.
case (Req_dec (v + powerRZ radix (Zpred (Fexp v)))%R  x); intros H'2.
Contradict H'.
rewrite <- H'2; rewrite H0.
generalize (To_OddUniqueP be radix (p+k)); unfold UniqueP.
intros T; unfold FtoRradix; apply T with x; auto with zarith; clear T.
rewrite <- H'2; rewrite H0;  unfold FtoRradix;apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
exact H'1.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
unfold FtoRradix; apply T with  x (v + powerRZ radix (Zpred (Fexp v)))%R; auto with zarith; clear T.
cut (x <= v + powerRZ radix (Zpred (Fexp v)))%R; auto with real.
intros T; case T; auto with real.
intros T'; Contradict T; auto with real.
apply Rplus_le_reg_l with (-v)%R.
ring_simplify (- v + (v + powerRZ radix (Zpred (Fexp v))))%R.
apply Rle_trans with (Rabs (-v + x))%R;[apply RRle_abs|idtac].
replace (- v + x)%R with (x-v)%R;[idtac|ring].
apply Rmult_le_reg_l with (2%nat)%R; auto with real.
apply Rle_trans with (Fulp b radix p v).
unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim vdef; auto.
rewrite CanonicFulp; auto with zarith.
right; unfold Zpred, FtoR; simpl; rewrite powerRZ_add; auto with zarith.
simpl; field; auto with real.
auto with real.
rewrite H0;unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be);auto.
apply To_OddRoundedModeP; auto with zarith.
case H2; auto with real; clear H2; intros H3.
elim ydef; intros H4 H5.
case H5; intros H6.
fold FtoRradix in H6; Contradict H6; auto with real.
clear H5; elim H6; intros H7 H8; clear H6 H7.
absurd (FNeven be radix (p + k) y).
apply FnOddNEven; auto.
apply FNevenEq with (Float (Zpower_nat radix (p + 1) + 2)%Z (Zpred (Zpred (Fexp v)))); auto with zarith.
fold FtoRradix; rewrite <- H0; auto with real.
apply EvenNormalize; auto.
simpl;unfold Zminus; apply EvenPlus1.
replace (p+1) with (S p); [idtac|ring].
apply EvenExp; unfold Even.
exists 1%Z; auto with zarith.
unfold Even; exists 1%Z; auto with zarith.
Contradict H1; unfold FtoRradix, FtoR; rewrite H.
apply sym_not_eq;apply Rmult_integral_contrapositive; split; auto with real zarith.
unfold nNormMin; auto with zarith real.
Qed.


End DblRndOddAux.

Section DblRndOdd.
Variables b be :  Fbound.
Variables p k :  nat.
Variables y z v: float.
Variables x : R.

Let radix := 2%Z.
Let FtoRradix := FtoR radix.
Coercion FtoRradix : float >-> R.

Hypotheses pGreaterThanOne :  (lt (S O) p).
Hypotheses kGreaterThanOne :  (lt (S O) k).
Hypotheses pGivesBound   :  (Zpos (vNum b)) = (Zpower_nat radix p).
Hypotheses pkGivesBounde :  (Zpos (vNum be)) = (Zpower_nat radix (plus p k)).


Hypotheses By : (Fbounded be y).
Hypotheses Bz : (Fbounded b  z).
Hypotheses Bv : (Fbounded b  v).
Hypotheses Cv : (Fcanonic radix b v).

Hypotheses ydef : (To_Odd      be radix (plus p k) x y).
Hypotheses zdef : (EvenClosest b  radix p          y z).
Hypotheses vdef : (EvenClosest b  radix p          x v).

Hypotheses rangeext: (-(dExp be) <= (Zpred (Zpred (-(dExp b)))))%Z.


Theorem To_Odd_Even_is_Even: ((FtoRradix v)=(FtoRradix z))%R.
case (Z_eq_dec (Zabs (Fnum v)) (nNormMin radix p)); intros H.
generalize EvenClosestUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply T with b p y; auto with zarith; clear T.
case (Req_dec x y); intros H'.
rewrite <- H'; auto.
case (Rle_or_lt 0%R v); intros H1.
rewrite Zabs_eq in H.
2: apply LeR0Fnum with radix; auto with real zarith.
apply To_Odd_Even_is_Even_nNormMin with be k x; auto.
rewrite <- (Ropp_involutive y%R).
rewrite <- (Fopp_Fopp v).
generalize (EvenClosestSymmetric b radix); unfold SymmetricP.
intros T; apply T; clear T.
unfold FtoRradix;rewrite <- Fopp_correct.
apply To_Odd_Even_is_Even_nNormMin with be k (-x)%R; auto with float.
generalize To_OddSymmetricP; unfold SymmetricP; intros T;apply T; auto.
generalize EvenClosestSymmetric; unfold SymmetricP; intros T;apply T; auto.
simpl; rewrite <- (Zabs_eq (-(Fnum v))%Z); auto with zarith. 
rewrite Zabs_Zopp; auto with zarith.
cut (Fnum v <= 0)%Z; auto with zarith.
apply R0LeFnum with radix; auto with real zarith.
rewrite Fopp_correct; auto with real zarith;fold radix FtoRradix.
Contradict H'.
rewrite <- Ropp_involutive; rewrite <- H'; auto with real.
rewrite  Fopp_correct; auto with real zarith.
assert (2%nat * Rabs (x - v) <= Fulp b radix p v)%R.
unfold FtoRradix; apply ClosestUlp; auto with zarith.
elim vdef; auto.
case H0; clear H0; intros H1.
generalize EvenClosestUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply T with b p y; auto with zarith; clear T.
case (Req_dec x y); intros H'.
rewrite <- H'; auto.
elim ClosestStrict with (b:=b) (p:=p) (f:=v) (z0:=y); auto.
intros H2 H3.
unfold EvenClosest.
split; auto.
assert (Rabs (x - v) < (powerRZ radix  (Zpred (Fexp v))))%R.
apply Rmult_lt_reg_l with 2%nat; auto with real.
apply Rlt_le_trans with (1:=H1);right; unfold Fulp.
rewrite FcanonicFnormalizeEq; auto with zarith;simpl.
unfold Zpred; rewrite powerRZ_add; auto with zarith real.
simpl; field; auto with real.
unfold Fulp; rewrite FcanonicFnormalizeEq; auto with zarith.
apply Rlt_le_trans with (2%nat * powerRZ radix (Zpred (Fexp v)))%R.
apply Rmult_lt_compat_l; auto with real.
2: unfold Zpred; rewrite powerRZ_add; auto with zarith real.
2: right; simpl; field; auto with real.
assert (Rabs (y - v) <= powerRZ radix (Zpred (Fexp v)))%R.
case (Rle_or_lt x v); intros H2.
rewrite Rabs_left1;apply Rplus_le_reg_l with (-v)%R;ring_simplify (- v + - (y - v))%R.
apply Rle_trans with  (- (v - powerRZ radix (Zpred (Fexp v))))%R;[idtac|right;ring].
apply Ropp_le_contravar.
assert ((v - powerRZ radix (Zpred (Fexp v)))=(Float (2*(Zpred (2*(Fnum v))))%Z (Zpred (Zpred (Fexp v)))))%R.
apply trans_eq with (2*2*(Fnum v)*(powerRZ radix (Zpred (Zpred (Fexp v))))- 2*powerRZ radix (Zpred(Zpred (Fexp v))))%R.
unfold FtoRradix, FtoR; simpl; ring_simplify.
unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
unfold FtoRradix, FtoR.
apply trans_eq with ((2*(Zpred(2* Fnum v)))%Z *powerRZ radix (Zpred (Zpred (Fexp v))))%R;[idtac|simpl;auto with real].
unfold Zpred;rewrite mult_IZR;rewrite plus_IZR;rewrite mult_IZR;simpl; ring.
rewrite H3.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
apply T with  (v - powerRZ radix (Zpred (Fexp v)))%R x; auto with zarith.
apply Rplus_lt_reg_r with (-x+powerRZ radix (Zpred (Fexp v)))%R.
ring_simplify.
apply Rle_lt_trans with (-(x-v))%R;[right;ring|idtac].
apply Rle_lt_trans with (Rabs (-(x-v)))%R;[apply RRle_abs|rewrite Rabs_Ropp];auto.
rewrite H3.
unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
clear T;split.
cut ((Zabs (2 * Zpred (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zpred.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (-1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (-1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
apply Rplus_le_reg_l with (v+v)%R.
ring_simplify.
case H2; intros H3.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
apply T with x (v)%R; auto with zarith.
unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
clear T;split.
apply Zlt_le_trans with (Zpos (vNum b))%Z; auto with zarith float.
rewrite pkGivesBounde; rewrite pGivesBound; auto with zarith.
apply Zle_trans with (- dExp b)%Z; auto with zarith float.
apply Zle_trans with (1:=rangeext); auto with zarith.
right; generalize (To_OddUniqueP be radix (p+k)); unfold UniqueP.
intros T; unfold FtoRradix; apply T with x; auto with zarith.
rewrite H3;  unfold FtoRradix;apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
clear T;split.
apply Zlt_le_trans with (Zpos (vNum b))%Z; auto with zarith float.
rewrite pkGivesBounde; rewrite pGivesBound; auto with zarith.
apply Zle_trans with (- dExp b)%Z; auto with zarith float.
apply Zle_trans with (1:=rangeext); auto with zarith.
rewrite Rabs_right;[apply Rplus_le_reg_l with (v)%R;ring_simplify ( v +  (y - v))%R|idtac].
assert ((v + powerRZ radix (Zpred (Fexp v)))=(Float (2*(Zsucc (2*(Fnum v))))%Z (Zpred (Zpred (Fexp v)))))%R.
apply trans_eq with (2*2*(Fnum v)*(powerRZ radix (Zpred (Zpred (Fexp v))))+ 2*powerRZ radix (Zpred(Zpred (Fexp v))))%R.
unfold FtoRradix, FtoR; simpl; ring_simplify.
unfold Zpred; repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
unfold FtoRradix, FtoR.
apply trans_eq with ((2*(Zsucc(2* Fnum v)))%Z *powerRZ radix (Zpred (Zpred (Fexp v))))%R;[idtac|simpl;auto with real].
unfold Zsucc;rewrite mult_IZR;rewrite plus_IZR;rewrite mult_IZR;simpl; ring.
rewrite H3.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
apply T with x (v + powerRZ radix (Zpred (Fexp v)))%R; auto with zarith.
apply Rplus_lt_reg_r with (-v)%R.
ring_simplify  (- v + (v + powerRZ radix (Zpred (Fexp v))))%R.
apply Rle_lt_trans with ((x-v))%R;[right;ring|idtac].
apply Rle_lt_trans with (Rabs ((x-v)))%R;[apply RRle_abs|idtac];auto.
rewrite H3.
unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
clear T;split.
cut ((Zabs (2 * Zsucc (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zsucc.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
apply Rle_ge;apply Rplus_le_reg_l with (v)%R.
ring_simplify.
generalize (To_OddMonotone be radix (p+k));unfold MonotoneP; intros T.
apply T with (v)%R x; auto with zarith.
unfold FtoRradix; apply RoundedModeProjectorIdem with (P:=(To_Odd be radix (p+k))) (b:=be).
apply To_OddRoundedModeP; auto with zarith.
clear T;split.
apply Zlt_le_trans with (Zpos (vNum b))%Z; auto with zarith float.
rewrite pkGivesBounde; rewrite pGivesBound; auto with zarith.
apply Zle_trans with (- dExp b)%Z; auto with zarith float.
apply Zle_trans with (1:=rangeext); auto with zarith.
case H2; auto with real.
clear H2; intros H2.
Contradict H'.
elim ydef; intros T1 T2;case T2; auto with real.
clear T1 T2; intros T1; elim T1; intros T2 T3.
absurd (FNeven be radix (p + k) y).
apply FnOddNEven; auto.
case (Rle_or_lt (y-v)%R 0%R); intros H3.
apply FNevenEq with (Float (2*(Zpred (2*(Fnum v))))%Z (Zpred (Zpred (Fexp v)))); auto with zarith.
split.
cut ((Zabs (2 * Zpred (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zpred.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (-1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (-1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify  (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
fold FtoRradix; apply Rplus_eq_reg_l with (-v)%R.
apply trans_eq with (-(-(y-v)))%R;[idtac|ring].
rewrite <- (Rabs_left1 (y-v)%R); auto with real.
rewrite H2.
pattern (FtoRradix v) at 1 in |-*; replace (FtoRradix v) with ((2*2*(Fnum v)*(powerRZ radix (Zpred (Zpred (Fexp v))))))%R.
apply trans_eq with (- (4 * Fnum v * powerRZ radix (Zpred (Zpred (Fexp v)))) +
    ((2 * Zpred (2 * Fnum v)))%Z * (powerRZ radix  (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl; ring.
unfold Zpred;rewrite mult_IZR;rewrite plus_IZR;rewrite mult_IZR;simpl; ring_simplify.
repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
unfold Zpred, FtoRradix, FtoR; repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
apply EvenNormalize.
split.
cut ((Zabs (2 * Zpred (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zpred.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (-1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (-1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify  (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
replace (Fnum (Float (2 * Zpred (2 * Fnum v)) (Zpred (Zpred (Fexp v)))))%Z
  with (2 * Zpred (2 * Fnum v))%Z; auto.
apply EvenMult1; auto with zarith.
unfold Even; exists 1%Z; auto with zarith.
apply FNevenEq with (Float (2*(Zsucc (2*(Fnum v))))%Z (Zpred (Zpred (Fexp v)))); auto with zarith.
split.
cut ((Zabs (2 * Zsucc (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zsucc.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
fold FtoRradix; apply Rplus_eq_reg_l with (-v)%R.
apply trans_eq with (((y-v)))%R;[idtac|ring].
rewrite <- (Rabs_right (y-v)%R); auto with real.
rewrite H2.
pattern (FtoRradix v) at 1 in |-*; replace (FtoRradix v) with ((2*2*(Fnum v)*(powerRZ radix (Zpred (Zpred (Fexp v))))))%R.
apply trans_eq with (- (4 * Fnum v * powerRZ radix (Zpred (Zpred (Fexp v)))) +
    ((2 * Zsucc (2 * Fnum v)))%Z * (powerRZ radix  (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl; ring.
unfold Zsucc;rewrite mult_IZR;rewrite plus_IZR;rewrite mult_IZR;simpl; ring_simplify.
unfold Zpred;repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
unfold Zpred, FtoRradix, FtoR; repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
apply Rle_ge; auto with real.
apply EvenNormalize.
split.
cut ((Zabs (2 * Zsucc (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zsucc.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
replace (Fnum (Float (2 * Zsucc (2 * Fnum v)) (Zpred (Zpred (Fexp v)))))%Z
  with (2 * Zsucc (2 * Fnum v))%Z; auto.
apply EvenMult1; auto with zarith.
unfold Even; exists 1%Z; auto with zarith.
generalize EvenClosestUniqueP; unfold UniqueP; intros T.
unfold FtoRradix; apply T with b p y; auto with zarith; clear T.
replace (FtoRradix y) with x; auto.
cut (exists f : float, (Fbounded be f) /\ (FtoRradix f) = x).
intros T; elim T; intros f T1; elim T1; intros H2 H3; clear T T1.
rewrite <- H3; unfold FtoRradix.
apply RoundedModeProjectorIdemEq with (precision:=p+k) (P:=(To_Odd be radix (p+k))) (b:=be); auto with zarith.
apply To_OddRoundedModeP; auto with zarith.
fold FtoRradix; rewrite H3; auto.
assert (Rabs (x - v) = powerRZ radix (Zpred (Fexp v)))%R.
apply trans_eq with (/2 * (2%nat *  Rabs (x - v)))%R;[simpl; field; auto with real|idtac].
rewrite H1; unfold Fulp; rewrite FcanonicFnormalizeEq; auto with zarith.
unfold Zpred; rewrite powerRZ_add; auto with real zarith; simpl; field.
case (Rle_or_lt (x-v)%R 0%R); intros H2.
exists (Float (2*(Zpred (2*(Fnum v))))%Z (Zpred (Zpred (Fexp v))));split.
split.
cut ((Zabs (2 *Zpred (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zpred.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (-1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (-1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
fold FtoRradix; apply Rplus_eq_reg_l with (-v)%R.
apply trans_eq with (-(-(x-v)))%R;[idtac|ring].
rewrite <- (Rabs_left1 (x-v)%R); auto with real.
rewrite H0.
pattern (FtoRradix v) at 1 in |-*; replace (FtoRradix v) with ((2*2*(Fnum v)*(powerRZ radix (Zpred (Zpred (Fexp v))))))%R.
apply trans_eq with (- (4 * Fnum v * powerRZ radix (Zpred (Zpred (Fexp v)))) +
    ((2 * Zpred (2 * Fnum v)))%Z * (powerRZ radix  (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl; ring.
unfold Zpred;rewrite mult_IZR;rewrite plus_IZR;rewrite mult_IZR;simpl; ring_simplify.
repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
unfold Zpred, FtoRradix, FtoR; repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
exists (Float (2*(Zsucc (2*(Fnum v))))%Z (Zpred (Zpred (Fexp v))));split.
split.
cut ((Zabs (2 *Zsucc (2 * Fnum v))) < Zpos (vNum be))%Z; auto with zarith.
rewrite pkGivesBounde;rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith; unfold Zsucc.
apply Zle_lt_trans with  (2 * (Zabs (2 * Fnum v) + (Zabs (1))))%Z; auto with zarith.
rewrite Zabs_Zmult;rewrite Zabs_eq; auto with zarith.
replace (Zabs (1))%Z with 1%Z; auto with zarith.
apply Zle_lt_trans with (2 * (2 * (Zpred (Zpower_nat radix p)) + 1))%Z.
cut (Zabs (Fnum v) <=  (Zpred (Zpower_nat radix p)))%Z; auto with zarith float.
elim Bv; rewrite pGivesBound; auto with zarith.
unfold Zpred;ring_simplify  (2 * (2 * (Zpower_nat radix p + -1) + 1))%Z.
apply Zlt_le_trans with (4 * Zpower_nat radix p)%Z; auto with zarith.
apply Zle_trans with  (Zpower_nat radix (p+2))%Z; auto with zarith.
rewrite Zpower_nat_is_exp;simpl (Zpower_nat 2); auto with zarith.
simpl;apply Zle_trans with (Zpred (Zpred (- dExp b)))%Z; auto with zarith float.
fold FtoRradix; apply Rplus_eq_reg_l with (-v)%R.
apply trans_eq with (((x-v)))%R;[idtac|ring].
rewrite <- (Rabs_right (x-v)%R); auto with real.
rewrite H0.
pattern (FtoRradix v) at 1 in |-*; replace (FtoRradix v) with ((2*2*(Fnum v)*(powerRZ radix (Zpred (Zpred (Fexp v))))))%R.
apply trans_eq with (- (4 * Fnum v * powerRZ radix (Zpred (Zpred (Fexp v)))) +
    ((2 * Zsucc (2 * Fnum v)))%Z * (powerRZ radix  (Zpred (Zpred (Fexp v)))))%R.
unfold FtoRradix, FtoR; simpl; ring.
unfold Zsucc;rewrite mult_IZR;rewrite plus_IZR;rewrite mult_IZR;simpl; ring_simplify.
unfold Zpred;repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
unfold Zpred, FtoRradix, FtoR; repeat rewrite powerRZ_add; auto with zarith real; simpl; field; auto with real.
apply Rle_ge; auto with real.
Qed.


End DblRndOdd.

