(****************************************************************************  IEEE754  :  Faux  Laurent Thery  ***************************************************************************** Auxillary properties about natural numbers, relative numbers and reals *)
Require Export Min.
Require Export Arith.
Require Export Reals.
Require Export Zpower.
Require Export ZArith.
Require Export Zcomplements.
Require Export sTactic.
Hint Resolve R1_neq_R0: real.
(*Missing rule for nat *)
intros a b H'.
apply sym_equal.
apply plus_minus; auto.
rewrite plus_comm; apply le_plus_minus; auto.
Qed.
intros p q r t H'; elim H'; simpl in |- *; auto with arith.
elim p; simpl in |- *; auto with arith.
intros n H m H0 H1 H2; apply plus_le_compat; auto with arith.
apply le_trans with (m := r + n * r); auto with arith.
Qed.
Hint Resolve lte_comp_mult: arith.
intros n m H'; rewrite H'; auto.
Qed.
intros n m H'; inversion H'; simpl in |- *; auto.
apply le_trans with (S n); auto.
Qed.
intros p; elim p; simpl in |- *.
auto with arith.
intros n0; case n0.
simpl in |- *; auto with arith.
intros n1 H' q r H'0 H'1.
apply lt_trans with (m := q + S n1 * r); auto with arith.
Qed.
Hint Resolve lt_comp_mult_l: arith.
intros; repeat rewrite (fun x : nat => mult_comm x p); auto with arith.
Qed.
Hint Resolve lt_comp_mult_r: arith.
intros p q r s; case q.
intros H'; inversion H'.
intros q'; case p.
intros H' H'0; simpl in |- *; apply le_lt_trans with (m := r);
auto with arith.
intros p' H' H'0; apply le_lt_trans with (m := S q' * r); auto with arith.
Qed.
Hint Resolve lt_comp_mult: arith.
intros n m p H' H'0.
apply le_antisym; auto.
case (le_or_lt m p); intros H'1; auto with arith.
absurd (n * p < n * m); auto with arith.
rewrite H'0; auto with arith.
case (le_or_lt p m); intros H'1; auto with arith.
absurd (n * m < n * p); auto with arith.
rewrite H'0; auto with arith.
Qed.
Definition natEq : forall n m : nat, {n = m} + {n <> m}.
intros n; elim n.
intros m; case m; auto with arith.
intros n0 H' m; case m; auto with arith.
Defined.
intros n H'; Contradict H'; auto.
rewrite H'; auto with arith.
Qed.
Hint Resolve notEqLt: arith.
intros n m H'; elim H'; auto with arith.
Qed.
intros n m H'; case (le_lt_or_eq _ _ H'); auto with arith.
Qed.
intros n; elim n; simpl in |- *; auto with arith.
intros n' Rec m; case m; simpl in |- *; auto with arith.
intros m'; elim (Rec m'); intros H'0; case H'0; clear H'0; intros H'0 H'1;
rewrite H'0; auto with arith.
Qed.
intros n; elim n; simpl in |- *; auto with arith.
intros n0 H' m; case m; auto with arith.
intros H'0; discriminate.
Qed.
intros n m H'; elim H'; simpl in |- *; auto with arith.
intros m0 H'0 H'1; apply minus_inv_lt_aux; auto.
Qed.
intros m n p q H' H'0.
case (le_or_lt m q); intros H'1.
rewrite minus_inv_lt with (1 := H'1); auto with arith.
apply (fun p n m : nat => plus_le_reg_l n m p) with (p := q).
rewrite le_plus_minus_r; auto with arith.
rewrite (le_plus_minus p q); auto.
rewrite (plus_comm p).
rewrite plus_assoc_reverse.
rewrite le_plus_minus_r; auto with arith.
apply le_trans with (1 := H'); auto with arith.
apply le_trans with (1 := H'0); auto with arith.
apply le_trans with (2 := H'); auto with arith.
Qed.
intros n m p H'; generalize m; clear m; elim H'.
intros m H'0; rewrite <- minus_n_n; elim H'0.
rewrite <- minus_Sn_m; auto with arith.
intros m0 H'1 H'2; rewrite <- minus_Sn_m; auto with arith.
intros m H'0 H'1 m0 H'2; repeat rewrite <- minus_Sn_m; auto with arith.
apply le_trans with n; auto with arith.
Qed.
intros n n1 n2 H' H'0; case (le_or_lt n2 n1); auto.
intros H'1; Contradict H'0; auto.
apply le_not_lt; auto with arith.
Qed.
intros n n1 n2 H' H'0; case (le_or_lt n1 n2); auto.
intros H'1; Contradict H'0; auto.
apply lt_not_le; auto with arith.
Qed.
intros n; case n; simpl in |- *; auto.
Qed.
(*Simplification rules missing in R *)
Hint Resolve Rabs_pos: real.
intros r1 r2 H; replace 0%R with (r1 - r1)%R; unfold Rminus in |- *;
auto with real.
Qed.
Hint Resolve Rlt_Rminus_ZERO: real.
intros a H; case H; intros H1.
apply Rabs_left; auto.
rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
Qed.
intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
Qed.
intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real;
intros; apply Ropp_le_cancel; auto with real.
Qed.
intros p q; unfold Rmax in |- *.
case (Rle_dec p q); case (Rle_dec q p); auto; intros H1 H2; apply Rle_antisym;
auto.
case (Rle_or_lt p q); auto; intros H'0; Contradict H1; apply Rlt_le; auto.
case (Rle_or_lt q p); auto; intros H'0; Contradict H2; apply Rlt_le; auto.
Qed.
intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with r; auto with real.
apply RmaxLess2; auto.
apply Rge_trans with p; auto with real; apply Rge_trans with q;
auto with real.
apply Rge_trans with p; auto with real.
rewrite (Rabs_left p); auto.
case (Rle_or_lt 0 q); intros H'2.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with r; auto.
apply RmaxLess2; auto.
apply Rge_trans with q; auto with real.
rewrite (Rabs_left q); auto.
case (Rle_or_lt 0 r); intros H'3.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with (- p)%R; auto with real.
apply RmaxLess1; auto.
rewrite (Rabs_left r); auto.
apply Rle_trans with (- p)%R; auto with real.
apply RmaxLess1; auto.
Qed.
intros z; case z; simpl in |- *; auto with real.
apply Rabs_right; auto with real.
intros p0; apply Rabs_right; auto with real zarith.
intros p0; unfold IZR; rewrite <- INR_IPR; rewrite Rabs_Ropp.
apply Rabs_right; auto with real zarith.
Qed.
intros p q r H; unfold Rmax in |- *.
case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
case H; intros E1.
case H1; auto with real.
rewrite <- E1; repeat rewrite Rmult_0_l; auto.
case H; intros E1.
case H2; auto with real.
apply Rmult_le_reg_l with (r := r); auto.
rewrite <- E1; repeat rewrite Rmult_0_l; auto.
Qed.
intros p H; rewrite <- Ropp_0; auto with real.
Qed.
intros p H; rewrite <- Ropp_0; auto with real.
Qed.
Hint Resolve Rle_R0_Ropp Rlt_R0_Ropp: real.
(* Properties of Z *)
intros p; elim p.
intros p0 H'; unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6.
generalize H'; case (nat_of_P p0); auto.
intros p0 H'; unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6.
generalize H'; case (nat_of_P p0); simpl in |- *; auto.
unfold nat_of_P in |- *; simpl in |- *; auto with arith.
Qed.
Hint Resolve convert_not_O: zarith arith.
Hint Resolve Zlt_le_weak Zle_not_gt Zgt_irrefl Z.lt_irrefl Zle_not_lt
Zlt_not_le Zlt_asym inj_lt inj_le: zarith.
intros x; elim x; auto.
unfold Z.abs_nat in |- *.
intros p.
pattern p at 1 3 in |- *;
rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id p).
generalize (convert_not_O p); case (nat_of_P p); simpl in |- *;
auto with arith.
intros H'; case H'; auto.
intros n H' H'0; rewrite Pos.pred_succ; auto.
intros p H'; Contradict H'; auto.
Qed.
intros p q H'; rewrite H'.
CaseEq (nat_of_P q); simpl in |- *.
elim q; unfold nat_of_P in |- *; simpl in |- *; intros;
try discriminate.
absurd (0%Z = Zpos p0); auto.
red in |- *; intros H'0; try discriminate.
apply H; auto.
change (nat_of_P p0 = 0) in |- *.
generalize H0; rewrite ZL6; case (nat_of_P p0); simpl in |- *;
auto; intros; try discriminate.
intros n; rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ.
intros H'0; apply f_equal with (f := Zpos).
apply nat_of_P_inj; auto.
Qed.
Hint Resolve inj_le inj_lt: zarith.
intros x y H'.
case (le_or_lt x y); auto with arith.
intros H'0; Contradict H'; auto with zarith.
Qed.
intros x y H'; apply le_antisym.
apply ZleLe; auto.
idtac; rewrite H'; auto with zarith.
apply ZleLe; auto.
idtac; rewrite H'; auto with zarith.
Qed.
intros p q; case p; case q; simpl in |- *; auto with arith;
try (intros; discriminate); intros q1 p1.
intros H1; rewrite (Pcompare_Eq_eq p1 q1); auto.
unfold Pos.compare.
generalize (Pcompare_Eq_eq p1 q1);
case (Pcompare p1 q1 Datatypes.Eq); simpl in |- *;
intros H H1; try discriminate; rewrite H; auto.
Qed.
intros x y; case x; case y; simpl in |- *; auto with zarith; intros p p0;
unfold Z.lt in |- *; simpl in |- *; unfold Pos.compare; rewrite <- ZC4;
auto.
Qed.
Hint Resolve Zlt_Zopp: zarith.
intros x y H'; case (Zle_lt_or_eq _ _ H'); auto with zarith.
Qed.
Hint Resolve Zle_Zopp: zarith.
intros n; case n; simpl in |- *; auto with arith.
intros n0; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto with arith.
Qed.
intros p; case p; simpl in |- *; auto.
Qed.
intros z; case z; simpl in |- *; auto; intros p; apply sym_equal;
apply inject_nat_convert; auto.
Qed.
intros p q; case p; case q; simpl in |- *; auto; intros p0 p1;
apply
((fun (x y : positive) (_ : positive -> positive) =>
nat_of_P_mult_morphism x y) p1 p0 (fun x => x)).
Qed.
intros m n; unfold Z.min in |- *.
case n; case m; simpl in |- *; auto; unfold Pos.compare.
intros p p0; rewrite (ZC4 p p0).
generalize (Pcompare_Eq_eq p0 p).
case (Pcompare p0 p Datatypes.Eq); simpl in |- *; auto.
intros H'; rewrite H'; auto.
intros p p0; rewrite (ZC4 p p0).
generalize (Pcompare_Eq_eq p0 p).
case (Pcompare p0 p Datatypes.Eq); simpl in |- *; auto.
intros H'; rewrite H'; auto.
Qed.
intros z; unfold Zpower_nat in |- *; simpl in |- *; auto.
Qed.
intros z; unfold Zpower_nat in |- *; simpl in |- *; rewrite Zmult_1_r; auto.
Qed.
intros z1 z2; unfold Z.le, Z.min in |- *; case (z1 ?= z2)%Z; auto; intros H;
Contradict H; auto.
Qed.
intros z1 z2 H; rewrite Zmin_sym; apply Zmin_le1; auto.
Qed.
intros z1 z2 z3 H' H'0; unfold Z.min in |- *.
case (z2 ?= z3)%Z; auto.
Qed.
intros n m.
unfold Z.pred in |- *; unfold Z.succ in |- *; ring.
Qed.
intros z; unfold Z.pred, Z.succ in |- *; ring.
Qed.
intros x y H' H'0; case (Zle_lt_or_eq _ _ H').
intros H'1; rewrite Zmult_comm; apply Zmult_gt_0_le_0_compat; auto;
apply Z.lt_gt; auto.
intros H'1; rewrite <- H'1; simpl in |- *; auto with zarith.
Qed.
Hint Resolve Zle_mult_gen: zarith.
Definition Zmax : forall x_ x_ : Z, Z :=
fun n m : Z =>
match (n ?= m)%Z with
| Datatypes.Eq => m
| Datatypes.Lt => m
| Datatypes.Gt => n
end.
intros z1 z2; unfold Zmax in |- *; CaseEq (z1 ?= z2)%Z; simpl in |- *;
auto with zarith.
unfold Z.le in |- *; intros H; rewrite H; red in |- *; intros; discriminate.
Qed.
intros z1 z2; unfold Zmax in |- *; CaseEq (z1 ?= z2)%Z; CaseEq (z2 ?= z1)%Z;
intros H1 H2; try case (Zcompare_EGAL _ _ H1); auto;
try case (Zcompare_EGAL _ _ H2); auto; Contradict H1.
case (Zcompare.Zcompare_Gt_Lt_antisym z2 z1); auto.
intros H' H'0; rewrite H'0; auto; red in |- *; intros; discriminate.
case (Zcompare.Zcompare_Gt_Lt_antisym z1 z2); auto.
intros H'; rewrite H'; auto; intros; red in |- *; intros; discriminate.
Qed.
intros z1 z2; unfold Z.le, Zmax in |- *; case (z1 ?= z2)%Z; auto.
intros H'; case H'; auto.
Qed.
intros z1 z2 H'; rewrite ZmaxSym; apply Zmax_le2; auto.
Qed.
intros z1 z2; rewrite ZmaxSym; apply ZmaxLe1.
Qed.
Hint Resolve ZmaxLe1 ZmaxLe2: zarith.
intros p q H' H'0; apply Zle_antisym; auto.
apply Zlt_succ_le; auto.
Qed.
intros z1 z2; case (Zle_or_lt z1 z2); unfold Z.le, Z.lt, Z.min, Zmax in |- *;
CaseEq (z1 ?= z2)%Z; auto; intros H1 H2; try rewrite H1;
try rewrite H2; red in |- *; intros; discriminate.
Qed.
intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith.
Qed.
intros x y z H' H'0; case (Zle_lt_or_eq _ _ H'); intros Zlt1.
apply Zmult_gt_0_le_compat_r; auto.
apply Z.lt_gt; auto.
rewrite <- Zlt1; repeat rewrite <- Zmult_0_r_reverse; auto with zarith.
Qed.
intros x y z H' H'0; repeat rewrite (Zmult_comm z);
apply Zle_Zmult_comp_r; auto.
Qed.
intros z1 z2; case z1; case z2; simpl in |- *; intros; auto; try discriminate.
Qed.
Hint Resolve NotZmultZero: zarith.
(* Conversions from R <-> Z  <-> N *)
intros p H'; rewrite H'; auto.
Qed.
Hint Resolve not_O_INR: real.
intros p; case p; simpl in |- *; auto.
intros p1 H'; Contradict H'; auto with real zarith.
intros p1 H'; absurd (INR (nat_of_P p1) = 0%R); auto with real zarith.
rewrite <- (Ropp_involutive (INR (nat_of_P p1))).
unfold IZR in H'; rewrite <- INR_IPR in H'.
rewrite H'; auto with real.
Qed.
intros n m H'; elim H'; auto.
replace (INR n) with (INR n + 0)%R; auto with real; rewrite S_INR;
auto with real.
intros m0 H'0 H'1.
replace (INR n) with (INR n + 0)%R; auto with real; rewrite S_INR;
auto with real.
Qed.
Hint Resolve INR_lt_nm: real.
replace 1%R with (INR 1); auto with real.
Qed.
Hint Resolve Rlt_INR1: real.
intros n m H'; (case (le_or_lt n m); intros H'1).
case (le_lt_or_eq _ _ H'1); intros H'2.
apply Rlt_dichotomy_converse; auto with real.
Contradict H'; auto.
apply Compare.not_eq_sym; apply Rlt_dichotomy_converse; auto with real.
Qed.
Hint Resolve NEq_INR: real.
replace 0%R with (INR 0); auto with real.
Qed.
Hint Resolve NEq_INRO: real.
replace 1%R with (INR 1); auto with real.
Qed.
Hint Resolve NEq_INR1: real.
intros n; elim n; simpl in |- *; auto with arith.
Qed.
Hint Resolve not_O_lt: arith.
intros n H; Contradict H.
apply IZR_zero_r; auto.
Qed.
Hint Resolve NEq_IZRO: real.
intros p q H; case (Rle_or_lt (IZR q) (IZR p)); auto.
intros H1; Contradict H; apply Zle_not_lt.
apply le_IZR; auto.
Qed.
Hint Resolve Rlt_IZR: real.
intros x y H'.
case (Zle_lt_or_eq _ _ H'); clear H'; intros H'.
apply Rlt_le; auto with real.
rewrite <- H'; auto with real.
Qed.
Hint Resolve Rle_IZR: real.
intros p H; replace 0%R with (IZR 0); auto with real.
Qed.
Hint Resolve Rlt_IZRO: real.
intros; replace 0%R with (IZR 0); auto with real.
Qed.
Hint Resolve Rle_IZRO: real.
intros; replace 1%R with (IZR 1); auto with real.
Qed.
Hint Resolve Rlt_IZR1: real.
intros; replace 1%R with (IZR 1); auto with real.
Qed.
Hint Resolve Rle_IZR1: real.
intros n m H'; case (le_or_lt m n); auto; intros H0; Contradict H';
auto with real.
case (le_lt_or_eq _ _ H0); intros H1; auto with real.
rewrite H1; apply Rlt_irrefl.
Qed.
intros n; elim n; auto; try rewrite S_INR.
intros m; case m; auto.
intros m' H1; Contradict H1; auto.
rewrite S_INR.
apply Rlt_dichotomy_converse; left.
apply Rle_lt_0_plus_1.
apply pos_INR.
intros n' H' m; case m.
intros H'0; Contradict H'0; auto.
rewrite S_INR.
apply Rlt_dichotomy_converse; right.
red in |- *; apply Rle_lt_0_plus_1.
apply pos_INR.
intros m' H'0.
rewrite (H' m'); auto.
repeat rewrite S_INR in H'0.
apply Rplus_eq_reg_l with (r := 1%R); repeat rewrite (Rplus_comm 1);
auto with real.
Qed.
intros x y H; repeat rewrite INR_IZR_INZ.
apply Rle_IZR; auto with zarith.
Qed.
Hint Resolve Rle_INR: real.
intros n m H'; case H'; auto.
intros H'0; apply lt_le_weak; apply lt_Rlt; auto.
intros H'0; rewrite <- (INR_inv _ _ H'0); auto with arith.
Qed.
intros z t; case z; case t; simpl in |- *; auto with real; unfold IZR; intros t1 z1; repeat rewrite <- INR_IPR.
- rewrite nat_of_P_mult_morphism; auto with real.
- rewrite nat_of_P_mult_morphism; auto with real.
rewrite Rmult_comm.
rewrite Ropp_mult_distr_l_reverse; auto with real.
apply Ropp_eq_compat; rewrite mult_comm; auto with real.
- rewrite nat_of_P_mult_morphism; auto with real.
rewrite Ropp_mult_distr_l_reverse; auto with real.
- rewrite nat_of_P_mult_morphism; auto with real.
rewrite Rmult_opp_opp; auto with real.
Qed.
intros z; case z.
3: intros p H'; Contradict H'; auto with zarith.
replace (Z.succ 0) with (Z_of_nat 1).
intros H'; rewrite absolu_INR; simpl in |- *; auto.
simpl in |- *; auto.
intros p H'; rewrite <- Zpos_succ_morphism; simpl in |- *; auto with zarith.
unfold nat_of_P in |- *; rewrite Pmult_nat_succ_morphism; auto.
Qed.
Hint Resolve Zlt_le_succ: zarith.
intros n m H'; case (Zle_lt_or_eq (Z.succ n) m); auto with zarith.
Qed.
intros n m H'; case (Zle_lt_or_eq _ _ H'); auto with zarith.
Qed.
intros x y H'; case (Zle_or_lt x y); auto with zarith.
Qed.
intros p q H'; case (Zle_lt_or_eq _ _ H'); auto with zarith.
Qed.
intros z H'; apply inject_nat_eq.
rewrite inj_S.
repeat rewrite <- (absolu_Zopp (Z.succ z)).
repeat rewrite <- (absolu_Zopp z).
repeat rewrite inj_abs; replace 0%Z with (- (0))%Z; auto with zarith.
Qed.
intros x n; case x; simpl in |- *; auto with zarith.
replace 0%Z with (Z_of_nat 0); auto with zarith.
intros p; rewrite <- (inject_nat_convert (Zpos p) p); auto with zarith.
case n; simpl in |- *; intros; red in |- *; simpl in |- *; auto.
Qed.
intros n; case n; auto.
intros H'; Contradict H'; auto.
intros n0 H'; rewrite inj_S; rewrite <- Zpred_succ; auto.
Qed.
intros p; case p; simpl in |- *; auto with zarith; intros q;
rewrite inject_nat_convert with (p := Zpos q);
auto with zarith.
unfold Z.le in |- *; red in |- *; intros H'2; discriminate.
Qed.
Hint Resolve Zle_abs: zarith.
intros z n H' H'0; case (le_or_lt (Z.abs_nat z) n); auto; intros lt.
case (Zle_or_lt 0 z); intros Zle0.
Contradict H'0.
apply Zlt_not_le; auto.
rewrite <- (inj_abs z); auto with zarith.
Contradict H'.
apply Zlt_not_le; auto.
replace z with (- Z_of_nat (Z.abs_nat z))%Z.
apply Zlt_Zopp; auto with zarith.
rewrite <- absolu_Zopp.
rewrite inj_abs; auto with zarith.
Qed.
intros n m H'; case (le_or_lt n m); auto.
intros H'0.
case (le_lt_or_eq _ _ H'0); auto with zarith.
intros H'1.
Contradict H'.
apply Zle_not_lt; auto with zarith.
Qed.
intros p; elim p; unfold nat_of_P in |- *; simpl in |- *.
intros p0 H'; red in |- *; intros H'0; discriminate.
intros p0; rewrite ZL6; unfold nat_of_P in |- *.
case (Pmult_nat p0 1); simpl in |- *; auto.
red in |- *; intros H'; discriminate.
Qed.
Hint Resolve NconvertO: zarith.
intros z; case z; simpl in |- *; auto; try (intros H'; case H'; auto; fail);
intros p; generalize (NconvertO p); auto with arith.
Qed.
replace 0%R with (INR 0); auto with real arith.
Qed.
Hint Resolve Rlt2: real.
apply Rmult_lt_reg_l with (r := INR 2); auto with real.
Qed.
Hint Resolve RlIt2: real.
intros r H'.
replace (INR 2 * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ].
pattern r at 1 in |- *; replace r with (r + 0)%R; [ idtac | ring ].
apply Rplus_le_compat_l; auto.
Qed.
intros r H'.
pattern r at 1 in |- *; replace r with (r + 0)%R; try ring.
replace (INR 2 * r)%R with (r + r)%R; simpl in |- *; try ring; auto with real.
Qed.

Theorem Rlt_RinvDouble : forall r : R, (0 < r)%R -> (/ INR 2 * r < r)%R.