Commit bdd4d892 authored by Guillaume Melquiond's avatar Guillaume Melquiond

Finished proof of DN_UP_parity_FLT_pos.

parent e895c104
...@@ -775,6 +775,21 @@ now apply Rlt_le. ...@@ -775,6 +775,21 @@ now apply Rlt_le.
now apply Rlt_le. now apply Rlt_le.
Qed. Qed.
Theorem ln_beta_bpow :
forall e, projT1 (ln_beta (bpow e)) = (e + 1)%Z.
Proof.
intros e.
apply ln_beta_unique.
rewrite Rabs_right.
replace (e + 1 - 1)%Z with e by ring.
split.
apply Rle_refl.
apply -> bpow_lt.
apply Zlt_succ.
apply Rle_ge.
apply bpow_ge_0.
Qed.
Theorem Zpower_pos_gt_0 : Theorem Zpower_pos_gt_0 :
forall b p, (0 < b)%Z -> forall b p, (0 < b)%Z ->
(0 < Zpower_pos b p)%Z. (0 < Zpower_pos b p)%Z.
......
...@@ -156,6 +156,32 @@ apply Rle_lt_trans with (1 := Hx1). ...@@ -156,6 +156,32 @@ apply Rle_lt_trans with (1 := Hx1).
now apply Hx5. now apply Hx5.
Qed. Qed.
(* TODO: vérifier si ça implique ^^ *)
Theorem FLT_canonic_FLX :
forall x : R,
(bpow (emin + prec - 1) <= Rabs x)%R ->
forall f : float beta,
( canonic beta FLT_exp x f <-> canonic beta (FLX_exp prec) x f ).
Proof.
intros x Hx f.
unfold canonic.
replace (FLT_exp (projT1 (ln_beta beta x))) with (FLX_exp prec (projT1 (ln_beta beta x))).
apply iff_refl.
unfold FLX_exp, FLT_exp.
apply sym_eq.
apply Zmax_left.
destruct (ln_beta beta x) as (ex, He).
simpl.
assert (emin + prec - 1 < ex)%Z. 2: omega.
apply <- (bpow_lt beta).
apply Rle_lt_trans with (1 := Hx).
apply He.
intros H.
elim Rlt_not_le with (2 := Hx).
rewrite H, Rabs_R0.
apply bpow_gt_0.
Qed.
Theorem FLT_format_FIX : Theorem FLT_format_FIX :
forall x, forall x,
(Rabs x <= bpow (emin + prec))%R -> (Rabs x <= bpow (emin + prec))%R ->
......
...@@ -35,6 +35,23 @@ exists (Float beta 0 _) ; repeat split. ...@@ -35,6 +35,23 @@ exists (Float beta 0 _) ; repeat split.
now rewrite F2R_0. now rewrite F2R_0.
Qed. Qed.
Theorem generic_format_bpow :
forall e, (fexp (e + 1) <= e)%Z ->
generic_format (bpow e).
Proof.
intros e H.
exists (Float beta (1 * Zpower (radix_val beta) (e - fexp (e + 1))) (fexp (e + 1))).
split.
rewrite <- F2R_change_exp.
apply sym_eq.
apply F2R_bpow.
exact H.
simpl.
apply f_equal.
apply sym_eq.
apply ln_beta_bpow.
Qed.
Theorem generic_DN_pt_large_pos_ge_pow : Theorem generic_DN_pt_large_pos_ge_pow :
forall x ex, forall x ex,
(fexp ex < ex)%Z -> (fexp ex < ex)%Z ->
......
...@@ -561,9 +561,89 @@ Proof. ...@@ -561,9 +561,89 @@ Proof.
intros x xd xu cd cu Hx0 Hfx Hd Hu Hxd Hxu Hed Heu. intros x xd xu cd cu Hx0 Hfx Hd Hu Hxd Hxu Hed Heu.
destruct (Rlt_or_le (bpow (emin + prec - 1)) x) as [Hx|Hx]. destruct (Rlt_or_le (bpow (emin + prec - 1)) x) as [Hx|Hx].
(* . *) (* . *)
admit. assert (Hn : generic_format beta FLTf (bpow (emin + prec - 1))).
apply generic_format_bpow.
unfold FLT_exp.
replace (emin + prec - 1 + 1 - prec)%Z with emin by ring.
rewrite Zmax_idempotent.
omega.
apply DN_UP_parity_FLX_pos with prec x xd xu cd cu ; try easy.
(* .. *)
intros H.
apply Hfx.
apply -> FLT_format_generic. 2: exact Hp.
apply <- FLT_format_FLX. 3: exact Hp.
now apply <- FLX_format_generic.
rewrite Rabs_pos_eq.
now apply Rlt_le.
now apply Rlt_le.
(* .. *)
apply -> FLT_canonic_FLX.
eexact Hd.
rewrite Rabs_pos_eq.
apply Hxd.
exact Hn.
now apply Rlt_le.
apply Hxd.
apply generic_format_0.
now apply Rlt_le.
(* .. *)
apply -> FLT_canonic_FLX.
eexact Hu.
rewrite Rabs_pos_eq.
apply Rlt_le.
apply Rlt_le_trans with (1 := Hx).
apply Hxu.
apply Rlt_le.
apply Rlt_le_trans with (1 := Hx0).
apply Hxu.
(* .. *)
apply Rnd_DN_pt_equiv_format with (a := bpow (emin + prec - 1)) (b := x) (4 := Hxd).
exact Hn.
intros a (Ha, _).
apply iff_trans with (2 := FLX_format_generic beta prec Hp a).
assert (Ha' : (bpow (emin + prec - 1) <= Rabs a)%R).
rewrite Rabs_pos_eq.
exact Ha.
apply Rle_trans with (2 := Ha).
apply bpow_ge_0.
apply iff_trans with (2 := FLT_format_FLX beta emin prec Hp a Ha').
apply iff_sym.
now apply FLT_format_generic.
split.
now apply Rlt_le.
apply Rle_refl.
(* .. *)
destruct (ln_beta beta x) as (ex, He).
specialize (He (Rgt_not_eq _ _ Hx0)).
rewrite Rabs_pos_eq in He.
2: now apply Rlt_le.
apply Rnd_UP_pt_equiv_format with (a := x) (b := bpow ex) (4 := Hxu).
apply generic_format_bpow.
unfold FLT_exp.
rewrite Zmax_left.
omega.
assert (emin + prec - 1 <= ex)%Z. 2 : omega.
apply <- (bpow_le beta).
apply Rlt_le.
now apply Rlt_trans with (2 := proj2 He).
intros b (Hb, _).
apply iff_trans with (2 := FLX_format_generic beta prec Hp b).
assert (Hb' : (bpow (emin + prec - 1) <= Rabs b)%R).
rewrite Rabs_pos_eq.
apply Rle_trans with (2 := Hb).
now apply Rlt_le.
apply Rle_trans with (2 := Hb).
now apply Rlt_le.
apply iff_trans with (2 := FLT_format_FLX beta emin prec Hp b Hb').
apply iff_sym.
now apply FLT_format_generic.
split.
apply Rle_refl.
now apply Rlt_le.
(* . *) (* . *)
apply (DN_UP_parity_FIX emin x xd xu cd cu) ; trivial. apply (DN_UP_parity_FIX emin x xd xu cd cu) ; trivial.
(* .. *)
intros H. intros H.
apply Hfx. apply Hfx.
apply generic_format_fun_eq with (2 := H). apply generic_format_fun_eq with (2 := H).
...@@ -577,6 +657,7 @@ apply Rle_lt_trans with (1 := Hx). ...@@ -577,6 +657,7 @@ apply Rle_lt_trans with (1 := Hx).
apply -> bpow_lt. apply -> bpow_lt.
apply Zlt_pred. apply Zlt_pred.
now apply Rlt_le. now apply Rlt_le.
(* .. *)
apply canonic_fun_eq with (2 := Hd). apply canonic_fun_eq with (2 := Hd).
apply sym_eq. apply sym_eq.
apply FIX_FLT_exp_subnormal. apply FIX_FLT_exp_subnormal.
...@@ -625,6 +706,7 @@ apply Zlt_pred. ...@@ -625,6 +706,7 @@ apply Zlt_pred.
apply Hxd. apply Hxd.
apply generic_format_0. apply generic_format_0.
now apply Rlt_le. now apply Rlt_le.
(* .. *)
apply canonic_fun_eq with (2 := Hu). apply canonic_fun_eq with (2 := Hu).
apply sym_eq. apply sym_eq.
apply FIX_FLT_exp_subnormal. apply FIX_FLT_exp_subnormal.
...@@ -634,16 +716,57 @@ apply Hxu. ...@@ -634,16 +716,57 @@ apply Hxu.
rewrite Rabs_pos_eq. rewrite Rabs_pos_eq.
apply Rle_lt_trans with (bpow (emin + prec - 1)). apply Rle_lt_trans with (bpow (emin + prec - 1)).
apply Hxu. apply Hxu.
exists (Float beta (Zpower (radix_val beta) (prec - 1)) emin). apply generic_format_bpow.
admit. unfold FLT_exp.
replace (emin + prec - 1 + 1 - prec)%Z with emin by ring.
rewrite Zmax_idempotent.
omega.
exact Hx. exact Hx.
apply -> bpow_lt. apply -> bpow_lt.
apply Zlt_pred. apply Zlt_pred.
apply Rlt_le. apply Rlt_le.
apply Rlt_le_trans with (1 := Hx0). apply Rlt_le_trans with (1 := Hx0).
apply Hxu. apply Hxu.
admit. (* .. *)
admit. apply Rnd_DN_pt_equiv_format with (a := R0) (b := x) (4 := Hxd).
apply generic_format_0.
intros a (Ha1, Ha2).
apply iff_trans with (2 := FIX_format_generic beta emin a).
assert (Ha' : (Rabs a <= bpow (emin + prec))%R).
rewrite Rabs_pos_eq.
apply Rle_trans with (1 := Ha2).
apply Rle_trans with (1 := Hx).
apply -> bpow_le.
apply Zle_pred.
exact Ha1.
apply iff_trans with (2 := FLT_format_FIX beta emin prec Hp a Ha').
apply iff_sym.
now apply FLT_format_generic.
split.
now apply Rlt_le.
apply Rle_refl.
(* .. *)
apply Rnd_UP_pt_equiv_format with (a := x) (b := bpow (emin + prec - 1)) (4 := Hxu).
apply generic_format_bpow.
unfold FLT_exp.
replace (emin + prec - 1 + 1 - prec)%Z with emin by ring.
rewrite Zmax_idempotent.
omega.
intros a (Ha1, Ha2).
apply iff_trans with (2 := FIX_format_generic beta emin a).
assert (Ha' : (Rabs a <= bpow (emin + prec))%R).
rewrite Rabs_pos_eq.
apply Rle_trans with (1 := Ha2).
apply -> bpow_le.
apply Zle_pred.
apply Rle_trans with (2 := Ha1).
now apply Rlt_le.
apply iff_trans with (2 := FLT_format_FIX beta emin prec Hp a Ha').
apply iff_sym.
now apply FLT_format_generic.
split.
apply Rle_refl.
exact Hx.
Qed. Qed.
Theorem Rnd_NE_pt_FLT : Theorem Rnd_NE_pt_FLT :
......
...@@ -1037,4 +1037,64 @@ rewrite <- Rnd_0 with (2 := H) ; trivial. ...@@ -1037,4 +1037,64 @@ rewrite <- Rnd_0 with (2 := H) ; trivial.
now apply H. now apply H.
Qed. Qed.
Theorem Rnd_DN_pt_equiv_format :
forall F1 F2 : R -> Prop,
forall a b : R,
F1 a ->
( forall x, a <= x <= b -> (F1 x <-> F2 x) ) ->
forall x f, a <= x <= b -> Rnd_DN_pt F1 x f -> Rnd_DN_pt F2 x f.
Proof.
intros F1 F2 a b Ha HF x f Hx (H1, (H2, H3)).
split.
apply -> HF.
exact H1.
split.
now apply H3.
now apply Rle_trans with (1 := H2).
split.
exact H2.
intros k Hk Hl.
destruct (Rlt_or_le k a) as [H|H].
apply Rlt_le.
apply Rlt_le_trans with (1 := H).
now apply H3.
apply H3.
apply <- HF.
exact Hk.
split.
exact H.
now apply Rle_trans with (1 := Hl).
exact Hl.
Qed.
Theorem Rnd_UP_pt_equiv_format :
forall F1 F2 : R -> Prop,
forall a b : R,
F1 b ->
( forall x, a <= x <= b -> (F1 x <-> F2 x) ) ->
forall x f, a <= x <= b -> Rnd_UP_pt F1 x f -> Rnd_UP_pt F2 x f.
Proof.
intros F1 F2 a b Hb HF x f Hx (H1, (H2, H3)).
split.
apply -> HF.
exact H1.
split.
now apply Rle_trans with (2 := H2).
now apply H3.
split.
exact H2.
intros k Hk Hl.
destruct (Rle_or_lt k b) as [H|H].
apply H3.
apply <- HF.
exact Hk.
split.
now apply Rle_trans with (2 := Hl).
exact H.
exact Hl.
apply Rlt_le.
apply Rle_lt_trans with (2 := H).
now apply H3.
Qed.
End RND_prop. End RND_prop.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment