pax_global_header00006660000000000000000000000064135712717560014530gustar00rootroot0000000000000052 comment=a4b445bad8b8d0afb725d64472b194d234676ce0 float-8.10.0/000077500000000000000000000000001357127175600127235ustar00rootroot00000000000000float-8.10.0/.gitignore000066400000000000000000000000071357127175600147100ustar00rootroot00000000000000tags.f float-8.10.0/AllFloat.v000066400000000000000000000000721357127175600146070ustar00rootroot00000000000000Require Export ClosestMult. Require Export Closest2Plus. float-8.10.0/Closest.v000066400000000000000000000551731357127175600145410ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Closest Laurent Thery ***************************************************************************** Properties about the closest rounding mode *) Require Export Fround. Section Fclosest. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Hypothesis precisionGreaterThanOne : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Definition Closest (r : R) (p : float) := Fbounded b p /\ (forall f : float, Fbounded b f -> (Rabs (p - r) <= Rabs (f - r))%R). Theorem ClosestTotal : TotalP Closest. red in |- *; intros r. case MinEx with (r := r) (3 := pGivesBound); auto with arith. intros min H'. case MaxEx with (r := r) (3 := pGivesBound); auto with arith. intros max H'0. cut (min <= r)%R; [ intros Rl1 | apply isMin_inv1 with (1 := H') ]. cut (r <= max)%R; [ intros Rl2 | apply isMax_inv1 with (1 := H'0) ]. case (Rle_or_lt (Rabs (min - r)) (Rabs (max - r))); intros H'1. exists min; split. case H'; auto. intros f H'2. case (Rle_or_lt f r); intros H'3. repeat rewrite Faux.Rabsolu_left1. apply Ropp_le_contravar; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. elim H'; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rle_trans with (1 := H'1). repeat rewrite Rabs_right. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. elim H'0; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rlt_le; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r. apply Rlt_le; auto. repeat rewrite Rplus_minus; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. exists max; split. case H'0; auto. intros f H'2. case (Rle_or_lt f r); intros H'3. apply Rle_trans with (1 := Rlt_le _ _ H'1). repeat rewrite Faux.Rabsolu_left1. apply Ropp_le_contravar; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. elim H'; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. repeat rewrite Rabs_right; auto with real. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. elim H'0; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rlt_le; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rlt_le; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. Qed. Theorem ClosestCompatible : CompatibleP b radix Closest. red in |- *; simpl in |- *. intros r1 r2 p q H'; case H'. intros H'0 H'1 H'2 H'3 H'4. split; auto. intros f H'5. unfold FtoRradix in |- *; rewrite <- H'3; rewrite <- H'2; auto. Qed. Theorem ClosestMin : forall (r : R) (min max : float), isMin b radix r min -> isMax b radix r max -> (2%nat * r <= min + max)%R -> Closest r min. intros r min max H' H'0 H'1; split. case H'; auto. intros f H'2. case (Rle_or_lt f r); intros H'3. repeat rewrite Faux.Rabsolu_left1. apply Ropp_le_contravar. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. case H'; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMin_inv1 with (1 := H'); auto. rewrite (Faux.Rabsolu_left1 (min - r)). rewrite (Rabs_right (f - r)). apply Rle_trans with (max - r)%R. cut (forall x y : R, (- y + x)%R = (- (y - x))%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. cut (forall x y : R, (- (x - y))%R = (y - x)%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; unfold Rminus in |- *; ring ]. apply Rplus_le_reg_l with (r := FtoR radix min). repeat rewrite Rplus_minus; auto. apply Rplus_le_reg_l with (r := r). replace (r + (FtoR radix min + (max - r)))%R with (min + max)%R. replace (r + r)%R with (2%nat * r)%R; auto. simpl in |- *; ring. simpl in |- *; fold FtoRradix; ring. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. case H'0; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rlt_le; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rlt_le; auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMin_inv1 with (1 := H'); auto. Qed. Theorem ClosestMax : forall (r : R) (min max : float), isMin b radix r min -> isMax b radix r max -> (min + max <= 2%nat * r)%R -> Closest r max. intros r min max H' H'0 H'1; split. case H'0; auto. intros f H'2. case (Rle_or_lt f r); intros H'3. rewrite (Rabs_right (max - r)). rewrite (Faux.Rabsolu_left1 (f - r)). apply Rle_trans with (r - min)%R. apply Rplus_le_reg_l with (r := FtoRradix min). repeat rewrite Rplus_minus; auto. apply Rplus_le_reg_l with (r := r). replace (r + (min + (max - r)))%R with (min + max)%R. replace (r + r)%R with (2%nat * r)%R; auto. simpl in |- *; ring. simpl in |- *; ring. replace (r - min)%R with (- (min - r))%R. apply Ropp_le_contravar. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. case H'; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. simpl in |- *; ring. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMax_inv1 with (1 := H'0); auto. repeat rewrite Rabs_right. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. case H'0; auto. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply Rlt_le; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rlt_le; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMax_inv1 with (1 := H'0); auto. Qed. Theorem ClosestMinOrMax : MinOrMaxP b radix Closest. red in |- *. intros r p H'. case (Rle_or_lt p r); intros H'1. left; split; auto. case H'; auto. split; auto. intros f H'0 H'2. apply Rplus_le_reg_l with (r := (- r)%R). cut (forall x y : R, (- y + x)%R = (- (y - x))%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. apply Ropp_le_contravar. rewrite <- (Rabs_right (r - FtoR radix p)). rewrite <- (Rabs_right (r - FtoR radix f)). cut (forall x y : R, Rabs (x - y) = Rabs (y - x)); [ intros Eq0; repeat rewrite (Eq0 r); clear Eq0 | intros x y; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr ]; auto. elim H'; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix f). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix p). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. right; split; auto. case H'; auto. split; auto. apply Rlt_le; auto. intros f H'0 H'2. apply Rplus_le_reg_l with (r := (- r)%R). cut (forall x y : R, (- y + x)%R = (- (y - x))%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. rewrite <- (Faux.Rabsolu_left1 (r - FtoR radix p)). rewrite <- (Faux.Rabsolu_left1 (r - FtoR radix f)). cut (forall x y : R, Rabs (x - y) = Rabs (y - x)); [ intros Eq0; repeat rewrite (Eq0 r); clear Eq0 | intros x y; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr ]; auto. elim H'; auto. apply Rplus_le_reg_l with (r := FtoR radix f). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rplus_le_reg_l with (r := FtoR radix p). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rlt_le; auto. Qed. Theorem ClosestMinEq : forall (r : R) (min max p : float), isMin b radix r min -> isMax b radix r max -> (2%nat * r < min + max)%R -> Closest r p -> p = min :>R. intros r min max p H' H'0 H'1 H'2. case (ClosestMinOrMax r p); auto; intros H'3. unfold FtoRradix in |- *; apply MinEq with (1 := H'3); auto. absurd (Rabs (max - r) <= Rabs (min - r))%R. apply Rgt_not_le. rewrite (Faux.Rabsolu_left1 (min - r)). rewrite Rabs_right. replace (- (min - r))%R with (r - min)%R; [ idtac | ring ]. red in |- *; apply Rplus_lt_reg_l with (r := FtoRradix min). repeat rewrite Rplus_minus; auto. apply Rplus_lt_reg_l with (r := r). replace (r + r)%R with (2%nat * r)%R; [ idtac | simpl in |- *; ring ]. replace (r + (min + (max - r)))%R with (min + max)%R; [ idtac | ring ]; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMax_inv1 with (1 := H'0); auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMin_inv1 with (1 := H'); auto. cut (Closest r max). intros H'4; case H'4. intros H'5 H'6; apply H'6; auto. case H'; auto. apply ClosestCompatible with (1 := H'2); auto. apply MaxEq with (1 := H'3); auto. case H'0; auto. Qed. Theorem ClosestMaxEq : forall (r : R) (min max p : float), isMin b radix r min -> isMax b radix r max -> (min + max < 2%nat * r)%R -> Closest r p -> p = max :>R. intros r min max p H' H'0 H'1 H'2. case (ClosestMinOrMax r p); auto; intros H'3. 2: unfold FtoRradix in |- *; apply MaxEq with (1 := H'3); auto. absurd (Rabs (min - r) <= Rabs (max - r))%R. apply Rgt_not_le. rewrite (Faux.Rabsolu_left1 (min - r)). rewrite Rabs_right. replace (- (min - r))%R with (r - min)%R; [ idtac | ring ]. red in |- *; apply Rplus_lt_reg_l with (r := FtoRradix min). repeat rewrite Rplus_minus; auto. apply Rplus_lt_reg_l with (r := r). replace (r + r)%R with (2%nat * r)%R; [ idtac | simpl in |- *; ring ]. replace (r + (min + (max - r)))%R with (min + max)%R; [ idtac | ring ]; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMax_inv1 with (1 := H'0); auto. apply Rplus_le_reg_l with (r := r). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply isMin_inv1 with (1 := H'); auto. cut (Closest r min). intros H'4; case H'4. intros H'5 H'6; apply H'6; auto. case H'0; auto. apply ClosestCompatible with (1 := H'2); auto. apply MinEq with (1 := H'3); auto. case H'; auto. Qed. Theorem ClosestMonotone : MonotoneP radix Closest. red in |- *; simpl in |- *. intros p q p' q' H' H'0 H'1. change (p' <= q')%R in |- *. case (Rle_or_lt p p'); intros Rl0. case (Rle_or_lt p q'); intros Rl1. apply Rplus_le_reg_l with (r := (- p)%R). cut (forall x y : R, (- y + x)%R = (- (y - x))%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. rewrite <- (Faux.Rabsolu_left1 (p - p')). rewrite <- (Faux.Rabsolu_left1 (p - q')). cut (forall x y : R, Rabs (x - y) = Rabs (y - x)); [ intros Eq0; repeat rewrite (Eq0 p); clear Eq0 | intros x y; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr ]; auto. elim H'0; auto. intros H'2 H'3; apply H'3; auto. case H'1; auto. apply Rplus_le_reg_l with (r := FtoR radix q'). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rplus_le_reg_l with (r := FtoR radix p'). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. case (Rle_or_lt p' q); intros Rl2. apply Rplus_le_reg_l with (r := (- q)%R). cut (forall x y : R, (- y + x)%R = (- (y - x))%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. rewrite <- (Rabs_right (q - p')). 2: apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix p'). 2: repeat rewrite Rplus_minus; auto. 2: rewrite Rplus_0_r; auto. rewrite <- (Rabs_right (q - q')). 2: apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix q'). 2: repeat rewrite Rplus_minus; auto. 2: rewrite Rplus_0_r; auto. 2: apply Rle_trans with (1 := Rlt_le _ _ Rl1); apply Rlt_le; auto. cut (forall x y : R, Rabs (x - y) = Rabs (y - x)); [ intros Eq0; repeat rewrite (Eq0 q); clear Eq0 | intros x y; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr ]; auto. apply Ropp_le_contravar. elim H'1; auto. intros H'2 H'3; apply H'3; auto. case H'0; auto. case (Rle_or_lt (p - q') (p' - q)); intros Rl3. absurd (Rabs (p' - p) <= Rabs (q' - p))%R. apply Rgt_not_le. rewrite (Faux.Rabsolu_left1 (q' - p)). 2: apply Rplus_le_reg_l with (r := p). 2: repeat rewrite Rplus_minus; auto. 2: rewrite Rplus_0_r; apply Rlt_le; auto. rewrite (Rabs_right (p' - p)). 2: apply Rle_ge; apply Rplus_le_reg_l with (r := p). 2: rewrite Rplus_0_r; auto. cut (forall x y : R, (- (y - x))%R = (x - y)%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. red in |- *; apply Rle_lt_trans with (1 := Rl3). replace (p' - p)%R with (p' - q + (q - p))%R. pattern (p' - q)%R at 1 in |- *; replace (p' - q)%R with (p' - q + 0)%R. apply Rplus_lt_compat_l; auto. apply Rplus_lt_reg_l with (r := p). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. rewrite Rplus_0_r; auto. ring. replace (p + (p' - p))%R with (FtoRradix p'); auto; ring. case H'0; intros H'2 H'3; apply H'3; auto. case H'1; auto. absurd (Rabs (q' - q) <= Rabs (p' - q))%R. apply Rgt_not_le. rewrite (Faux.Rabsolu_left1 (q' - q)). 2: apply Rplus_le_reg_l with (r := q). 2: repeat rewrite Rplus_minus; auto. 2: rewrite Rplus_0_r; apply Rlt_le; auto. 2: apply Rlt_trans with (1 := Rl1); auto. rewrite (Rabs_right (p' - q)). 2: apply Rle_ge; apply Rplus_le_reg_l with (r := q). 2: rewrite Rplus_0_r; apply Rlt_le; auto. cut (forall x y : R, (- (y - x))%R = (x - y)%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. red in |- *; apply Rlt_trans with (1 := Rl3). replace (q - q')%R with (p - q' + (q - p))%R. pattern (p - q')%R at 1 in |- *; replace (p - q')%R with (p - q' + 0)%R. apply Rplus_lt_compat_l; auto. apply Rplus_lt_reg_l with (r := p). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. rewrite Rplus_0_r; auto. ring. replace (q + (p' - q))%R with (FtoRradix p'); auto; ring. case H'1; intros H'2 H'3; apply H'3; auto. case H'0; auto. case (Rle_or_lt p q'); intros Rl1. apply Rle_trans with p; auto. apply Rlt_le; auto. apply Rplus_le_reg_l with (r := (- q)%R). cut (forall x y : R, (- y + x)%R = (- (y - x))%R); [ intros Eq0; repeat rewrite Eq0; clear Eq0 | intros; ring ]. rewrite <- (Rabs_right (q - p')). rewrite <- (Rabs_right (q - q')). apply Ropp_le_contravar. cut (forall x y : R, Rabs (x - y) = Rabs (y - x)); [ intros Eq0; repeat rewrite (Eq0 q); clear Eq0 | intros x y; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr ]; auto. elim H'1; auto. intros H'2 H'3; apply H'3; auto. case H'0; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix q'). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rlt_le; apply Rlt_trans with (1 := Rl1); auto. apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix p'). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; auto. apply Rlt_le; apply Rlt_trans with (1 := Rl0); auto. Qed. Theorem ClosestRoundedModeP : RoundedModeP b radix Closest. split; try exact ClosestTotal. split; try exact ClosestCompatible. split; try exact ClosestMinOrMax. try exact ClosestMonotone. Qed. Definition EvenClosest (r : R) (p : float) := Closest r p /\ (FNeven b radix precision p \/ (forall q : float, Closest r q -> q = p :>R)). Theorem EvenClosestTotal : TotalP EvenClosest. red in |- *; intros r. case MinEx with (r := r) (3 := pGivesBound); auto with arith. intros min H'. case MaxEx with (r := r) (3 := pGivesBound); auto with arith. intros max H'0. cut (min <= r)%R; [ intros Rl1 | apply isMin_inv1 with (1 := H'); auto ]. cut (r <= max)%R; [ intros Rl2 | apply isMax_inv1 with (1 := H'0) ]. case (Rle_or_lt (r - min) (max - r)); intros H'1. case H'1; intros H'2; auto. exists min; split. apply ClosestMin with (max := max); auto. replace (2%nat * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ]. apply Rminus_le; auto. replace (r + r - (min + max))%R with (r - min - (max - r))%R; [ idtac | simpl in |- *; ring ]. apply Rle_minus; auto. right; intros q H'3. apply ClosestMinEq with (r := r) (max := max); auto. replace (2%nat * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ]. apply Rminus_lt; auto. replace (r + r - (min + max))%R with (r - min - (max - r))%R; [ idtac | simpl in |- *; ring ]. apply Rlt_minus; auto. case (FNevenOrFNodd b radix precision min); intros Ev0. exists min; split; auto. apply ClosestMin with (max := max); auto. replace (2%nat * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ]. apply Rminus_le; auto. replace (r + r - (min + max))%R with (r - min - (max - r))%R; [ idtac | simpl in |- *; ring ]. apply Rle_minus; auto. exists max; split; auto. apply ClosestMax with (min := min); auto. replace (2%nat * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ]. apply Rminus_le; auto. replace (min + max - (r + r))%R with (max - r - (r - min))%R; [ idtac | simpl in |- *; ring ]. apply Rle_minus; auto. rewrite H'2; auto with real. case (Req_dec min max); intros H'5. right; intros q H'3. case (ClosestMinOrMax _ _ H'3); intros isM0. rewrite <- H'5. apply MinEq with (1 := isM0); auto. apply MaxEq with (1 := isM0); auto. left. apply FNevenEq with (f1 := FNSucc b radix precision min); auto. apply FcanonicBound with (radix := radix). apply FNSuccCanonic; auto with arith. case H'; auto. case H'0; auto. apply MaxEq with (b := b) (r := r); auto. apply MinMax; auto with arith. Contradict H'5; auto. fold FtoRradix in H'5; rewrite H'5 in H'2. replace (FtoRradix max) with (min + (max - min))%R; [ rewrite <- H'2 | idtac ]; ring. apply FNoddSuc; auto. case H'; auto. exists max; split; auto. apply ClosestMax with (min := min); auto. replace (2%nat * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ]. apply Rminus_le; auto. replace (min + max - (r + r))%R with (max - r - (r - min))%R; [ idtac | simpl in |- *; ring ]. apply Rle_minus; auto with real. right; intros q H'2. apply ClosestMaxEq with (r := r) (min := min); auto. replace (2%nat * r)%R with (r + r)%R; [ idtac | simpl in |- *; ring ]. apply Rminus_lt; auto. replace (min + max - (r + r))%R with (max - r - (r - min))%R; [ idtac | simpl in |- *; ring ]. apply Rlt_minus; auto. Qed. Theorem EvenClosestCompatible : CompatibleP b radix EvenClosest. red in |- *; simpl in |- *. intros r1 r2 p q H' H'0 H'1 H'2; red in |- *. inversion H'. split. apply (ClosestCompatible r1 r2 p q); auto. case H0; intros H1. left. apply FNevenEq with (f1 := p); auto. case H; auto. right; intros q0 H'3. unfold FtoRradix in |- *; rewrite <- H'1; auto. apply H1; auto. apply (ClosestCompatible r2 r1 q0 q0); auto. case H'3; auto. Qed. Theorem EvenClosestMinOrMax : MinOrMaxP b radix EvenClosest. red in |- *; intros r p H'; case (ClosestMinOrMax r p); auto. case H'; auto. Qed. Theorem EvenClosestMonotone : MonotoneP radix EvenClosest. red in |- *; simpl in |- *; intros p q p' q' H' H'0 H'1. apply (ClosestMonotone p q); auto; case H'0; case H'1; auto. Qed. Theorem EvenClosestRoundedModeP : RoundedModeP b radix EvenClosest. red in |- *; split. exact EvenClosestTotal. split. exact EvenClosestCompatible. split. exact EvenClosestMinOrMax. exact EvenClosestMonotone. Qed. Theorem EvenClosestUniqueP : UniqueP radix EvenClosest. red in |- *; simpl in |- *. intros r p q H' H'0. inversion H'; inversion H'0; case H0; case H2; auto. intros H'1 H'2; case (EvenClosestMinOrMax r p); case (EvenClosestMinOrMax r q); auto. intros H'3 H'4; apply (MinUniqueP b radix r); auto. intros H'3 H'4; case (Req_dec p q); auto; intros H'5. Contradict H'1; auto. apply FnOddNEven; auto. apply FNoddEq with (f1 := FNSucc b radix precision p); auto. apply FcanonicBound with (radix := radix); auto. apply FNSuccCanonic; auto with arith. case H'4; auto. case H'3; auto. apply (MaxUniqueP b radix r); auto. apply MinMax; auto with arith. Contradict H'5; auto. apply (RoundedProjector b radix _ (MaxRoundedModeP _ _ _ radixMoreThanOne precisionGreaterThanOne pGivesBound)); auto. case H'4; auto. rewrite <- H'5; auto. apply FNevenSuc; auto. case H'4; auto. intros H'3 H'4; case (Req_dec p q); auto; intros H'5. Contradict H'2; auto. apply FnOddNEven; auto. apply FNoddEq with (f1 := FNSucc b radix precision q); auto. apply FcanonicBound with (radix := radix); auto. apply FNSuccCanonic; auto with arith. case H'3; auto. case H'4; auto. apply (MaxUniqueP b radix r); auto. apply MinMax; auto with arith. Contradict H'5; auto. apply sym_eq; apply (RoundedProjector b radix _ (MaxRoundedModeP _ _ _ radixMoreThanOne precisionGreaterThanOne pGivesBound)); auto. case H'3; auto. rewrite <- H'5; auto. apply FNevenSuc; auto. case H'3; auto. intros H'3 H'4; apply (MaxUniqueP b radix r); auto. intros H'1 H'2; apply sym_eq; auto. Qed. Theorem ClosestSymmetric : SymmetricP Closest. red in |- *; intros r p H'; case H'; clear H'. intros H' H'0; split. apply oppBounded; auto. intros f H'1. replace (Rabs (Fopp p - - r)) with (Rabs (p - r)). replace (Rabs (f - - r)) with (Rabs (Fopp f - r)). apply H'0; auto. apply oppBounded; auto. unfold FtoRradix in |- *; rewrite Fopp_correct. pattern r at 1 in |- *; replace r with (- - r)%R; [ idtac | ring ]. replace (- FtoR radix f - - - r)%R with (- (FtoR radix f - - r))%R; [ idtac | ring ]. apply Rabs_Ropp; auto. unfold FtoRradix in |- *; rewrite Fopp_correct. replace (- FtoR radix p - - r)%R with (- (FtoR radix p - r))%R; [ idtac | ring ]. apply sym_eq; apply Rabs_Ropp. Qed. Theorem EvenClosestSymmetric : SymmetricP EvenClosest. red in |- *; intros r p H'; case H'; clear H'. intros H' H'0; case H'0; clear H'0; intros H'0. split; auto. apply (ClosestSymmetric r p); auto. left. apply FNevenFop; auto. split; auto. apply (ClosestSymmetric r p); auto. right. intros q H'1. cut (Fopp q = p :>R). intros H'2; unfold FtoRradix in |- *; rewrite Fopp_correct. unfold FtoRradix in H'2; rewrite <- H'2. rewrite Fopp_correct; ring. apply H'0; auto. replace r with (- - r)%R; [ idtac | ring ]. apply (ClosestSymmetric (- r)%R q); auto. Qed. End Fclosest. Hint Resolve ClosestTotal ClosestCompatible ClosestMin ClosestMax ClosestMinOrMax ClosestMonotone ClosestRoundedModeP EvenClosestTotal EvenClosestCompatible EvenClosestMinOrMax EvenClosestMonotone EvenClosestRoundedModeP FnOddNEven EvenClosestUniqueP ClosestSymmetric EvenClosestSymmetric: float.float-8.10.0/Closest2Plus.v000066400000000000000000000237271357127175600154670ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Closest2Plus Laurent Thery ******************************************************************************) Require Export ClosestPlus. Require Export Closest2Prop. Section F2. Variable b : Fbound. Variable precision : nat. Let radix := 2%Z. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Theorem TwoMoreThanOne : (1 < radix)%Z. red in |- *; simpl in |- *; auto. Qed. Hint Resolve TwoMoreThanOne. Hypothesis precisionNotZero : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem plusUpperBound : forall P, RoundedModeP b 2%nat P -> forall p q pq : float, P (p + q)%R pq -> Fbounded b p -> Fbounded b q -> (Rabs pq <= radix * Rmax (Rabs p) (Rabs q))%R. intros P H' p q pq H'0 H'1 H'2. rewrite <- (Rabs_right radix); auto with real zarith. rewrite <- RmaxRmult; auto with real. repeat rewrite <- Rabs_mult. case (Rle_or_lt p q); intros Rltp. apply RmaxAbs; auto. apply (RoundedModeMultLess b radix) with (P := P) (r := (p + q)%R); auto. replace (radix * FtoR radix p)%R with (p + p)%R; [ auto with real | unfold radix at 1; fold FtoRradix; ring]. unfold FtoRradix in |- *; apply (RoundedModeMult b radix) with (P := P) (r := (p + q)%R); auto. replace (radix * FtoR radix q)%R with (q + q)%R; [ auto with real | unfold radix at 1; fold FtoRradix; ring ]. rewrite RmaxSym. apply RmaxAbs; auto. apply (RoundedModeMultLess b radix) with (P := P) (r := (p + q)%R); auto. replace (radix * FtoR radix q)%R with (q + q)%R; [ auto with real | unfold radix at 1; fold FtoRradix; ring ]. unfold FtoRradix in |- *; apply (RoundedModeMult b radix) with (P := P) (r := (p + q)%R); auto. replace (radix * FtoR radix p)%R with (p + p)%R; [ auto with real zarith | unfold radix at 1; fold FtoRradix; ring]. Qed. Theorem plusErrorBound2 : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> ~ is_Fzero r -> (Rabs (r - (p + q)) < radix * / pPred (vNum b) * Rmax (Rabs p) (Rabs q))%R. intros p q r H' H'0 H'1 H'2. apply Rlt_le_trans with (Rabs (FtoR radix r) * / radix * (radix * / pPred (vNum b)))%R; auto. unfold FtoRradix in |- *; apply plusErrorBound1 with (precision := precision); auto with arith. replace (Rabs (FtoR radix r) * / radix * (radix * / pPred (vNum b)))%R with (radix * / pPred (vNum b) * (Rabs r * / radix))%R; [ idtac | fold FtoRradix; ring ]. apply Rmult_le_compat_l; auto. replace 0%R with (radix * 0)%R; [ apply Rmult_le_compat_l | ring ]. cut (0 <= radix)%Z; auto with real zarith. apply Rlt_le; apply Rinv_0_lt_compat; cut (0 < pPred (vNum b))%Z; auto with real zarith. unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *. apply vNumbMoreThanOne with (radix := radix) (precision := precision); auto with real arith. apply Rmult_le_reg_l with (r := IZR radix); auto with real. rewrite (Rmult_comm (Rabs r)); rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real zarith; rewrite Rmult_1_l. apply plusUpperBound with (P := Closest b radix); auto. apply ClosestRoundedModeP with (precision := precision); auto. Qed. Theorem plusClosestLowerBoundAux1 : forall p q pq : float, (Rabs q <= p)%R -> Closest b radix (p + q) pq -> Fbounded b p -> Fbounded b q -> pq <> (p + q)%R :>R -> (/ radix * p <= pq)%R. intros p q pq H' H'0 H'1 H'2 H'3. cut (0 <= p)%R; [ intros Rl0; Casec Rl0; intros H0 | apply Rle_trans with (2 := H'); auto with real ]. apply (FmultRadixInv b radix precision) with (5 := H'0); auto. case (Rle_or_lt 0 q); intros Rl0. apply Rlt_le_trans with (FtoRradix p); auto. apply Rlt_RinvDouble; auto. pattern (FtoRradix p) at 1 in |- *; replace (FtoRradix p) with (p + 0)%R; auto with real. apply Rmult_lt_reg_l with (r := IZR radix); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r. rewrite Rmult_plus_distr_l. rewrite Rmult_1_l. apply Rplus_lt_reg_l with (r := (- (radix * p))%R). replace (- (radix * p) + FtoR radix p)%R with (- p)%R; [ idtac | unfold radix at 1; unfold FtoRradix; ring]. replace (- (radix * p) + (radix * p + radix * q))%R with (radix * q)%R; [ idtac | simpl in |- *; ring ]. rewrite <- (Ropp_involutive (radix * q)); apply Ropp_lt_contravar. replace (- (radix * q))%R with (radix * - q)%R; [ idtac | ring ]. case (Rle_or_lt (FtoRradix p) (radix * - q)); auto. intros H'4; Contradict H'3. rewrite <- (Fplus_correct radix); auto. unfold FtoRradix in |- *; apply sym_eq; apply ClosestIdem with (b := b); auto. replace (Fplus radix p q) with (Fminus radix p (Fopp q)). rewrite <- Fopp_Fminus. apply oppBounded; auto. apply Sterbenz; auto. apply oppBounded; auto. apply Rmult_le_reg_l with (r := IZR radix); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r. rewrite Rmult_1_l; rewrite Fopp_correct; auto. replace 0%R with (INR 0); auto with real arith. apply Rle_trans with (FtoR 2%nat p); auto with real. rewrite Fopp_correct; auto. rewrite <- Faux.Rabsolu_left1; auto. apply Rlt_le; auto. unfold Fminus in |- *; rewrite Fopp_Fopp; auto. apply (ClosestCompatible b radix (p + q)%R (FtoR radix (Fplus radix p q)) pq pq); auto. apply sym_eq; unfold FtoRradix in |- *; apply Fplus_correct; auto. apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. apply ClosestRoundedModeP with (precision := precision); auto. replace 0%R with (INR 0); auto with real arith. rewrite <- H0; rewrite Rmult_0_r. replace (FtoRradix pq) with (FtoRradix p); auto. rewrite <- H0; auto with real. unfold FtoRradix in |- *; apply ClosestIdem with (b := b); auto. apply (ClosestCompatible b radix (p + q)%R (FtoR radix p) pq pq); auto. replace (FtoR 2%nat p) with (FtoRradix p); auto. fold FtoRradix; rewrite <- H0; replace (FtoRradix q) with 0%R; try ring. generalize H'; unfold Rabs in |- *; case (Rcase_abs q); auto. intros H'4 H'5; Contradict H'5; rewrite <- H0; auto with real. apply Rlt_not_le; auto with real. intros H'4 H'5; apply Rle_antisym; auto with real. rewrite H0; auto. apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. apply ClosestRoundedModeP with (precision := precision); auto. Qed. Theorem plusClosestLowerBoundAux2 : forall p q pq : float, Closest b radix (p + q) pq -> Fbounded b p -> Fbounded b q -> pq <> (p + q)%R :>R -> (Rabs p <= Rabs q)%R -> (/ radix * Rabs q <= Rabs pq)%R. intros p q pq H' H'0 H'1 H'2 H'3. cut (Fbounded b pq); [ intros Fb0 | apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto; apply ClosestRoundedModeP with (precision := precision) ]; auto. case (Rle_or_lt 0 q); intros Rl2; [ idtac | cut (q <= 0)%R; [ intros Rl2' | apply Rlt_le; auto ] ]. repeat rewrite Rabs_right; auto with real. apply plusClosestLowerBoundAux1 with (q := p); auto. rewrite <- (Rabs_right q); auto with real. apply (ClosestCompatible b radix (p + q)%R (q + p)%R pq pq); auto; try ring. rewrite Rplus_comm; auto with real. apply Rle_ge; unfold FtoRradix in |- *; apply RleRoundedR0 with (b := b) (precision := precision) (P := Closest b radix) (r := (p + q)%R); auto. apply ClosestRoundedModeP with (precision := precision); auto. case (Rle_or_lt 0 p); intros Rl3; [ idtac | cut (p <= 0)%R; [ intros Rl3' | apply Rlt_le; auto ] ]; auto with real. replace 0%R with (0 + 0)%R; auto with real. apply Rplus_le_reg_l with (r := (- p)%R). replace (- p + 0)%R with (- p)%R; [ idtac | ring ]. replace (- p + (p + q))%R with (FtoRradix q); [ idtac | ring ]. rewrite <- (Faux.Rabsolu_left1 (FtoRradix p)); auto with real. rewrite <- (Rabs_right (FtoRradix q)); auto with real. repeat rewrite Faux.Rabsolu_left1; auto with real. unfold FtoRradix in |- *; repeat rewrite <- (Fopp_correct 2%nat); auto. apply plusClosestLowerBoundAux1 with (q := Fopp p); auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; rewrite Rabs_Ropp; rewrite <- Faux.Rabsolu_left1; auto with real. apply (ClosestCompatible b radix (- (p + q))%R (Fopp q + Fopp p)%R ( Fopp pq) (Fopp pq)); auto. apply ClosestOpp; auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; ring. apply oppBounded; auto. apply oppBounded; auto. apply oppBounded; auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; Contradict H'2. unfold FtoRradix in |- *; rewrite <- (Ropp_involutive (FtoR radix pq)); rewrite H'2; ring. unfold FtoRradix in |- *; apply RleRoundedLessR0 with (b := b) (precision := precision) (P := Closest b radix) (r := (p + q)%R); auto. apply ClosestRoundedModeP with (precision := precision); auto. case (Rle_or_lt 0 p); intros Rl3; [ idtac | cut (p <= 0)%R; [ intros Rl3' | apply Rlt_le; auto ] ]; auto with real. apply Rplus_le_reg_l with (r := (- q)%R). replace (- q + 0)%R with (- q)%R; [ idtac | ring ]. replace (- q + (p + q))%R with (FtoRradix p); [ idtac | ring ]. rewrite <- (Rabs_right (FtoRradix p)); auto with real. rewrite <- (Rabs_left (FtoRradix q)); auto with real. replace 0%R with (0 + 0)%R; auto with real. Qed. Theorem plusClosestLowerBound : forall p q pq : float, Closest b radix (p + q) pq -> Fbounded b p -> Fbounded b q -> pq <> (p + q)%R :>R -> (/ radix * Rmax (Rabs p) (Rabs q) <= Rabs pq)%R. intros p q pq H' H'0 H'1 H'2. cut (Fbounded b pq); [ intros Fb0 | apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto; apply ClosestRoundedModeP with (precision := precision) ]; auto. unfold Rmax in |- *. case (Rle_dec (Rabs p) (Rabs q)); intros Rl1. apply plusClosestLowerBoundAux2 with (p := p); auto. apply plusClosestLowerBoundAux2 with (p := q); auto. apply (ClosestCompatible b radix (p + q)%R (q + p)%R pq pq); auto; try ring. rewrite Rplus_comm; auto. case (Rle_or_lt (Rabs q) (Rabs p)); auto; intros H'3; Contradict Rl1; apply Rlt_le; auto. Qed. End F2.float-8.10.0/Closest2Prop.v000066400000000000000000000047651357127175600154650ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Closest2Prop Laurent Thery ******************************************************************************) Require Export ClosestProp. Section F2. Variable b : Fbound. Variable precision : nat. Let radix := 2%Z. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Theorem TwoMoreThanOne : (1 < radix)%Z. unfold radix in |- *; red in |- *; simpl in |- *; auto. Qed. Hint Resolve TwoMoreThanOne. Hypothesis precisionNotZero : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem FevenNormMin : Even (nNormMin 2%nat precision). unfold nNormMin in |- *. generalize precisionNotZero; case precision. intros H'2; Contradict H'2; auto with zarith. intros n; case n. intros H'2; Contradict H'2; auto with zarith. intros n0 H'2; replace (pred (S (S n0))) with (S n0). apply EvenExp; auto. exists 1%Z; ring. simpl in |- *; auto. Qed. Theorem EvenFNSuccFNSuccMid : forall p : float, Fbounded b p -> FNeven b radix precision p -> Fminus radix (FNSucc b radix precision (FNSucc b radix precision p)) (FNSucc b radix precision p) = Fminus radix (FNSucc b radix precision p) p :>R. intros p H' H'0. unfold FtoRradix in |- *; apply FNSuccFNSuccMid; auto. red in |- *; intros H'1; absurd (FNodd b radix precision (FNSucc b radix precision p)); auto. unfold FNodd in |- *. rewrite FcanonicFnormalizeEq; auto with float arith. unfold Fodd in |- *. rewrite H'1. apply EvenNOdd; auto with float arith. apply FevenNormMin; auto with float arith. apply FNevenSuc; auto. red in |- *; intros H'1; absurd (FNodd b radix precision (FNSucc b radix precision p)); auto with float arith. unfold FNodd in |- *. rewrite FcanonicFnormalizeEq; auto with float arith. unfold Fodd in |- *. rewrite H'1. apply EvenNOdd. apply EvenOpp; apply FevenNormMin. Qed. Theorem AScal2 : forall p : float, Float (Fnum p) (Fexp p + 1%nat) = (radix * p)%R :>R. intros p. unfold FtoRradix in |- *; rewrite FvalScale; auto. replace (powerRZ radix 1%nat) with (INR 2); [ idtac | simpl in |- *; unfold radix; ring ]; auto. Qed. End F2. Hint Resolve FevenNormMin: float.float-8.10.0/ClosestMult.v000066400000000000000000000343321357127175600153750ustar00rootroot00000000000000(**************************************************************************** IEEE754 : ClosestMult Laurent Thery, Sylvie Boldo ******************************************************************************) Require Export FroundMult. Require Export ClosestProp. Section FRoundP. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Hypothesis precisionGreaterThanOne : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem closestLessMultPos : forall (p : float) (r : R), Closest b radix r p -> (0 <= r)%R -> (p <= 2%nat * r)%R. intros p r H' H'0. case ClosestMinOrMax with (1 := H'); intros H'3. apply Rle_trans with r; auto with real. apply isMin_inv1 with (1 := H'3). case (MinEx b radix precision) with (r := r); auto with arith. intros min Hmin. apply Rle_trans with (min + p)%R; auto with real. apply Rplus_le_reg_l with (r := (- p)%R). replace (- p + p)%R with 0%R; [ idtac | ring ]. replace (- p + (min + p))%R with (FtoRradix min); [ apply (RleMinR0 b radix precision) with (r := r); auto | ring ]. apply Rplus_le_reg_l with (r := (- r)%R). apply Rplus_le_reg_l with (r := (- min)%R). replace (- min + (- r + (min + p)))%R with (Rabs (p - r)). replace (- min + (- r + 2%nat * r))%R with (Rabs (min - r)). case H'. intros H'1 H'2; apply H'2; auto. case Hmin; auto. rewrite Faux.Rabsolu_left1; simpl in |- *. ring; auto. apply Rle_minus; apply isMin_inv1 with (1 := Hmin). rewrite Rabs_right; simpl in |- *. ring; auto. apply Rle_ge; apply Rplus_le_reg_l with (r := r). replace (r + 0)%R with r; [ idtac | ring ]. replace (r + (p - r))%R with (FtoRradix p); [ apply isMax_inv1 with (1 := H'3) | ring ]. Qed. Theorem closestLessMultNeg : forall (p : float) (r : R), Closest b radix r p -> (r <= 0)%R -> (2%nat * r <= p)%R. intros p r H' H'0. replace (2%nat * r)%R with (- (2%nat * - r))%R; [ idtac | ring ]. replace (FtoRradix p) with (- - p)%R; [ unfold FtoRradix in |- *; rewrite <- Fopp_correct | ring ]. apply Ropp_le_contravar. apply closestLessMultPos; auto. apply ClosestOpp; auto. replace 0%R with (-0)%R; [ auto with real | ring ]. Qed. Theorem closestLessMultAbs : forall (p : float) (r : R), Closest b radix r p -> (Rabs p <= 2%nat * Rabs r)%R. intros p r H'; case (Rle_or_lt 0 r); intros H'1. repeat rewrite Rabs_right; auto with real. apply closestLessMultPos; auto. apply Rle_ge; apply (RleRoundedR0 b radix precision) with (P := Closest b radix) (r := r); auto. apply ClosestRoundedModeP with (precision := precision); auto. repeat rewrite Faux.Rabsolu_left1; auto. replace (2%nat * - r)%R with (- (2%nat * r))%R; [ apply Ropp_le_contravar | ring ]. apply closestLessMultNeg; auto. apply Rlt_le; auto. apply Rlt_le; auto. apply (RleRoundedLessR0 b radix precision) with (P := Closest b radix) (r := r); auto. apply ClosestRoundedModeP with (precision := precision); auto. apply Rlt_le; auto. Qed. Theorem errorBoundedMultClosest_aux : forall p q pq : float, Fbounded b p -> Fbounded b q -> Closest b radix (p * q) pq -> (- dExp b <= Fexp p + Fexp q)%Z -> (p * q - pq)%R <> 0%R :>R -> ex (fun r : float => ex (fun s : float => Fcanonic radix b r /\ Fbounded b r /\ Fbounded b s /\ r = pq :>R /\ s = (p * q - r)%R :>R /\ Fexp s = (Fexp p + Fexp q)%Z :>Z /\ (Fexp s <= Fexp r)%Z /\ (Fexp r <= precision + (Fexp p + Fexp q))%Z)). intros p q pq Hp Hq H1 H2 H3. cut (RoundedModeP b radix (Closest b radix)); [ intros H4 | apply ClosestRoundedModeP with precision; auto ]. lapply (errorBoundedMultExp b radix precision); [ intros H'2; lapply H'2; [ intros H'3; lapply H'3; [ intros H'4; lapply (H'4 (Closest b radix)); [ intros H'7; elim (H'7 p q pq); [ intros r E; elim E; intros s E0; elim E0; intros H'15 H'16; elim H'16; intros H'17 H'18; elim H'18; intros H'19 H'20; elim H'20; intros H'21 H'22; elim H'22; intros H'23 H'24; elim H'24; intros H'25 H'26; clear H'24 H'22 H'20 H'18 H'16 E0 E H'3 H'2 | clear H'3 H'2 | clear H'3 H'2 | clear H'3 H'2 | clear H'3 H'2 ] | clear H'3 H'2 ] | clear H'3 H'2 ] | clear H'2 ] | idtac]; auto. exists (Fnormalize radix b precision r); exists s. cut (Fbounded b (Fnormalize radix b precision r)); [ intros H5 | apply FnormalizeBounded; auto with arith ]. split; [ apply FnormalizeCanonic; auto with arith | idtac ]. repeat (split; auto). unfold FtoRradix in |- *; rewrite <- H'19; unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto with arith. apply Zlt_le_weak. apply RoundedModeErrorExpStrict with b radix precision (Closest b radix) (p * q)%R; auto with arith. generalize ClosestCompatible; unfold CompatibleP in |- *; intros H6. generalize (H6 b radix (FtoRradix p * FtoRradix q)%R (FtoRradix p * FtoRradix q)%R pq); intros H9; apply H9; auto. rewrite FnormalizeCorrect; auto with real arith. rewrite FnormalizeCorrect; auto with real arith. rewrite H'21; rewrite H'19; auto. apply Z.le_trans with (Fexp r); auto. apply FcanonicLeastExp with radix b precision; auto with arith. rewrite FnormalizeCorrect; auto with real arith. apply FnormalizeCanonic; auto with arith. Qed. Theorem errorBoundedMultClosest : forall p q pq : float, Fbounded b p -> Fbounded b q -> Closest b radix (p * q) pq -> (- dExp b <= Fexp p + Fexp q)%Z -> (- dExp b <= Fexp (Fnormalize radix b precision pq) - precision)%Z -> ex (fun r : float => ex (fun s : float => Fcanonic radix b r /\ Fbounded b r /\ Fbounded b s /\ r = pq :>R /\ s = (p * q - r)%R :>R /\ Fexp s = (Fexp r - precision)%Z :>Z)). intros. cut (RoundedModeP b radix (Closest b radix)); [ intros G1 | apply ClosestRoundedModeP with precision; auto ]. case (Req_dec (p * q - pq) 0); intros U. exists (Fnormalize radix b precision pq); exists (Fzero (Fexp (Fnormalize radix b precision pq) - precision)). cut (Fbounded b pq); [ intros G2 | apply RoundedModeBounded with radix (Closest b radix) (p * q)%R; auto ]. cut (Fcanonic radix b (Fnormalize radix b precision pq)); [ intros G3 | apply FnormalizeCanonic; auto with arith ]. cut (Fbounded b (Fnormalize radix b precision pq)); [ intros G4 | apply FnormalizeBounded; auto with arith ]. cut (Fnormalize radix b precision pq = pq :>R); [ intros G5 | unfold FtoRradix in |- *; apply FnormalizeCorrect; auto with arith ]. repeat (split; auto). rewrite G5; unfold FtoRradix in |- *; rewrite FzeroisReallyZero; auto with real. lapply (errorBoundedMultClosest_aux p q pq); auto; intros H5. lapply H5; auto; intros H6; clear H5. lapply H6; auto; intros H5; clear H6. lapply H5; auto; intros H6; clear H5. lapply H6; auto; intros H5; clear H6. elim H5; intros r H6; clear H5. elim H6; intros s H5; clear H6. elim H5; intros H7 H6; clear H5. elim H6; intros H8 H9; clear H6. elim H9; intros H6 H10; clear H9. elim H10; intros H9 H11; clear H10. elim H11; intros H10 H12; clear H11. elim H12; intros H11 H13; clear H12. elim H13; intros H12 H14; clear H13. cut (ex (fun m : Z => s = Float m (Fexp r - precision) :>R /\ (Z.abs m <= pPred (vNum b))%Z)). intros H13; elim H13; intros m H15; elim H15; intros H16 H17; clear H15 H13. exists r; exists (Float m (Fexp r - precision)). split; auto. split; auto. split. 2: repeat (split; auto). 2: rewrite <- H16; auto. split; simpl in |- *. generalize H17; unfold pPred in |- *; apply Zle_Zpred_inv. replace r with (Fnormalize radix b precision pq); auto with zarith. apply FcanonicUnique with radix b precision; auto with zarith. apply FnormalizeCanonic; auto with zarith; elim H1; auto. rewrite FnormalizeCorrect; auto with real zarith. cut (radix <> 0%Z :>Z); [ intros V | auto with arith real zarith ]. cut (0 < radix)%Z; [ intros V2 | auto with arith real zarith ]. rewrite H10; unfold FtoRradix in |- *; rewrite <- Fmult_correct; auto. rewrite <- Fminus_correct; fold FtoRradix in |- *; auto. unfold Fmult in |- *; unfold Fminus in |- *; unfold Fopp in |- *; unfold Fplus in |- *; simpl in |- *. unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *. rewrite Zmin_le1; auto with zarith. replace (Fnum p * Fnum q * Zpower_nat radix (Z.abs_nat (Fexp p + Fexp q - (Fexp p + Fexp q))))%Z with (Fnum p * Fnum q)%Z. 2: replace (Fexp p + Fexp q - (Fexp p + Fexp q))%Z with 0%Z; auto with zarith arith; simpl in |- *. 2: auto with zarith. exists ((Fnum p * Fnum q + - Fnum r * Zpower_nat radix (Z.abs_nat (Fexp r - (Fexp p + Fexp q)))) * Zpower_nat radix (Z.abs_nat (Fexp p + Fexp q + (precision - Fexp r))))%Z; split. rewrite plus_IZR. repeat rewrite Rmult_IZR. rewrite plus_IZR. repeat rewrite Rmult_IZR. rewrite (Zpower_nat_powerRZ_absolu radix (Fexp r - (Fexp p + Fexp q))). 2: auto with zarith arith. rewrite (Zpower_nat_powerRZ_absolu radix (Fexp p + Fexp q + (precision - Fexp r))) . 2: auto with zarith arith. cut (radix <> 0%R :>R); [ intros W | auto with real arith zarith ]. unfold Zminus in |- *. repeat rewrite powerRZ_add; try rewrite <- INR_IZR_INZ; auto. apply trans_eq with ((Fnum p * Fnum q + (- Fnum r)%Z * (powerRZ radix (Fexp r) * powerRZ radix (- (Fexp p + Fexp q)))) * (powerRZ radix (Fexp p) * powerRZ radix (Fexp q)))%R. ring; ring. apply trans_eq with ((Fnum p * Fnum q + (- Fnum r)%Z * (powerRZ radix (Fexp r) * powerRZ radix (- (Fexp p + Fexp q)))) * (powerRZ radix (Fexp p) * powerRZ radix (Fexp q) * (powerRZ radix precision * powerRZ radix (- precision))) * (powerRZ radix (Fexp r) * powerRZ radix (- Fexp r)))%R. 2: ring; ring. replace (powerRZ radix precision * powerRZ radix (- precision))%R with 1%R. replace (powerRZ radix (Fexp r) * powerRZ radix (- Fexp r))%R with 1%R; try ring. rewrite <- powerRZ_add; try rewrite <- INR_IZR_INZ; auto. rewrite Zplus_opp_r; simpl in |- *; auto. rewrite <- powerRZ_add; try rewrite <- INR_IZR_INZ; auto. rewrite Zplus_opp_r; simpl in |- *; auto. apply le_IZR; rewrite <- Faux.Rabsolu_Zabs. rewrite Rmult_IZR; rewrite plus_IZR. repeat rewrite Rmult_IZR. rewrite (Zpower_nat_powerRZ_absolu radix (Fexp p + Fexp q + (precision - Fexp r))) . 2: auto with zarith arith. rewrite (Zpower_nat_powerRZ_absolu radix (Fexp r - (Fexp p + Fexp q))). 2: auto with zarith arith. rewrite powerRZ_add; try rewrite <- INR_IZR_INZ; auto with real arith. replace ((Fnum p * Fnum q + (- Fnum r)%Z * powerRZ radix (Fexp r - (Fexp p + Fexp q))) * (powerRZ radix (Fexp p + Fexp q) * powerRZ radix (precision - Fexp r)))%R with ((Fnum p * Fnum q + (- Fnum r)%Z * powerRZ radix (Fexp r - (Fexp p + Fexp q))) * powerRZ radix (Fexp p + Fexp q) * powerRZ radix (precision - Fexp r))%R; [ idtac | ring; ring ]. rewrite Rabs_mult. rewrite (Rabs_right (powerRZ radix (precision - Fexp r))). 2: apply Rle_ge; apply powerRZ_le; auto with real zarith. apply Rmult_le_reg_l with (powerRZ radix (Fexp r - precision)). apply powerRZ_lt; auto with real arith. rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- powerRZ_add. 2: auto with zarith arith real. replace (precision - Fexp r + (Fexp r - precision))%Z with 0%Z; [ simpl in |- * | ring ]. apply Rle_trans with (Rabs ((Fnum p * Fnum q + (- Fnum r)%Z * powerRZ radix (Fexp r - (Fexp p + Fexp q))) * powerRZ radix (Fexp p + Fexp q))); [ right; ring | idtac ]. replace ((Fnum p * Fnum q + (- Fnum r)%Z * powerRZ radix (Fexp r - (Fexp p + Fexp q))) * powerRZ radix (Fexp p + Fexp q))%R with (p * q - r)%R. 2: unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *; unfold Rminus in |- *. 2: unfold Zminus in |- *; repeat rewrite Ropp_Ropp_IZR. 2: repeat rewrite powerRZ_add; auto with real arith. 2: apply trans_eq with (Fnum p * Fnum q * (powerRZ radix (Fexp p) * powerRZ radix (Fexp q)) + - Fnum r * (powerRZ radix (Fexp r) * (powerRZ radix (- (Fexp p + Fexp q)) * (powerRZ radix (Fexp p) * powerRZ radix (Fexp q)))))%R; [ idtac | ring ]. 2: replace (powerRZ radix (- (Fexp p + Fexp q)) * (powerRZ radix (Fexp p) * powerRZ radix (Fexp q)))%R with 1%R; try ring. 2: repeat rewrite <- powerRZ_add; auto with real arith. 2: replace (- (Fexp p + Fexp q) + (Fexp p + Fexp q))%Z with 0%Z; simpl in |- *; simpl; ring. apply Rle_trans with (powerRZ radix (Fexp r) * / 2%nat)%R. rewrite <- H10; replace (powerRZ radix (Fexp r)) with (FtoRradix (Float 1%nat (Fexp r))); unfold FtoRradix in |- *; [ idtac | unfold FtoR in |- *; simpl in |- *; ring ]. apply ClosestErrorBound with b precision (p * q)%R; auto. apply (ClosestCompatible b radix (p * q)%R (p * q)%R pq); auto. unfold Zminus in |- *; rewrite powerRZ_add; auto with real arith. rewrite Rmult_assoc; apply Rmult_le_compat_l. apply powerRZ_le; auto with real arith. unfold pPred, Z.pred in |- *; rewrite pGivesBound. rewrite plus_IZR; rewrite Zpower_nat_Z_powerRZ. replace (powerRZ radix (- precision) * (powerRZ radix precision + (-1)%Z))%R with (1 + - powerRZ radix (- precision))%R. apply Rle_trans with (1 + - powerRZ radix (- 1%nat))%R. simpl in |- *. replace (radix * 1)%R with (IZR radix); [ idtac | ring ]. replace (/ (1 + 1))%R with (1 + - / 2)%R. apply Rplus_le_compat_l; apply Ropp_le_contravar. apply Rle_Rinv; auto with real arith zarith. replace 2%R with (1 + 1)%R; auto with real arith zarith. cut ((1 + 1)%R <> 0%R :>R); [ intros | idtac ]. 2: replace 2%R with (INR 2); auto with real arith zarith. apply Rmult_eq_reg_l with (1 + 1)%R; auto. rewrite Rmult_plus_distr_l. simpl. rewrite (Rmult_comm (1 + 1) (- / (1 + 1))). rewrite Ropp_mult_distr_l_reverse. rewrite (Rmult_comm (/ (1 + 1)) (1 + 1)). rewrite Rinv_r; auto with real; ring. apply Rplus_le_compat_l; apply Ropp_le_contravar. apply Rle_powerRZ; auto with real arith zarith. rewrite Rmult_plus_distr_l. rewrite <- powerRZ_add; auto with real arith. replace (- precision + precision)%Z with 0%Z; simpl in |- *; ring. Qed. End FRoundP. float-8.10.0/ClosestPlus.v000066400000000000000000000656461357127175600154130ustar00rootroot00000000000000(**************************************************************************** IEEE754 : ClosestPlus Laurent Thery, Sylvie Boldo ******************************************************************************) Require Export FroundPlus. Require Export ClosestProp. Section ClosestP. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local 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 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem errorBoundedPlusLe : forall p q pq : float, Fbounded b p -> Fbounded b q -> (Fexp p <= Fexp q)%Z -> Closest b radix (p + q) pq -> exists error : float, error = Rabs (p + q - pq) :>R /\ Fbounded b error /\ Fexp error = Z.min (Fexp p) (Fexp q). intros p q pq H' H'0 H'1 H'2. cut (ex (fun m : Z => pq = Float m (Fexp (Fplus radix p q)) :>R)). 2: unfold FtoRradix in |- *; apply RoundedModeRep with (b := b) (precision := precision) (P := Closest b radix); auto. 2: apply ClosestRoundedModeP with (precision := precision); auto. 2: rewrite (Fplus_correct radix); auto with arith. intros H'3; elim H'3; intros m E; clear H'3. exists (Fabs (Fminus radix q (Fminus radix (Float m (Fexp (Fplus radix p q))) p))). cut (forall A B : Prop, A -> (A -> B) -> A /\ B); [ intros tmp; apply tmp; clear tmp | auto ]. unfold FtoRradix in |- *; rewrite Fabs_correct; auto with arith. cut (forall p q : R, p = q -> Rabs p = Rabs q); [ intros tmp; apply tmp; clear tmp | intros p' q' H; rewrite H; auto ]. unfold FtoRradix in |- *; repeat rewrite Fminus_correct; auto with arith. unfold FtoRradix in E; rewrite E; auto. ring. intros H'4. cut (Rabs (pq - (p + q)) <= Rabs (q - (p + q)))%R. 2: elim H'2; auto. replace (q - (p + q))%R with (- FtoRradix p)%R. 2: ring. rewrite Rabs_Ropp. unfold FtoRradix in |- *; rewrite <- Fabs_correct; auto with arith. rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr. unfold FtoRradix in H'4; rewrite <- H'4. simpl in |- *. rewrite Zmin_le1; auto. generalize H'1 H'; case p; case q; unfold Fabs, Fminus, Fopp, Fplus in |- *; simpl in |- *; clear H'1 H'. intros Fnum1 Fexp1 Fnum2 Fexp2 H'5 H'6. repeat rewrite Zmin_n_n; auto. repeat rewrite (Zmin_le2 _ _ H'5); auto with zarith. replace (Z.abs_nat (Fexp2 - Fexp2)) with 0. rewrite Zpower_nat_O. cut (forall z : Z, (z * 1%nat)%Z = z); [ intros tmp; repeat rewrite tmp; clear tmp | auto with zarith ]. unfold FtoRradix, FtoR in |- *; simpl in |- *. intros H'. repeat split; simpl in |- *. rewrite (fun x => Z.abs_eq (Z.abs x)); auto with zarith. apply Z.le_lt_trans with (Z.abs Fnum2); auto. apply le_IZR. apply (Rle_monotony_contra_exp radix) with (z := Fexp2); auto. case H'6; auto. case H'6; auto. intros; simpl in |- *; ring. replace (Fexp2 - Fexp2)%Z with 0%Z; simpl in |- *; auto with zarith. Qed. Theorem errorBoundedPlusAbs : forall p q pq : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) pq -> exists error : float, error = Rabs (p + q - pq) :>R /\ Fbounded b error /\ Fexp error = Z.min (Fexp p) (Fexp q). intros p q pq H' H'0 H'1. case (Zle_or_lt (Fexp p) (Fexp q)); intros H'2. apply errorBoundedPlusLe; auto. replace (p + q)%R with (q + p)%R; [ idtac | ring ]. replace (Z.min (Fexp p) (Fexp q)) with (Z.min (Fexp q) (Fexp p)); [ idtac | apply Zmin_sym ]. apply errorBoundedPlusLe; auto. auto with zarith. apply (ClosestCompatible b radix (p + q)%R (q + p)%R pq); auto. ring. case H'1; auto. Qed. Theorem errorBoundedPlus : forall p q pq : float, (Fbounded b p) -> (Fbounded b q) -> (Closest b radix (p + q) pq) -> exists error : float, error = (p + q - pq)%R :>R /\ (Fbounded b error) /\ (Fexp error) = (Z.min (Fexp p) (Fexp q)). intros p q pq H' H'0 H'1. case (errorBoundedPlusAbs p q pq); auto. intros x H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6; clear H'4 H'2. generalize H'3; clear H'3. unfold Rabs in |- *; case (Rcase_abs (p + q - pq)). intros H'2 H'3; exists (Fopp x); split; auto. unfold FtoRradix in |- *; rewrite Fopp_correct; auto. unfold FtoRradix in H'3; rewrite H'3; ring. split. apply oppBounded; auto. rewrite <- H'6; auto. intros H'2 H'3; exists x; split; auto. Qed. Theorem plusExact1 : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> (Fexp r <= Z.min (Fexp p) (Fexp q))%Z -> r = (p + q)%R :>R. intros p q r H' H'0 H'1 H'2. cut (2%nat * Rabs (FtoR radix (Fplus radix p q) - FtoR radix r) <= Float 1%nat (Fexp r))%R; [ rewrite Fplus_correct; auto with zarith; intros Rl1 | idtac ]. case errorBoundedPlus with (p := p) (q := q) (pq := r); auto. intros x H'3; elim H'3; intros H'4 H'5; elim H'5; intros H'6 H'7; clear H'5 H'3. unfold FtoRradix in H'4; rewrite <- H'4 in Rl1. 2: apply Rle_trans with (Fulp b radix precision r); auto. 2: apply (ClosestUlp b radix precision); auto. 2: rewrite Fplus_correct; auto with zarith. 2: unfold FtoRradix in |- *; apply FulpLe; auto. 2: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. 2: apply ClosestRoundedModeP with (precision := precision); auto. cut (x = 0%R :>R); [ unfold FtoRradix in |- *; intros Eq1 | idtac ]. replace (FtoR radix r) with (FtoR radix r + 0)%R; [ idtac | ring ]. rewrite <- Eq1. rewrite H'4; ring. apply (is_Fzero_rep1 radix). case (Z_zerop (Fnum x)); simpl in |- *; auto. intros H'3; Contradict Rl1. apply Rgt_not_le. red in |- *; apply Rle_lt_trans with (Rabs (FtoR radix x)). unfold FtoRradix, FtoR in |- *; simpl in |- *; auto. rewrite Rabs_mult. apply Rmult_le_compat; auto with real arith. generalize H'3; case (Fnum x); simpl in |- *; auto with real zarith. intros H'5; case H'5; auto. intros p0 H'5; rewrite Rabs_right; auto with real. replace 1%R with (INR 1); unfold IZR; repeat rewrite <- INR_IPR; auto with real arith. intros p0 H'5; rewrite Faux.Rabsolu_left1; auto. unfold IZR; rewrite Ropp_involutive. repeat rewrite <- INR_IPR; simpl; replace 1%R with (INR 1); auto with real arith. unfold IZR; repeat rewrite <- INR_IPR; replace 0%R with (- 0%nat)%R; auto with real. rewrite Rabs_right; auto with real arith. apply Rle_powerRZ; auto with real arith. auto with zarith. apply Rle_ge; cut (1 < radix)%Z; auto with float real zarith. cut (forall r : R, (2%nat * r)%R = (r + r)%R); [ intros tmp; rewrite tmp; clear tmp | intros f; simpl in |- *; ring ]. pattern (Rabs (FtoR radix x)) at 1 in |- *; replace (Rabs (FtoR radix x)) with (Rabs (FtoR radix x) + 0)%R; [ idtac | ring ]. apply Rplus_lt_compat_l; auto. case (Rabs_pos (FtoR radix x)); auto. rewrite <- Fabs_correct; auto with arith. intros H'5; Contradict H'3. cut (Fnum (Fabs x) = 0%Z). unfold Fabs in |- *; simpl in |- *; case (Fnum x); simpl in |- *; auto; intros; discriminate. change (is_Fzero (Fabs x)) in |- *. apply (is_Fzero_rep2 radix); auto with arith. Qed. Theorem plusExact1bis : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> r <> (p + q)%R :>R -> (Z.min (Fexp p) (Fexp q) < Fexp r)%Z. intros p0 q0 r0 H' H'0 H'1 H'2; case (Zle_or_lt (Fexp r0) (Z.min (Fexp p0) (Fexp q0))); auto. intros H'3; Contradict H'2. apply plusExact1; auto. Qed. Theorem plusExact2Aux : forall p q r : float, (0 <= p)%R -> Fcanonic radix b p -> Fbounded b q -> Closest b radix (p + q) r -> (Fexp r < Z.pred (Fexp p))%Z -> r = (p + q)%R :>R. intros p q r H' H'0 H'1 H'2 H'3. apply plusExact1; auto. apply FcanonicBound with (1 := H'0); auto. case (Zle_or_lt (Fexp p) (Fexp q)); intros Zl1. rewrite Zmin_le1; auto with zarith. apply Z.le_trans with (Z.pred (Fexp p)); auto with zarith. unfold Z.pred in |- *; auto with zarith. rewrite Zmin_le2; auto with zarith. case (Zlt_next _ _ Zl1); intros Zl2. rewrite Zl2 in H'3. replace (Fexp q) with (Z.pred (Z.succ (Fexp q))); auto with zarith; unfold Z.pred, Z.succ in |- *; ring. case H'0; clear H'0; intros H'0. absurd (r < Float (nNormMin radix precision) (Z.pred (Fexp p)))%R. apply Rle_not_lt; auto. unfold FtoRradix in |- *; apply (ClosestMonotone b radix (Float (nNormMin radix precision) (Z.pred (Fexp p))) ( p + q)%R); auto; auto. cut (Float (nNormMin radix precision) (Fexp p) <= p)%R; [ intros Eq1 | idtac ]. case (Rle_or_lt 0 q); intros Rl1. apply Rlt_le_trans with (FtoRradix p). apply Rlt_le_trans with (FtoRradix (Float (nNormMin radix precision) (Fexp p))); auto. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto. apply Rmult_lt_compat_l; auto with real arith. replace 0%R with (IZR 0%nat); auto with real; auto with real float arith. apply Rlt_IZR; apply nNormPos; auto with zarith. unfold Z.pred in |- *; auto with real float zarith arith. pattern (FtoRradix p) at 1 in |- *; replace (FtoRradix p) with (p + 0)%R; auto with real. apply Rplus_lt_reg_l with (r := (- q)%R); auto. replace (- q + (p + q))%R with (FtoRradix p); [ idtac | ring ]. apply Rlt_le_trans with (FtoRradix (Float (nNormMin radix precision) (Fexp p))); auto. apply Rlt_le_trans with (2%nat * Float (nNormMin radix precision) (Z.pred (Fexp p)))%R; auto. cut (forall r : R, (2%nat * r)%R = (r + r)%R); [ intros tmp; rewrite tmp; clear tmp | intros; simpl in |- *; ring ]. rewrite (Rplus_comm (- q)). apply Rplus_lt_compat_l. rewrite <- Faux.Rabsolu_left1; auto. rewrite <- (Fabs_correct radix); auto with arith. unfold FtoRradix in |- *; apply maxMaxBis with (b := b); auto with zarith. apply Rlt_le; auto. apply Rle_trans with (radix * Float (nNormMin radix precision) (Z.pred (Fexp p)))%R. apply Rmult_le_compat_r; auto. apply (LeFnumZERO radix); simpl in |- *; auto with arith. apply Zlt_le_weak; apply nNormPos; auto with zarith. rewrite INR_IZR_INZ; apply Rle_IZR; simpl in |- *; cut (1 < radix)%Z; auto with real zarith. pattern (Fexp p) at 2 in |- *; replace (Fexp p) with (Z.succ (Z.pred (Fexp p))); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith. repeat rewrite <- Rmult_assoc. rewrite (Rmult_comm radix); auto with real. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto. apply Rmult_le_compat_r; auto with real zarith. apply Rle_IZR. rewrite <- (Z.abs_eq (Fnum p)); auto with zarith. apply pNormal_absolu_min with (b := b); auto with arith. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto. apply (LeR0Fnum radix); auto with arith. apply (RoundedModeProjectorIdem b radix (Closest b radix)); auto. apply ClosestRoundedModeP with (precision := precision); auto. repeat split; simpl in |- *. rewrite Z.abs_eq; auto with zarith. apply ZltNormMinVnum; auto with arith. apply Zlt_le_weak; apply nNormPos; auto with zarith. apply Z.le_trans with (Fexp q); auto with float zarith. case (Rle_or_lt 0 r); intros Rl1. rewrite <- (Rabs_right r); auto with real. rewrite <- (Fabs_correct radix); auto with arith. unfold FtoRradix in |- *; apply maxMaxBis with (b := b); auto with zarith. apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. apply ClosestRoundedModeP with (precision := precision); auto with real. apply Rlt_le_trans with 0%R; auto. apply (LeFnumZERO radix); simpl in |- *; auto with arith. apply Zlt_le_weak; apply nNormPos; auto with zarith. absurd (- dExp b <= Fexp q)%Z; auto with float. apply Zlt_not_le. case H'0; intros Z1 (Z2, Z3); rewrite <- Z2; auto with zarith. Qed. Theorem plusExact2 : forall p q r : float, Fcanonic radix b p -> Fbounded b q -> Closest b radix (p + q) r -> (Fexp r < Z.pred (Fexp p))%Z -> r = (p + q)%R :>R. intros p q r H' H'0 H'1 H'2. case (Rle_or_lt 0 p); intros Rl1. apply plusExact2Aux; auto. replace (p + q)%R with (- (Fopp p + Fopp q))%R. rewrite <- (plusExact2Aux (Fopp p) (Fopp q) (Fopp r)); auto. unfold FtoRradix in |- *; rewrite Fopp_correct; ring. unfold FtoRradix in |- *; rewrite Fopp_correct. apply Rlt_le; replace 0%R with (-0)%R; auto with real. apply FcanonicFopp; auto with arith. apply oppBounded; auto. replace (Fopp p + Fopp q)%R with (- (p + q))%R. apply ClosestOpp; auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; ring. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; ring. Qed. Theorem plusExactR0 : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> r = 0%R :>R -> r = (p + q)%R :>R. intros p q r H' H'0 H'1 H'2. cut (r = FtoRradix (Fzero (- dExp b)) :>R); [ intros Eq1; rewrite Eq1 | rewrite H'2; apply sym_eq; unfold FtoRradix in |- *; apply FzeroisZero ]. apply plusExact1; auto. apply (ClosestCompatible b radix (p + q)%R (p + q)%R r); auto. apply FboundedFzero; auto. simpl in |- *; auto. unfold Z.min in |- *; case (Fexp p ?= Fexp q)%Z; auto with float. Qed. Theorem plusErrorBound1 : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> ~ is_Fzero r -> (Rabs (r - (p + q)) < Rabs r * / 2%nat * (radix * / pPred (vNum b)))%R. intros p q r H' H'0 H'1 H'2. cut (Fcanonic radix b (Fnormalize radix b precision r)); [ intros tmp; Casec tmp; intros Fs | idtac ]. 3: apply FnormalizeCanonic; auto with arith. 3: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. 3: apply ClosestRoundedModeP with (precision := precision); auto. 2: rewrite <- (plusExact1 p q (Fnormalize radix b precision r)); auto. 2: unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto with arith. 2: replace (FtoR radix r - FtoR radix r)%R with 0%R; [ idtac | ring ]. 2: rewrite Rabs_R0. 2: replace 0%R with (0 * (radix * / pPred (vNum b)))%R; [ apply Rmult_lt_compat_r | ring ]. 2: replace 0%R with (0 * / pPred (vNum b))%R; [ apply Rmult_lt_compat_r | ring ]. 2: apply Rinv_0_lt_compat; replace 0%R with (IZR 0); auto with real zarith. 2: apply Rlt_IZR; unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *. 2: apply vNumbMoreThanOne with (radix := radix) (precision := precision); auto with real zarith. 2: cut (1 < radix)%Z; auto with real zarith. 2: replace 0%R with (0 * / 2%nat)%R; [ apply Rmult_lt_compat_r | ring ]; auto with real. 2: case (Rabs_pos (FtoR radix r)); auto. 2: intros H'3; Contradict H'2. 2: apply is_Fzero_rep2 with (radix := radix); auto with real arith. 2: generalize H'3; fold FtoRradix in |- *; unfold Rabs in |- *; case (Rcase_abs r); auto. 2: intros r0 H'2; replace 0%R with (-0)%R; [ rewrite H'2 | idtac ]; ring. 2: apply (ClosestCompatible b radix (p + q)%R (p + q)%R r); auto. 2: apply sym_eq; apply FnormalizeCorrect; auto. 2: apply FnormalizeBounded; auto with arith. 2: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. 2: apply ClosestRoundedModeP with (precision := precision); auto. 2: replace (Fexp (Fnormalize radix b precision r)) with (- dExp b)%Z. 2: unfold Z.min in |- *; case (Fexp p ?= Fexp q)%Z; auto with float. 2: apply sym_equal; case Fs; intros H1 H2; case H2; auto. apply Rle_lt_trans with (/ 2%nat * Fulp b radix precision r)%R. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_1_l. unfold FtoRradix in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite <- (Fplus_correct radix); auto with zarith. apply ClosestUlp; auto. rewrite Fplus_correct; auto with arith. replace (Rabs r * / 2%nat * (radix * / pPred (vNum b)))%R with (/ 2%nat * (Rabs r * (radix * / pPred (vNum b))))%R; [ apply Rmult_lt_compat_l; auto with real | ring ]. replace (Fulp b radix precision r) with (Float (pPred (vNum b)) (Z.pred (Fexp (Fnormalize radix b precision r))) * (radix * / pPred (vNum b)))%R. apply Rmult_lt_compat_r. replace 0%R with (radix * 0)%R; [ apply Rmult_lt_compat_l | ring ]; auto with real arith. apply Rinv_0_lt_compat; replace 0%R with (IZR 0%nat); auto with real arith; apply Rlt_IZR. unfold pPred in |- *; apply Zlt_succ_pred; apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. unfold FtoRradix in |- *; rewrite <- (FnormalizeCorrect _ radixMoreThanOne b precision r). rewrite <- (Fabs_correct radix); auto with arith. apply FnormalBoundAbs; auto with zarith. unfold Fulp, FtoRradix, FtoR in |- *; simpl in |- *. apply trans_eq with (pPred (vNum b) * / pPred (vNum b) * (radix * powerRZ radix (Z.pred (Fexp (Fnormalize radix b precision r)))))%R; [ ring | idtac ]; auto. rewrite Rinv_r; auto with real arith. rewrite <- powerRZ_Zs; auto with real. cut (forall r : Z, Z.succ (Z.pred r) = r); [ intros Er; rewrite Er | intros r'; unfold Z.succ, Z.pred in |- * ]; ring. apply Rlt_dichotomy_converse; right; red in |- *. replace 0%R with (IZR 0); cut (1 < radix)%Z; auto with real zarith. apply Rlt_dichotomy_converse; right; red in |- *. replace 0%R with (IZR 0); auto with real zarith. unfold pPred in |- *; apply Rlt_IZR; apply Zlt_succ_pred; simpl in |- *. apply vNumbMoreThanOne with (radix := radix) (precision := precision); auto with real arith. Qed. Theorem plusErrorBound1bis : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> ~ is_Fzero r -> (Rabs (r - (p + q)) <= Rabs r * / 2%nat * (radix * / Zpos (vNum b)))%R. intros p q r H' H'0 H'1 H'2. cut (Fcanonic radix b (Fnormalize radix b precision r)); [ intros tmp; Casec tmp; intros Fs | idtac ]. 3: apply FnormalizeCanonic; auto with arith. 3: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. 3: apply ClosestRoundedModeP with (precision := precision); auto. 2: rewrite <- (plusExact1 p q (Fnormalize radix b precision r)); auto. 2: unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto. 2: replace (FtoR radix r - FtoR radix r)%R with 0%R; [ idtac | ring ]. 2: rewrite Rabs_R0. 2: replace 0%R with (0 * (radix * / Zpos (vNum b)))%R; [ apply Rmult_le_compat_r | ring ]; auto with real zarith. 2: replace 0%R with (0 * / Zpos (vNum b))%R; [ apply Rmult_le_compat_r | ring ]; auto with real zarith. 2: replace 0%R with (0 * / 2%nat)%R; [ apply Rmult_le_compat_r | ring ]; auto with real zarith. 2: apply (ClosestCompatible b radix (p + q)%R (p + q)%R r); auto. 2: apply sym_eq; apply FnormalizeCorrect; auto. 2: apply FnormalizeBounded; auto with arith. 2: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := (p + q)%R); auto. 2: apply ClosestRoundedModeP with (precision := precision); auto. 2: replace (Fexp (Fnormalize radix b precision r)) with (- dExp b)%Z. 2: unfold Z.min in |- *; case (Fexp p ?= Fexp q)%Z; intuition. 2: case Fs; intros H1 (H2, H3); auto. apply Rle_trans with (/ 2%nat * Fulp b radix precision r)%R. replace (Rabs (FtoRradix r - (FtoRradix p + FtoRradix q))) with (/ 2%nat * (2%nat * Rabs (FtoRradix r - (FtoRradix p + FtoRradix q))))%R; [ idtac | rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real ]. apply Rmult_le_compat_l; auto with real. replace (FtoRradix r - (FtoRradix p + FtoRradix q))%R with (- (FtoRradix p + FtoRradix q - FtoRradix r))%R; [ rewrite Rabs_Ropp | ring ]. apply (ClosestUlp b radix); auto. replace (Rabs r * / 2%nat * (radix * / Zpos (vNum b)))%R with (/ 2%nat * (Rabs r * (radix * / Zpos (vNum b))))%R; [ apply Rmult_le_compat_l; auto with real | ring ]. replace (Fulp b radix precision r) with (Zpos (vNum b) * FtoR radix (Float 1%nat (Z.pred (Fexp (Fnormalize radix b precision r)))) * (radix * / Zpos (vNum b)))%R. apply Rmult_le_compat_r. replace 0%R with (radix * 0)%R; [ apply Rmult_le_compat_l | ring ]; apply Rlt_le; auto with real arith; rewrite INR_IZR_INZ; apply Rlt_IZR; simpl in |- *; apply Zlt_1_O; apply Zlt_le_weak; apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. unfold FtoRradix in |- *; rewrite <- (FnormalizeCorrect _ radixMoreThanOne b precision r). rewrite <- (Fabs_correct radix); auto with arith. apply FnormalBoundAbs2 with precision; auto with arith. unfold Fulp, FtoRradix, FtoR in |- *; simpl in |- *. apply trans_eq with (nat_of_P (vNum b) * / nat_of_P (vNum b) * (radix * powerRZ radix (Z.pred (Fexp (Fnormalize radix b precision r)))))%R; [ unfold IZR at 1 5; repeat rewrite <- INR_IPR; ring | idtac]. rewrite Rinv_r; auto with real arith. rewrite <- powerRZ_Zs; auto with real zarith. rewrite <- Zsucc_pred; ring. Qed. Theorem plusErrorBound1withZero : forall p q r : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) r -> (Rabs (r - (p + q)) <= Rabs r * / 2%nat * (radix * / pPred (vNum b)))%R. intros p q r H H0 H1. case (Req_dec r 0); intros Hr. replace (Rabs (r - (p + q))) with (Rabs r * / 2%nat * 0)%R. apply Rmult_le_compat_l. replace 0%R with (Rabs r * 0)%R; [ apply Rmult_le_compat_l | ring ]; auto with real arith. replace 0%R with (radix * 0)%R; [ apply Rmult_le_compat_l | ring ]; auto with real arith. apply Rlt_le; apply Rinv_0_lt_compat; auto with real arith. replace 0%R with (IZR 0%nat); auto with real zarith; apply Rlt_IZR. apply Z.le_lt_trans with (nNormMin radix precision). apply Zlt_le_weak; apply nNormPos; auto with real zarith. apply nNormMimLtvNum; auto with real zarith. rewrite <- plusExactR0 with (3 := H1); auto with real zarith. rewrite Hr; repeat rewrite Rabs_R0 || (rewrite Rminus_diag_eq; auto); ring. apply Rlt_le; apply plusErrorBound1; auto. Contradict Hr; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto. Qed. Theorem pPredMoreThanOne : (0 < pPred (vNum b))%Z. unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. Qed. Theorem pPredMoreThanRadix : (radix < pPred (vNum b))%Z. apply Z.le_lt_trans with (nNormMin radix precision). pattern radix at 1 in |- *; rewrite <- (Zpower_nat_1 radix); unfold nNormMin in |- *; auto with zarith. apply nNormMimLtvNum; auto with zarith. Qed. Theorem RoundBound : forall x y p : float, Fbounded b x -> Fbounded b y -> Fbounded b p -> Closest b radix (x + y) p -> (radix < 2%nat * pPred (vNum b))%Z -> (Rabs p <= Rabs (x + y) * (2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b) - radix)))%R. intros x y p H H0 H1 H2 H3. cut (0 < 2%nat * pPred (vNum b))%Z; [ intros NZ1 | apply Z.lt_trans with radix; auto with zarith ]. cut (0 < 2%nat * pPred (vNum b))%R; [ intros NZ1' | rewrite INR_IZR_INZ; rewrite <- Rmult_IZR; auto with real zarith ]. cut (radix < 2%nat * pPred (vNum b))%R; [ intros NZ2 | rewrite INR_IZR_INZ; rewrite <- Rmult_IZR; auto with real zarith ]. replace (Rabs p) with (Rabs p * ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b))) * (2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b) - radix)))%R. 2: replace (Rabs p * ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b))) * (2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b) - radix)))%R with (Rabs p * ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b) - radix)) * (2%nat * pPred (vNum b) * / (2%nat * pPred (vNum b))))%R; [ idtac | ring ]. 2: repeat rewrite Rinv_r; auto with real zarith; try ring. apply Rmult_le_compat_r. replace 0%R with (2%nat * pPred (vNum b) * 0)%R; [ apply Rmult_le_compat_l | ring ]; auto with real zarith. replace ((2%nat * pPred (vNum b) - radix) * / (2%nat * pPred (vNum b)))%R with (1 - radix * / (2%nat * pPred (vNum b)))%R. 2: unfold Rminus in |- *; rewrite Rmult_plus_distr_r; rewrite Rinv_r; auto with real. replace (Rabs p * (1 - radix * / (2%nat * pPred (vNum b))))%R with (Rabs p - Rabs p * (radix * / (2%nat * pPred (vNum b))))%R; [ idtac | ring; ring ]. apply Rplus_le_reg_l with (Rabs p * (radix * / (2%nat * pPred (vNum b))))%R. replace (Rabs (FtoRradix p) * (radix * / (2%nat * pPred (vNum b))) + (Rabs (FtoRradix p) - Rabs (FtoRradix p) * (radix * / (2%nat * pPred (vNum b)))))%R with (Rabs p); [ idtac | ring ]. apply Rle_trans with (Rabs (p - (x + y)) + Rabs (x + y))%R. pattern (FtoRradix p) at 1 in |- *; replace (FtoRradix p) with (p - (x + y) + (x + y))%R; [ apply Rabs_triang | ring ]. rewrite (Rplus_comm (Rabs (p - (x + y))) (Rabs (x + y))); rewrite (Rplus_comm (Rabs p * (radix * / (2%nat * pPred (vNum b)))) (Rabs (x + y))) ; apply Rplus_le_compat_l. replace (Rabs p * (radix * / (2%nat * pPred (vNum b))))%R with (Rabs p * / 2%nat * (radix * / pPred (vNum b)))%R; [ apply plusErrorBound1withZero | idtac ]; auto. rewrite (Rinv_mult_distr 2%nat (pPred (vNum b))); auto with real zarith. ring. apply NEq_IZRO; auto with real zarith. generalize pPredMoreThanOne; auto with zarith. Qed. Theorem plusExactExp : forall p q pq : float, Fbounded b p -> Fbounded b q -> Closest b radix (p + q) pq -> ex (fun r : float => ex (fun s : float => Fbounded b r /\ Fbounded b s /\ s = pq :>R /\ r = (p + q - s)%R :>R /\ Fexp r = Z.min (Fexp p) (Fexp q) :>Z /\ (Fexp r <= Fexp s)%Z /\ (Fexp s <= Z.succ (Zmax (Fexp p) (Fexp q)))%Z)). intros p q pq H H0 H1. case (plusExpBound b radix precision) with (P := Closest b radix) (5 := H1); auto with zarith. apply (ClosestRoundedModeP b radix precision); auto with zarith. intros r (H2, (H3, (H4, H5))); fold FtoRradix in H3. case (Req_dec (p + q - pq) 0); intros Hr. cut (Fbounded b (Fzero (Z.min (Fexp p) (Fexp q)))); [ intros Fbs | idtac ]. exists (Fzero (Z.min (Fexp p) (Fexp q))); exists r; repeat (split; auto). rewrite (FzeroisReallyZero radix); rewrite <- Hr; rewrite <- H3; auto. case (Zmin_or (Fexp p) (Fexp q)); intros Hz; rewrite Hz; apply FboundedZeroSameExp; auto. case (errorBoundedPlus p q pq); auto. intros error (H6, (H7, H8)). exists error; exists r; repeat (split; auto). rewrite H3; auto. rewrite H8; auto. Qed. Theorem plusExactExpCanonic : forall c d p q : float, Fbounded b c -> Fbounded b d -> Fbounded b p -> Fbounded b q -> Closest b radix (c + d) p -> q = (c + d - p)%R :>R -> q <> 0%R :>R -> ex (fun r : float => ex (fun s : float => Fcanonic radix b s /\ Fbounded b r /\ s = p :>R /\ r = (c + d - s)%R :>R /\ Fexp r = Z.min (Fexp c) (Fexp d) :>Z /\ (Fexp r < Fexp s)%Z /\ (Fexp s <= Z.succ (Zmax (Fexp c) (Fexp d)))%Z)). intros c d p q H H0 H1 H2 H3 H4 H5. case (plusExactExp c d p); auto. intros r (s, (H6, (H7, (H8, (H9, (H10, (H11, H12))))))). exists r; exists (Fnormalize radix b precision s). repeat (split; auto with float). apply FnormalizeCanonic; auto with arith. rewrite <- H8; apply (FnormalizeCorrect radix); auto with zarith. rewrite (FnormalizeCorrect radix); auto with zarith. apply ClosestErrorExpStrict with (radix := radix) (b := b) (precision := precision) (x := (c + d)%R); auto with float. apply FnormalizeBounded; auto with arith. apply (ClosestCompatible b radix (c + d)%R (c + d)%R p); auto. rewrite (FnormalizeCorrect radix); auto with zarith. apply FnormalizeBounded; auto with arith. rewrite (FnormalizeCorrect radix); auto with zarith. fold FtoRradix in |- *; rewrite H9; rewrite H8; rewrite <- H4; auto. apply Z.le_trans with (Fexp s); auto. apply FcanonicLeastExp with radix b precision; auto with arith. apply sym_eq; apply FnormalizeCorrect; auto with real. apply FnormalizeCanonic; auto with arith. Qed. End ClosestP. float-8.10.0/ClosestProp.v000066400000000000000000000666511357127175600154050ustar00rootroot00000000000000(**************************************************************************** IEEE754 : ClosestProp Laurent Thery, Sylvie Boldo ******************************************************************************) Require Export FroundProp. Require Export Closest. Section Fclosestp2. Variable b : Fbound. Variable radix : Z. Variable precision : 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 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem ClosestOpp : forall (p : float) (r : R), Closest b radix r p -> Closest b radix (- r) (Fopp p). intros p r H'; split. apply oppBounded; auto. case H'; auto. intros f H'0. rewrite Fopp_correct. replace (- FtoR radix p - - r)%R with (- (FtoR radix p - r))%R; [ idtac | ring ]. replace (FtoR radix f - - r)%R with (- (- FtoR radix f - r))%R; [ idtac | ring ]. rewrite <- Fopp_correct. repeat rewrite Rabs_Ropp. case H'; auto with float. Qed. Theorem ClosestFabs : forall (p : float) (r : R), Closest b radix r p -> Closest b radix (Rabs r) (Fabs p). intros p r H'; case (Rle_or_lt 0 r); intros Rl0. rewrite Rabs_right; auto with real. replace (Fabs p) with p; auto. unfold Fabs in |- *; apply floatEq; simpl in |- *; auto. cut (0 <= Fnum p)%Z. case (Fnum p); simpl in |- *; auto; intros p' H0; Contradict H0; apply Zlt_not_le; red in |- *; simpl in |- *; auto with zarith. apply LeR0Fnum with (radix := radix); auto. apply RleRoundedR0 with (b := b) (precision := precision) (P := Closest b radix) (r := r); auto. apply ClosestRoundedModeP with (precision := precision); auto with real. rewrite Faux.Rabsolu_left1; auto. replace (Fabs p) with (Fopp p). apply ClosestOpp; auto. unfold Fabs in |- *; apply floatEq; simpl in |- *; auto. cut (Fnum p <= 0)%Z. case (Fnum p); simpl in |- *; auto; intros p' H0; Contradict H0; apply Zlt_not_le; red in |- *; simpl in |- *; auto with zarith. apply R0LeFnum with (radix := radix); auto. apply RleRoundedLessR0 with (b := b) (precision := precision) (P := Closest b radix) (r := r); auto. apply ClosestRoundedModeP with (precision := precision); auto. apply Rlt_le; auto. apply Rlt_le; auto. Qed. Theorem ClosestUlp : forall (p : R) (q : float), Closest b radix p q -> (2%nat * Rabs (p - q) <= Fulp b radix precision q)%R. intros p q H'. case (Req_dec p q); intros Eqpq. rewrite Eqpq. replace (Rabs (q - q)) with 0%R; [ rewrite Rmult_0_r | replace (q - q)%R with 0%R; try ring; rewrite Rabs_right; auto with real ]. unfold Fulp in |- *; apply Rlt_le; auto with real arith. replace (2%nat * Rabs (p - q))%R with (Rabs (p - q) + Rabs (p - q))%R; [ idtac | simpl in |- *; ring ]. case ClosestMinOrMax with (1 := H'); intros H'1. apply Rle_trans with (Rabs (p - q) + Rabs (FNSucc b radix precision q - p))%R. apply Rplus_le_compat_l. rewrite <- (Rabs_Ropp (p - q)). rewrite Ropp_minus_distr. elim H'; auto. intros H'0 H'2; apply H'2; auto. apply FcanonicBound with (radix := radix); auto with float arith. rewrite Rabs_right. rewrite Rabs_right. replace (p - q + (FNSucc b radix precision q - p))%R with (FNSucc b radix precision q - q)%R; [ idtac | ring ]. unfold FtoRradix in |- *; apply FulpSuc; auto. case H'1; auto. apply Rge_minus; apply Rle_ge; auto with real float. case MinMax with (3 := pGivesBound) (r := p) (p := q); auto with arith. intros H'0 H'2; elim H'2; intros H'3 H'4; apply H'3; clear H'2; auto. apply Rge_minus; apply Rle_ge; auto with real float. apply isMin_inv1 with (1 := H'1). apply Rle_trans with (Rabs (p - q) + Rabs (p - FNPred b radix precision q))%R. apply Rplus_le_compat_l. rewrite <- (Rabs_Ropp (p - q)); rewrite <- (Rabs_Ropp (p - FNPred b radix precision q)). repeat rewrite Ropp_minus_distr. elim H'; auto. intros H'0 H'2; apply H'2; auto. apply FcanonicBound with (radix := radix); auto with float arith. rewrite <- (Rabs_Ropp (p - q)); rewrite Ropp_minus_distr. rewrite Rabs_right. rewrite Rabs_right. replace (q - p + (p - FNPred b radix precision q))%R with (q - FNPred b radix precision q)%R; [ idtac | ring ]. unfold FtoRradix in |- *; apply FulpPred; auto. case H'1; auto. apply Rge_minus; apply Rle_ge; auto with real float. case MaxMin with (3 := pGivesBound) (r := p) (p := q); auto with arith. intros H'0 H'2; elim H'2; intros H'3 H'4; apply H'3; clear H'2; auto. apply Rge_minus; apply Rle_ge; auto with real float. apply isMax_inv1 with (1 := H'1). Qed. Theorem ClosestExp : forall (p : R) (q : float), Closest b radix p q -> (2%nat * Rabs (p - q) <= powerRZ radix (Fexp q))%R. intros p q H'. apply Rle_trans with (Fulp b radix precision q). apply (ClosestUlp p q); auto. replace (powerRZ radix (Fexp q)) with (FtoRradix (Float 1%nat (Fexp q))). apply (FulpLe b radix); auto. apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := p); auto. apply ClosestRoundedModeP with (precision := precision); auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. ring. Qed. Theorem ClosestErrorExpStrict : forall (p q : float) (x : R), Fbounded b p -> Fbounded b q -> Closest b radix x p -> q = (x - p)%R :>R -> q <> 0%R :>R -> (Fexp q < Fexp p)%Z. intros. case (Zle_or_lt (Fexp p) (Fexp q)); auto; intros Z1. absurd (powerRZ radix (Fexp p) <= powerRZ radix (Fexp q))%R. 2: apply Rle_powerRZ; auto with real arith. apply Rgt_not_le. red in |- *; apply Rlt_le_trans with (2%nat * powerRZ radix (Fexp q))%R. apply Rltdouble; auto with real arith. apply Rle_trans with (2%nat * Fabs q)%R. apply Rmult_le_compat_l; auto with real arith. replace 0%R with (INR 0); auto with real arith. replace (powerRZ radix (Fexp q)) with (FtoRradix (Float 1%nat (Fexp q))); auto. apply (Fop.RleFexpFabs radix); auto with real zarith. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. rewrite (Fabs_correct radix); auto with arith. replace (FtoR radix q) with (x - p)%R; auto. apply ClosestExp; auto. Qed. Theorem ClosestIdem : forall p q : float, Fbounded b p -> Closest b radix p q -> p = q :>R. intros p q H' H'0. case (Rabs_pos (q - p)); intros H1. Contradict H1; apply Rle_not_lt. replace 0%R with (Rabs (p - p)); [ case H'0; auto | idtac ]. replace (p - p)%R with 0%R; [ apply Rabs_R0; auto | ring ]. apply Rplus_eq_reg_l with (r := (- p)%R). apply trans_eq with 0%R; [ ring | idtac ]. apply trans_eq with (q - p)%R; [ idtac | ring ]. generalize H1; unfold Rabs in |- *; case (Rcase_abs (q - p)); auto. intros r H0; replace 0%R with (-0)%R; [ rewrite H0 | idtac ]; ring. Qed. Theorem ClosestM1 : forall (r1 r2 : R) (min max p q : float), isMin b radix r1 min -> isMax b radix r1 max -> (min + max < 2%nat * r2)%R -> Closest b radix r1 p -> Closest b radix r2 q -> (p <= q)%R. intros r1 r2 min max p q H' H'0 H'1 H'2 H'3. case (Rle_or_lt r2 max); intros H'4. 2: apply (ClosestMonotone b radix) with (p := r1) (q := r2); auto. 2: apply Rle_lt_trans with (FtoRradix max); auto. 2: apply isMax_inv1 with (1 := H'0). case H'4; clear H'4; intros H'4. 2: replace (FtoRradix q) with (FtoRradix max). 2: case ClosestMinOrMax with (1 := H'2); intros H'5. 2: replace (FtoRradix p) with (FtoRradix min). 2: apply Rle_trans with r1. 2: apply isMin_inv1 with (1 := H'). 2: apply isMax_inv1 with (1 := H'0). 2: apply MinEq with (1 := H'); auto. 2: replace (FtoRradix p) with (FtoRradix max); auto with real. 2: apply MaxEq with (1 := H'0); auto. 2: apply ClosestIdem; auto. 2: case H'0; auto. 2: rewrite <- H'4; auto. cut (min < r2)%R. 2: apply Rmult_lt_reg_l with (r := INR 2); auto with real. 2: replace (2%nat * min)%R with (min + min)%R; [ idtac | simpl in |- *; ring ]. 2: apply Rle_lt_trans with (2 := H'1). 2: apply Rplus_le_compat_l; auto with real. 2: apply Rle_trans with r1. 2: apply isMin_inv1 with (1 := H'). 2: apply isMax_inv1 with (1 := H'0). intros H'5. replace (FtoRradix q) with (FtoRradix max). case ClosestMinOrMax with (1 := H'2); intros H'6. replace (FtoRradix p) with (FtoRradix min). apply Rle_trans with r1. apply isMin_inv1 with (1 := H'). apply isMax_inv1 with (1 := H'0). apply MinEq with (1 := H'); auto. replace (FtoRradix p) with (FtoRradix max); auto with real. apply MaxEq with (1 := H'0); auto. apply sym_eq. apply (ClosestMaxEq b radix) with (r := r2) (min := min); auto. apply isMinComp with (2 := H'0); auto. apply isMaxComp with (1 := H'); auto. Qed. Theorem FmultRadixInv : forall (x z : float) (y : R), Fbounded b x -> Closest b radix y z -> (/ 2%nat * x < y)%R -> (/ 2%nat * x <= z)%R. intros x z y H' H'0 H'1. case MinEx with (r := (/ 2%nat * x)%R) (3 := pGivesBound); auto with arith. intros min isMin. case MaxEx with (r := (/ 2%nat * x)%R) (3 := pGivesBound); auto with arith. intros max isMax. case (Rle_or_lt y max); intros Rl1. case Rl1; clear Rl1; intros Rl1. replace (FtoRradix z) with (FtoRradix max). apply isMax_inv1 with (1 := isMax). apply sym_eq. unfold FtoRradix in |- *; apply ClosestMaxEq with (b := b) (r := y) (min := min); auto. apply isMinComp with (r1 := (/ 2%nat * x)%R) (max := max); auto. apply Rle_lt_trans with (2 := H'1); auto. apply isMin_inv1 with (1 := isMin). apply isMaxComp with (r1 := (/ 2%nat * x)%R) (min := min); auto. apply Rle_lt_trans with (2 := H'1); auto. apply isMin_inv1 with (1 := isMin). replace (FtoR radix min + FtoR radix max)%R with (FtoRradix x). apply Rmult_lt_reg_l with (r := (/ 2%nat)%R); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_l; try rewrite Rmult_1_l; auto with real. unfold FtoRradix in |- *; apply (div2IsBetween b radix precision); auto. cut (Closest b radix max z); [ intros C0 | idtac ]. replace (FtoRradix z) with (FtoRradix max); auto. rewrite <- Rl1; auto. apply Rlt_le; auto. apply ClosestIdem; auto. case isMax; auto. apply (ClosestCompatible b radix y max z z); auto. case H'0; auto. apply Rle_trans with (FtoRradix max); auto. apply isMax_inv1 with (1 := isMax). apply (ClosestMonotone b radix (FtoRradix max) y); auto. apply (RoundedModeProjectorIdem b radix (Closest b radix)); auto. apply ClosestRoundedModeP with (precision := precision); auto. case isMax; auto. Qed. Theorem ClosestErrorBound : forall (p q : float) (x : R), Fbounded b p -> Closest b radix x p -> q = (x - p)%R :>R -> (Rabs q <= Float 1%nat (Fexp p) * / 2%nat)%R. intros p q x H H0 H1. apply Rle_trans with (Fulp b radix precision p * / 2%nat)%R. rewrite H1. replace (Rabs (x - p)) with (2%nat * Rabs (x - p) * / 2%nat)%R; [ idtac | field; auto with real ]. apply Rmult_le_compat_r; auto with real. apply ClosestUlp; auto. apply Rmult_le_compat_r. apply Rlt_le. apply Rinv_0_lt_compat; auto with real. unfold FtoRradix in |- *; apply FulpLe; auto. Qed. Theorem ClosestErrorExp : forall (p q : float) (x : R), Fbounded b p -> Fbounded b q -> Closest b radix x p -> q = (x - p)%R :>R -> exists error : float, Fbounded b error /\ error = q :>R /\ (Fexp error <= Zmax (Fexp p - precision) (- dExp b))%Z. intros p q x H H0 H1 H2; exists (Fnormalize radix b precision q). cut (Fcanonic radix b (Fnormalize radix b precision q)); [ intros C1 | apply FnormalizeCanonic; auto with arith ]. split. apply FcanonicBound with (radix := radix); auto. split. apply (FnormalizeCorrect radix); auto. case C1; intros C2. apply Z.le_trans with (Fexp p - precision)%Z; auto with zarith. apply Zplus_le_reg_l with (Z_of_nat precision). replace (precision + (Fexp p - precision))%Z with (Fexp p); [ idtac | ring ]. replace (precision + Fexp (Fnormalize radix b precision q))%Z with (Z.succ (Z.pred precision + Fexp (Fnormalize radix b precision q))); [ idtac | unfold Z.pred, Z.succ in |- *; ring ]. apply Zlt_le_succ. apply Zlt_powerRZ with (IZR radix); auto with real zarith. rewrite powerRZ_add; auto with real zarith. apply Rle_lt_trans with (Z.abs (Fnum (Fnormalize radix b precision q)) * powerRZ radix (Fexp (Fnormalize radix b precision q)))%R. apply Rmult_le_compat_r; auto with real zarith. replace (Z.pred precision) with (Z_of_nat (pred (digit radix (Fnum (Fnormalize radix b precision q))))). rewrite <- Zpower_nat_Z_powerRZ. apply Rle_IZR; apply digitLess; auto with real zarith. change (~ is_Fzero (Fnormalize radix b precision q)) in |- *; apply (FnormalNotZero radix b); auto with float. change (Z_of_nat (pred (Fdigit radix (Fnormalize radix b precision q))) = Z.pred precision) in |- *. rewrite FnormalPrecision with (precision := precision) (4 := C2); auto with zarith arith. apply inj_pred; auto with arith. change (Fabs (Fnormalize radix b precision q) < powerRZ radix (Fexp p))%R in |- *. rewrite (Fabs_correct radix); auto; rewrite (FnormalizeCorrect radix); auto. apply Rle_lt_trans with (Float 1%nat (Fexp p) * / 2%nat)%R. apply ClosestErrorBound with (x := x); auto. unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *. pattern (powerRZ radix (Fexp p)) at 2 in |- *; replace (powerRZ radix (Fexp p)) with (powerRZ radix (Fexp p) * 1)%R; [ idtac | ring ]. replace (1 * powerRZ radix (Fexp p))%R with (powerRZ radix (Fexp p)); [ apply Rmult_lt_compat_l | ring ]. apply powerRZ_lt; auto with arith real. pattern 1%R at 3 in |- *; replace 1%R with (/ 1)%R. apply Rinv_1_lt_contravar; auto with real. replace 2%R with (INR 2); auto with real arith. apply Z.le_trans with (- dExp b)%Z; auto with float zarith. case C2. intros H3 (H4, H5); rewrite H4; auto with zarith. Qed. Theorem ClosestErrorBoundNormal_aux : forall (x : R) (p : float), Closest b radix x p -> Fnormal radix b (Fnormalize radix b precision p) -> (Rabs (x - p) <= Rabs p * (/ 2%nat * (radix * / Zpos (vNum b))))%R. intros x p H H'. apply Rle_trans with (/ 2%nat * Fulp b radix precision p)%R. replace (Rabs (x - FtoRradix p)) with (/ 2%nat * (2%nat * Rabs (x - FtoRradix p)))%R. apply Rmult_le_compat_l; auto with real. apply ClosestUlp; auto. rewrite <- Rmult_assoc; rewrite Rinv_l; simpl in |- *; auto with real. apply Rle_trans with (/ 2%nat * (Rabs p * (radix * / Zpos (vNum b))))%R; [ apply Rmult_le_compat_l | right; ring; ring ]. apply Rlt_le; apply Rinv_0_lt_compat; auto with real arith. unfold Fulp in |- *. replace (Fexp (Fnormalize radix b precision p)) with (Fexp (Fnormalize radix b precision p) + precision + - precision)%Z; [ idtac | ring ]. rewrite powerRZ_add; auto with real zarith. apply Rle_trans with (Rabs p * radix * powerRZ radix (- precision))%R; [ apply Rmult_le_compat_r | right ]; auto with real zarith. 2: rewrite pGivesBound; simpl in |- *. 2: rewrite powerRZ_Zopp; auto with real zarith; rewrite Zpower_nat_Z_powerRZ; auto with real zarith; ring. replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)); [ idtac | apply (FnormalizeCorrect radix) ]; auto. rewrite <- (Fabs_correct radix); unfold FtoR in |- *; simpl in |- *; auto with arith. rewrite powerRZ_add; auto with real zarith. replace (Z.abs (Fnum (Fnormalize radix b precision p)) * powerRZ radix (Fexp (Fnormalize radix b precision p)) * radix)%R with (powerRZ radix (Fexp (Fnormalize radix b precision p)) * (Z.abs (Fnum (Fnormalize radix b precision p)) * radix))%R; [ idtac | ring ]. apply Rmult_le_compat_l; auto with arith real. rewrite <- Zpower_nat_Z_powerRZ; auto with real zarith. rewrite <- Rmult_IZR; apply Rle_IZR. rewrite <- pGivesBound; pattern radix at 2 in |- *; rewrite <- (Z.abs_eq radix); auto with zarith. rewrite <- Zabs_Zmult. rewrite Zmult_comm; elim H'; auto. Qed. Theorem ClosestErrorBound2 : forall (x : R) (p : float), Closest b radix x p -> (Rabs (x - p) <= Rmax (Rabs p * (/ 2%nat * (radix * / Zpos (vNum b)))) (/ 2%nat * powerRZ radix (- dExp b)))%R. intros x p H. cut (Fcanonic radix b (Fnormalize radix b precision p)); [ intros tmp; Casec tmp; intros Fs | idtac ]. 3: apply FnormalizeCanonic; auto with arith. 3: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := x); auto. 3: apply ClosestRoundedModeP with (precision := precision); auto. apply Rle_trans with (Rabs p * (/ 2%nat * (radix * / Zpos (vNum b))))%R; [ idtac | apply RmaxLess1 ]. apply ClosestErrorBoundNormal_aux; auto. apply Rle_trans with (/ 2%nat * Fulp b radix precision p)%R. replace (Rabs (x - FtoRradix p)) with (/ 2%nat * (2%nat * Rabs (x - FtoRradix p)))%R. apply Rmult_le_compat_l; auto with real. apply ClosestUlp; auto. rewrite <- Rmult_assoc; rewrite Rinv_l; simpl in |- *; auto with real. elim Fs; intros H1 H2; elim H2; intros; clear H2. unfold Fulp in |- *; rewrite H0; apply RmaxLess2. Qed. Theorem ClosestErrorBoundNormal : forall (x : R) (p : float), Closest b radix x p -> Fnormal radix b (Fnormalize radix b precision p) -> (Rabs (x - p) <= Rabs p * (/ 2%nat * powerRZ radix (Z.succ (- precision))))%R. intros x p H H1. apply Rle_trans with (Rabs (FtoRradix p) * (/ 2%nat * (radix * / Zpos (vNum b))))%R; [ apply ClosestErrorBoundNormal_aux; auto | right ]. replace (powerRZ radix (Z.succ (- precision))) with (radix * / Zpos (vNum b))%R; auto with real. rewrite pGivesBound; rewrite Zpower_nat_Z_powerRZ. rewrite Rinv_powerRZ; auto with real zarith. rewrite powerRZ_Zs; auto with real zarith. Qed. Theorem ClosestPropHigham25 : forall (x : R) (p : float), Closest b radix x p -> exists delta : R, (exists nu : R, (x / (1 + delta) + nu)%R = FtoRradix p /\ (Rabs delta <= / 2%nat * powerRZ radix (Z.succ (- precision)))%R /\ (Rabs nu <= / 2%nat * powerRZ radix (- dExp b))%R /\ (delta * nu)%R = 0%R /\ (Fnormal radix b (Fnormalize radix b precision p) -> nu = 0%R) /\ (Fsubnormal radix b (Fnormalize radix b precision p) -> delta = 0%R)). intros x p H. cut (Fcanonic radix b (Fnormalize radix b precision p)); [ intros tmp; Casec tmp; intros Fs | idtac ]. 3: apply FnormalizeCanonic; auto with arith. 3: apply RoundedModeBounded with (radix := radix) (P := Closest b radix) (r := x); auto. 3: apply ClosestRoundedModeP with (precision := precision); auto. cut (~ is_Fzero (Fnormalize radix b precision p)); [ unfold is_Fzero in |- *; intros tmp | apply FnormalNotZero with radix b; auto ]. cut (FtoRradix p <> 0%R); [ intros H1; clear tmp | unfold FtoRradix in |- * ]. 2: rewrite <- FnormalizeCorrect with radix b precision p; auto; unfold FtoR in |- *; simpl in |- *. 2: apply Rmult_integral_contrapositive; split; auto with real zarith. exists ((x - p) / p)%R; exists 0%R. split; [ case (Req_dec x 0); intros H2 | idtac ]. repeat rewrite H2; unfold Rdiv in |- *. ring_simplify. rewrite <- FzeroisZero with radix b; unfold FtoRradix in |- *. cut (ProjectorP b radix (Closest b radix)); [ unfold ProjectorP in |- *; intros H3 | apply RoundedProjector; auto with float ]. apply H3; auto with float zarith. replace (FtoR radix (Fzero (- dExp b))) with x; auto with real. rewrite H2; unfold Fzero, FtoR in |- *; simpl in |- *; ring. apply ClosestRoundedModeP with precision; auto with zarith. apply sym_eq; apply trans_eq with (x / (1 + (x - p) / p))%R; [ idtac | ring ]. replace (1 + (x - FtoRradix p) / FtoRradix p)%R with (x / p)%R; unfold Rdiv in |- *. rewrite Rinv_mult_distr; auto with real; rewrite Rinv_involutive; auto; rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real. ring_simplify; rewrite Rinv_l; auto with real; ring. split. apply Rmult_le_reg_l with (Rabs p); [ apply Rabs_pos_lt; auto | idtac ]. apply Rle_trans with (Rabs (x - FtoRradix p)); [ right | apply ClosestErrorBoundNormal; auto ]. unfold Rdiv in |- *; rewrite Rabs_mult; rewrite Rabs_Rinv; auto. rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l; auto with real. apply Rabs_no_R0; exact H1. split; [ rewrite Rabs_R0; apply Rmult_le_pos; auto with real zarith | idtac ]. split; [ ring | idtac ]. split; [ auto with real | intros H2 ]. absurd (Fnormal radix b (Fnormalize radix b precision p) /\ Fsubnormal radix b (Fnormalize radix b precision p)). apply NormalNotSubNormal; auto. split; auto. exists 0%R; exists (p - x)%R. split; [ unfold Rdiv in |- *; ring_simplify (1 + 0)%R; rewrite Rinv_1; ring | idtac ]. split; [ rewrite Rabs_R0; apply Rmult_le_pos; auto with real zarith | idtac ]. split. apply Rle_trans with (/ 2%nat * Fulp b radix precision p)%R. rewrite <- Rabs_Ropp; replace (- (FtoRradix p - x))%R with (x - FtoRradix p)%R; [ idtac | ring ]. replace (Rabs (x - FtoRradix p)) with (/ 2%nat * (2%nat * Rabs (x - FtoRradix p)))%R. apply Rmult_le_compat_l; auto with real; apply ClosestUlp; auto. rewrite <- Rmult_assoc; rewrite Rinv_l; simpl in |- *; auto with real. elim Fs; intros H1 H2; elim H2; intros; clear H2. unfold Fulp in |- *; rewrite H0; auto with real. split; [ ring | idtac ]. split; [ intros H2 | auto with real ]. absurd (Fnormal radix b (Fnormalize radix b precision p) /\ Fsubnormal radix b (Fnormalize radix b precision p)). apply NormalNotSubNormal; auto. split; auto. Qed. Theorem FpredUlpPos : forall x : float, Fcanonic radix b x -> (0 < x)%R -> (FPred b radix precision x + Fulp b radix precision (FPred b radix precision x))%R = x. intros x Hx H. apply sym_eq; apply Rplus_eq_reg_l with (- FtoRradix (FPred b radix precision x))%R. apply trans_eq with (Fulp b radix precision (FPred b radix precision x)); [ idtac | ring ]. apply trans_eq with (FtoRradix x - FtoRradix (FPred b radix precision x))%R; [ ring | idtac ]. unfold FtoRradix in |- *; rewrite <- Fminus_correct; auto with zarith; fold FtoRradix in |- *. pattern x at 1 in |- *; replace x with (FSucc b radix precision (FPred b radix precision x)); [ idtac | apply FSucPred; auto with zarith arith ]. unfold FtoRradix in |- *; apply FSuccUlpPos; auto with zarith arith. apply FPredCanonic; auto with zarith arith. apply R0RltRlePred; auto with zarith arith real. Qed. Theorem FulpFPredLe : forall f : float, Fbounded b f -> Fcanonic radix b f -> (Fulp b radix precision f <= radix * Fulp b radix precision (FPred b radix precision f))%R. intros f Hf1 Hf2; unfold Fulp in |- *. replace (Fnormalize radix b precision f) with f; [ idtac | apply FcanonicUnique with (radix := radix) (b := b) (precision := precision); auto with float arith zarith ]. 2: apply sym_eq; apply FnormalizeCorrect; auto with arith zarith. replace (Fnormalize radix b precision (FPred b radix precision f)) with (FPred b radix precision f); [ idtac | apply FcanonicUnique with (radix := radix) (b := b) (precision := precision); auto with float arith zarith ]. 2: apply sym_eq; apply FnormalizeCorrect; auto with arith zarith. pattern (IZR radix) at 2 in |- *; replace (IZR radix) with (powerRZ radix 1); [ idtac | simpl in |- *; auto with arith zarith real ]. rewrite <- powerRZ_add; auto with zarith real. apply Rle_powerRZ; auto with zarith real. replace (1 + Fexp (FPred b radix precision f))%Z with (Z.succ (Fexp (FPred b radix precision f))); auto with zarith. unfold FPred in |- *. generalize (Z_eq_bool_correct (Fnum f) (- pPred (vNum b))); case (Z_eq_bool (Fnum f) (- pPred (vNum b))); intros H1; [ simpl in |- *; auto with zarith | idtac ]. generalize (Z_eq_bool_correct (Fnum f) (nNormMin radix precision)); case (Z_eq_bool (Fnum f) (nNormMin radix precision)); intros H2; [ idtac | simpl in |- *; auto with zarith ]. generalize (Z_eq_bool_correct (Fexp f) (- dExp b)); case (Z_eq_bool (Fexp f) (- dExp b)); intros H3; simpl in |- *; auto with zarith. Qed. Theorem ClosestErrorBoundNormal2_aux : forall (x : R) (p : float), Closest b radix x p -> Fnormal radix b p -> Fnormal radix b (Fnormalize radix b precision (FPred b radix precision p)) -> (0 < x)%R -> (x < p)%R -> (Rabs (x - p) <= Rabs x * (/ 2%nat * powerRZ radix (Z.succ (- precision))))%R. intros x p H1 H2 H0 H3 H4. cut (Fcanonic radix b p); [ intros H5 | left; auto ]. cut (Fbounded b p); [ intros H6 | elim H2; auto ]. cut (0 < p)%R; [ intros H7 | apply Rlt_trans with x; auto ]. cut (FPred b radix precision p < x)%R; [ intros H' | idtac ]. apply Rle_trans with (/ 2%nat * Fulp b radix precision (FPred b radix precision p))%R. case (Rle_or_lt (Rabs (x - FtoRradix p)) (/ 2%nat * Fulp b radix precision (FPred b radix precision p))); auto; intros H8. absurd (Rabs (p - x) <= Rabs (FPred b radix precision p - x))%R. 2: generalize H1; unfold Closest in |- *; intros H9; elim H9; intros tmp H10. 2: clear tmp; apply H10; auto with float zarith arith. apply Rlt_not_le; rewrite Rabs_left; auto with real. apply Rle_lt_trans with (p - FPred b radix precision p + (x - p))%R; [ right; ring | idtac ]. pattern (FtoRradix p) at 1 in |- *; rewrite <- FpredUlpPos with p; auto with real. apply Rle_lt_trans with (Fulp b radix precision (FPred b radix precision p) + (x - p))%R; [ right; ring | idtac ]. apply Rle_lt_trans with (Fulp b radix precision (FPred b radix precision p) + - (/ 2%nat * Fulp b radix precision (FPred b radix precision p)))%R; [ apply Rplus_le_compat_l | idtac ]. apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite <- Rabs_left; auto with real. apply Rle_lt_trans with (/ 2%nat * Fulp b radix precision (FPred b radix precision p))%R. right; apply trans_eq with ((1 + - / 2%nat) * Fulp b radix precision (FPred b radix precision p))%R; [ ring | idtac ]. replace (1 + - / 2%nat)%R with (/ 2%nat)%R; [ ring | simpl; field; auto with arith real; simpl in |- *; ring ]. rewrite <- Rabs_Ropp; replace (- (FtoRradix p - x))%R with (x - p)%R; auto; ring. apply Rle_trans with (/ 2%nat * (Rabs x * powerRZ radix (Z.succ (- precision))))%R; [ apply Rmult_le_compat_l; auto with real arith | right; ring ]. apply Rle_trans with (Rabs (FPred b radix precision p) * powerRZ radix (Z.succ (- precision)))%R. unfold Fulp in |- *; replace (Fexp (Fnormalize radix b precision (FPred b radix precision p))) with (Fexp (Fnormalize radix b precision (FPred b radix precision p)) + precision + - precision)%Z; [ idtac | ring ]. rewrite powerRZ_add; auto with real zarith. apply Rle_trans with (Rabs (FPred b radix precision p) * radix * powerRZ radix (- precision))%R; [ apply Rmult_le_compat_r | right ]; auto with real zarith. 2: rewrite powerRZ_Zs; auto with real zarith; ring. replace (FtoRradix (FPred b radix precision p)) with (FtoRradix (Fnormalize radix b precision (FPred b radix precision p))); [ idtac | apply (FnormalizeCorrect radix) ]; auto. rewrite <- (Fabs_correct radix); unfold FtoR in |- *; simpl in |- *; auto with arith. rewrite powerRZ_add; auto with real zarith. apply Rle_trans with (powerRZ radix (Fexp (Fnormalize radix b precision (FPred b radix precision p))) * (Z.abs (Fnum (Fnormalize radix b precision (FPred b radix precision p))) * radix))%R; [ idtac | right; ring ]. apply Rmult_le_compat_l; auto with arith real. rewrite <- Zpower_nat_Z_powerRZ; auto with real zarith; rewrite <- Rmult_IZR. apply Rle_IZR; rewrite <- pGivesBound; pattern radix at 3 in |- *; rewrite <- (Z.abs_eq radix); auto with zarith; rewrite <- Zabs_Zmult; rewrite Zmult_comm; elim H0; auto. apply Rmult_le_compat_r; auto with real zarith. repeat rewrite Rabs_right; auto with real; apply Rle_ge; auto with real. unfold FtoRradix in |- *; apply R0RltRlePred; auto with real arith. case (Rle_or_lt 0 (FtoRradix (FPred b radix precision p) - x)); intros H9. absurd (Rabs (p - x) <= Rabs (FPred b radix precision p - x))%R. apply Rlt_not_le; repeat rewrite Rabs_right; try apply Rle_ge; auto with real. unfold Rminus in |- *; apply Rplus_lt_compat_r; auto with real float zarith. unfold FtoRradix in |- *; apply FPredLt; auto with real float zarith. generalize H1; unfold Closest in |- *; intros H'; elim H'; intros tmp H10. clear tmp; apply H10; auto with float zarith arith. apply Rplus_lt_reg_l with (- x)%R; auto with real. ring_simplify (- x + x)%R; apply Rle_lt_trans with (2 := H9); right; ring. Qed. End Fclosestp2. Hint Resolve ClosestOpp ClosestFabs ClosestUlp: float.float-8.10.0/Digit.v000066400000000000000000000275471357127175600141710ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Digit Laurent Thery ***************************************************************************** Gives the number of digits necessary to write a number in a given base *) Require Export ZArithRing. Require Export Omega. Require Export Faux. Section Pdigit. (* n is the base *) Variable n : Z. (* and it is greater or equal to 2 *) Hypothesis nMoreThan1 : (1 < n)%Z. Let nMoreThanOne := Zlt_1_O _ (Zlt_le_weak _ _ nMoreThan1). Hint Resolve nMoreThanOne: zarith. Theorem Zpower_nat_less : forall q : nat, (0 < Zpower_nat n q)%Z. intros q; elim q; simpl in |- *; auto with zarith. Qed. Hint Resolve Zpower_nat_less: zarith. Theorem Zpower_nat_monotone_S : forall p : nat, (Zpower_nat n p < Zpower_nat n (S p))%Z. intros p; rewrite <- (Zmult_1_l (Zpower_nat n p)); replace (S p) with (1 + p); [ rewrite Zpower_nat_is_exp | auto with zarith ]. rewrite Zpower_nat_1; auto with zarith. apply Zmult_gt_0_lt_compat_r; auto with zarith. apply Z.lt_gt; auto with zarith. Qed. Theorem Zpower_nat_monotone_lt : forall p q : nat, p < q -> (Zpower_nat n p < Zpower_nat n q)%Z. intros p q H'; elim H'; simpl in |- *; auto. apply Zpower_nat_monotone_S. intros m H H0; apply Z.lt_trans with (1 := H0). apply Zpower_nat_monotone_S. Qed. Hint Resolve Zpower_nat_monotone_lt: zarith. Theorem Zpower_nat_anti_monotone_lt : forall p q : nat, (Zpower_nat n p < Zpower_nat n q)%Z -> p < q. intros p q H'. case (le_or_lt q p); auto; (intros H'1; generalize H'; case H'1). intros H'0; Contradict H'0; auto with zarith. intros m H'0 H'2; Contradict H'2; auto with zarith. Qed. Theorem Zpower_nat_monotone_le : forall p q : nat, p <= q -> (Zpower_nat n p <= Zpower_nat n q)%Z. intros p q H'; case (le_lt_or_eq _ _ H'); auto with zarith. intros H1; rewrite H1; auto with zarith. Qed. Theorem Zpower_nat_anti_monotone_le : forall p q : nat, (Zpower_nat n p <= Zpower_nat n q)%Z -> p <= q. intros p q H'; case (le_or_lt p q); intros H'0; auto with arith. Contradict H'; auto with zarith. Qed. Theorem Zpower_nat_anti_eq : forall p q : nat, Zpower_nat n p = Zpower_nat n q -> p = q. intros p q H'; apply le_antisym; apply Zpower_nat_anti_monotone_le; rewrite H'; auto with zarith. Qed. (* To compute the number of digits structurally, we suppose that we know already an upper bound q. So we start from q down to 0 to find the bigger exponent r such that n^(r-1) < v *) Fixpoint digitAux (v r : Z) (q : positive) {struct q} : nat := match q with | xH => 0 | xI q' => match (n * r)%Z with | r' => match (r ?= v)%Z with | Datatypes.Gt => 0 | _ => S (digitAux v r' q') end end | xO q' => match (n * r)%Z with | r' => match (r ?= v)%Z with | Datatypes.Gt => 0 | _ => S (digitAux v r' q') end end end. (* As we know that log_n q < log_2 q we can define our function digit*) Definition digit (q : Z) := match q with | Z0 => 0 | Zpos q' => digitAux (Z.abs q) 1 (xO q') | Zneg q' => digitAux (Z.abs q) 1 (xO q') end. Hint Unfold digit. Theorem digitAux1 : forall p r, (Zpower_nat n (S p) * r)%Z = (Zpower_nat n p * (n * r))%Z. intros p r; replace (S p) with (1 + p); [ rewrite Zpower_nat_is_exp | auto with arith ]. rewrite Zpower_nat_1; ring. Qed. Theorem Zcompare_correct : forall p q : Z, match (p ?= q)%Z with | Datatypes.Gt => (q < p)%Z | Datatypes.Lt => (p < q)%Z | Datatypes.Eq => p = q end. intros p q; unfold Z.lt in |- *; generalize (Zcompare_EGAL p q); (CaseEq (p ?= q)%Z; simpl in |- *; auto). intros H H0; case (Zcompare_Gt_Lt_antisym p q); auto. Qed. Theorem digitAuxLess : forall (v r : Z) (q : positive), match digitAux v r q with | S r' => (Zpower_nat n r' * r <= v)%Z | O => True end. intros v r q; generalize r; elim q; clear r q; simpl in |- *; auto. intros q' Rec r; generalize (Zcompare_correct r v); case (r ?= v)%Z; auto. intros H1; generalize (Rec (n * r)%Z); case (digitAux v (n * r) q'). intros; rewrite H1; rewrite Zpower_nat_O; auto with zarith. intros r'; rewrite digitAux1; auto. intros H1; generalize (Rec (n * r)%Z); case (digitAux v (n * r) q'). intros; rewrite Zpower_nat_O; auto with zarith. apply Z.le_trans with (m := r); auto with zarith. intros r'; rewrite digitAux1; auto. intros q' Rec r; generalize (Zcompare_correct r v); case (r ?= v)%Z; auto. intros H1; generalize (Rec (n * r)%Z); case (digitAux v (n * r) q'). intros; rewrite H1; rewrite Zpower_nat_O; auto with zarith. intros r'; rewrite digitAux1; auto. intros H1; generalize (Rec (n * r)%Z); case (digitAux v (n * r) q'). intros; rewrite Zpower_nat_O; auto with zarith. apply Z.le_trans with (m := r); auto with zarith. intros r'; rewrite digitAux1; auto. Qed. (* digit is correct (first part) *) Theorem digitLess : forall q : Z, q <> 0%Z -> (Zpower_nat n (pred (digit q)) <= Z.abs q)%Z. intros q; case q. intros H; Contradict H; auto with zarith. intros p H; unfold digit in |- *; generalize (digitAuxLess (Z.abs (Zpos p)) 1 (xO p)); case (digitAux (Z.abs (Zpos p)) 1 (xO p)); simpl in |- *; auto with zarith. intros p H; unfold digit in |- *; generalize (digitAuxLess (Z.abs (Zneg p)) 1 (xO p)); case (digitAux (Z.abs (Zneg p)) 1 (xO p)); simpl in |- *; auto with zarith. Qed. Hint Resolve digitLess: zarith. Hint Resolve Zmult_gt_0_lt_compat_r Zmult_gt_0_lt_compat_l: zarith. Fixpoint pos_length (p : positive) : nat := match p with | xH => 0 | xO p' => S (pos_length p') | xI p' => S (pos_length p') end. Theorem digitAuxMore : forall (v r : Z) (q : positive), (0 < r)%Z -> (v < Zpower_nat n (pos_length q) * r)%Z -> (v < Zpower_nat n (digitAux v r q) * r)%Z. intros v r q; generalize r; elim q; clear r q; simpl in |- *. intros p Rec r Hr; generalize (Zcompare_correct r v); case (r ?= v)%Z; auto. intros H1 H2; rewrite <- H1. apply Z.le_lt_trans with (Zpower_nat n 0 * r)%Z; auto with zarith arith. rewrite Zpower_nat_O; rewrite Zmult_1_l; auto with zarith. intros H1 H2; rewrite digitAux1. apply Rec. apply Zlt_mult_ZERO; auto with zarith. rewrite <- digitAux1; auto. rewrite Zpower_nat_O; rewrite Zmult_1_l; auto with zarith. intros p Rec r Hr; generalize (Zcompare_correct r v); case (r ?= v)%Z; auto. intros H1 H2; rewrite <- H1. apply Z.le_lt_trans with (Zpower_nat n 0 * r)%Z; auto with zarith arith. rewrite Zpower_nat_O; rewrite Zmult_1_l; auto with zarith. intros H1 H2; rewrite digitAux1. apply Rec. apply Zlt_mult_ZERO; auto with zarith. rewrite <- digitAux1; auto. rewrite Zpower_nat_O; rewrite Zmult_1_l; auto with zarith. auto. Qed. Theorem pos_length_pow : forall p : positive, (Zpos p < Zpower_nat n (S (pos_length p)))%Z. intros p; elim p; simpl in |- *; auto. intros p0 H; rewrite Zpos_xI. apply Z.lt_le_trans with (2 * (n * Zpower_nat n (pos_length p0)))%Z; auto with zarith. intros p0 H; rewrite Zpos_xO. apply Z.lt_le_trans with (2 * (n * Zpower_nat n (pos_length p0)))%Z; auto with zarith. auto with zarith. Qed. (* digit is correct (second part) *) Theorem digitMore : forall q : Z, (Z.abs q < Zpower_nat n (digit q))%Z. intros q; case q. easy. intros q'; rewrite <- (Zmult_1_r (Zpower_nat n (digit (Zpos q')))). unfold digit in |- *; apply digitAuxMore; auto with zarith. rewrite Zmult_1_r. simpl in |- *; apply pos_length_pow. intros q'; rewrite <- (Zmult_1_r (Zpower_nat n (digit (Zneg q')))). unfold digit in |- *; apply digitAuxMore; auto with zarith. rewrite Zmult_1_r. simpl in |- *; apply pos_length_pow. Qed. Hint Resolve digitMore: zarith. (* if we find an r such that n^(r-1) =< q < n^r then r is the number of digits *) Theorem digitInv : forall (q : Z) (r : nat), (Zpower_nat n (pred r) <= Z.abs q)%Z -> (Z.abs q < Zpower_nat n r)%Z -> digit q = r. intros q r H' H'0; case (le_or_lt (digit q) r). intros H'1; case (le_lt_or_eq _ _ H'1); auto; intros H'2. absurd (Z.abs q < Zpower_nat n (digit q))%Z; auto with zarith. apply Zle_not_lt; auto with zarith. apply Z.le_trans with (m := Zpower_nat n (pred r)); auto with zarith. apply Zpower_nat_monotone_le. generalize H'2; case r; auto with arith. intros H'1. absurd (Zpower_nat n (pred (digit q)) <= Z.abs q)%Z; auto with zarith. apply Zlt_not_le; auto with zarith. apply Z.lt_le_trans with (m := Zpower_nat n r); auto. apply Zpower_nat_monotone_le. generalize H'1; case (digit q); auto with arith. apply digitLess; auto with zarith. generalize H'1; case q; unfold digit in |- *; intros tmp; intros; red in |- *; intros; try discriminate; Contradict tmp; auto with arith. Qed. Theorem digitO : digit 0 = 0. unfold digit in |- *; simpl in |- *; auto with arith. Qed. Theorem digit1 : digit 1 = 1. unfold digit in |- *; simpl in |- *; auto. Qed. (* digit is monotone *) Theorem digit_monotone : forall p q : Z, (Z.abs p <= Z.abs q)%Z -> digit p <= digit q. intros p q H; case (le_or_lt (digit p) (digit q)); auto; intros H1; Contradict H. apply Zlt_not_le. cut (p <> 0%Z); [ intros H2 | idtac ]. apply Z.lt_le_trans with (2 := digitLess p H2). cut (digit q <= pred (digit p)); [ intros H3 | idtac ]. apply Z.lt_le_trans with (2 := Zpower_nat_monotone_le _ _ H3); auto with zarith. generalize H1; case (digit p); simpl in |- *; auto with arith. generalize H1; case p; simpl in |- *; intros tmp; intros; red in |- *; intros; try discriminate; Contradict tmp; auto with arith. Qed. Hint Resolve digit_monotone: arith. (* if the number is not null so is the number of digits *) Theorem digitNotZero : forall q : Z, q <> 0%Z -> 0 < digit q. intros q H'. apply lt_le_trans with (m := digit 1); auto with zarith. apply digit_monotone. generalize H'; case q; simpl in |- *; auto with zarith; intros q'; case q'; simpl in |- *; auto with zarith arith; intros; red in |- *; simpl in |- *; red in |- *; intros; discriminate. Qed. Hint Resolve Z.lt_gt: zarith. Theorem digitAdd : forall (q : Z) (r : nat), q <> 0%Z -> digit (q * Zpower_nat n r) = digit q + r. intros q r H0. apply digitInv. replace (pred (digit q + r)) with (pred (digit q) + r). rewrite Zpower_nat_is_exp; rewrite Zabs_Zmult; rewrite (fun x => Z.abs_eq (Zpower_nat n x)); auto with zarith arith. generalize (digitNotZero _ H0); case (digit q); auto with arith. intros H'; Contradict H'; auto with arith. rewrite Zpower_nat_is_exp; rewrite Zabs_Zmult; rewrite (fun x => Z.abs_eq (Zpower_nat n x)); auto with zarith arith. Qed. Theorem digit_minus1 : forall p : nat, digit (Zpower_nat n p - 1) = p. intros p; case p; auto. intros n0; apply digitInv; auto. rewrite Z.abs_eq. cut (Zpower_nat n (pred (S n0)) < Zpower_nat n (S n0))%Z; auto with zarith. cut (0 < Zpower_nat n (S n0))%Z; auto with zarith. rewrite Z.abs_eq; auto with zarith. Qed. Theorem digit_bound : forall (x y z : Z) (n : nat), (Z.abs x <= Z.abs y)%Z -> (Z.abs y <= Z.abs z)%Z -> digit x = n -> digit z = n -> digit y = n. intros x y z n0 H' H'0 H'1 H'2; apply le_antisym. rewrite <- H'2; auto with arith. rewrite <- H'1; auto with arith. Qed. Theorem digit_abs : forall p : Z, digit (Z.abs p) = digit p. intros p; case p; simpl in |- *; auto. Qed. (* Strict comparison on the number of digits gives comparison on the numbers *) Theorem digit_anti_monotone_lt : (1 < n)%Z -> forall p q : Z, digit p < digit q -> (Z.abs p < Z.abs q)%Z. intros H' p q H'0. case (Zle_or_lt (Z.abs q) (Z.abs p)); auto; intros H'1. Contradict H'0. case (Zle_lt_or_eq _ _ H'1); intros H'2. apply le_not_lt; auto with arith. rewrite <- (digit_abs p); rewrite <- (digit_abs q); rewrite H'2; auto with arith. Qed. End Pdigit. Hint Resolve Zpower_nat_less: zarith. Hint Resolve Zpower_nat_monotone_lt: zarith. Hint Resolve Zpower_nat_monotone_le: zarith. Hint Unfold digit. Hint Resolve digitLess: zarith. Hint Resolve digitMore: zarith. Hint Resolve digit_monotone: arith.float-8.10.0/FPred.v000066400000000000000000000460221357127175600141160ustar00rootroot00000000000000(**************************************************************************** IEEE754 : FPred Laurent Thery ******************************************************************************) Require Export FSucc. Section pred. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Hypothesis precisionNotZero : precision <> 0. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Definition FPred (x : float) := match Z_eq_bool (Fnum x) (- pPred (vNum b)) with | true => Float (- nNormMin radix precision) (Z.succ (Fexp x)) | false => match Z_eq_bool (Fnum x) (nNormMin radix precision) with | true => match Z_eq_bool (Fexp x) (- dExp b) with | true => Float (Z.pred (Fnum x)) (Fexp x) | false => Float (pPred (vNum b)) (Z.pred (Fexp x)) end | false => Float (Z.pred (Fnum x)) (Fexp x) end end. Theorem FPredSimpl1 : forall x : float, Fnum x = (- pPred (vNum b))%Z -> FPred x = Float (- nNormMin radix precision) (Z.succ (Fexp x)). intros x H'; unfold FPred in |- *. generalize (Z_eq_bool_correct (Fnum x) (- pPred (vNum b))); case (Z_eq_bool (Fnum x) (- pPred (vNum b))); auto. intros H'0; Contradict H'0; auto. Qed. Theorem FPredSimpl2 : forall x : float, Fnum x = nNormMin radix precision -> Fexp x <> (- dExp b)%Z -> FPred x = Float (pPred (vNum b)) (Z.pred (Fexp x)). intros x H' H'0; unfold FPred in |- *. generalize (Z_eq_bool_correct (Fnum x) (- pPred (vNum b))); case (Z_eq_bool (Fnum x) (- pPred (vNum b))); auto. intros H'1; absurd (0%nat < Fnum x)%Z; auto with zarith arith. apply Zle_not_lt; rewrite H'1; replace (Z_of_nat 0) with (- (0))%Z; [ apply Zle_Zopp | simpl in |- *; auto ]. unfold pPred in |- *; apply Zle_Zpred; red in |- *; simpl in |- *; auto. rewrite H'. apply nNormPos; auto with zarith. intros H'1; generalize (Z_eq_bool_correct (Fnum x) (nNormMin radix precision)); case (Z_eq_bool (Fnum x) (nNormMin radix precision)). intros H'2; generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); auto. intros H'3; Contradict H'0; auto. intros H'2; Contradict H'2; auto. Qed. Theorem FPredSimpl3 : FPred (Float (nNormMin radix precision) (- dExp b)) = Float (Z.pred (nNormMin radix precision)) (- dExp b). unfold FPred in |- *; simpl in |- *. generalize (Z_eq_bool_correct (nNormMin radix precision) (- pPred (vNum b))); case (Z_eq_bool (nNormMin radix precision) (- pPred (vNum b))); auto. intros H'0; absurd (0 < pPred (vNum b))%Z; auto with zarith arith. rewrite <- (Z.opp_involutive (pPred (vNum b))); rewrite <- H'0. apply Zle_not_lt; replace 0%Z with (- (0))%Z; [ apply Zle_Zopp | simpl in |- *; auto ]. apply Zlt_le_weak; apply nNormPos; auto with float zarith. unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *; auto with float zarith. simpl in |- *; apply vNumbMoreThanOne with (3 := pGivesBound); auto. intros H'; generalize (Z_eq_bool_correct (nNormMin radix precision) (nNormMin radix precision)); case (Z_eq_bool (nNormMin radix precision) (nNormMin radix precision)). intros H'0; generalize (Z_eq_bool_correct (- dExp b) (- dExp b)); case (Z_eq_bool (- dExp b) (- dExp b)); auto. intros H'1; Contradict H'1; auto. intros H'1; Contradict H'1; auto. Qed. Theorem FPredSimpl4 : forall x : float, Fnum x <> (- pPred (vNum b))%Z -> Fnum x <> nNormMin radix precision -> FPred x = Float (Z.pred (Fnum x)) (Fexp x). intros x H' H'0; unfold FPred in |- *. generalize (Z_eq_bool_correct (Fnum x) (- pPred (vNum b))); case (Z_eq_bool (Fnum x) (- pPred (vNum b))); auto. intros H'1; Contradict H'; auto. intros H'1; generalize (Z_eq_bool_correct (Fnum x) (nNormMin radix precision)); case (Z_eq_bool (Fnum x) (nNormMin radix precision)); auto. intros H'2; Contradict H'0; auto. Qed. Theorem FPredFopFSucc : forall x : float, FPred x = Fopp (FSucc b radix precision (Fopp x)). intros x. generalize (Z_eq_bool_correct (Fnum x) (- pPred (vNum b))); case (Z_eq_bool (Fnum x) (- pPred (vNum b))); intros H'1. rewrite FPredSimpl1; auto; rewrite FSuccSimpl1; auto. unfold Fopp in |- *; simpl in |- *; rewrite H'1; auto with zarith. generalize (Z_eq_bool_correct (Fnum x) (nNormMin radix precision)); case (Z_eq_bool (Fnum x) (nNormMin radix precision)); intros H'2. generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); intros H'3. replace x with (Float (Fnum x) (Fexp x)). rewrite H'2; rewrite H'3; rewrite FPredSimpl3; unfold Fopp in |- *; simpl in |- *; rewrite FSuccSimpl3; simpl in |- *; auto. rewrite <- Zopp_Zpred_Zs; rewrite Z.opp_involutive; auto. case x; simpl in |- *; auto. rewrite FPredSimpl2; auto; rewrite FSuccSimpl2; unfold Fopp in |- *; simpl in |- *; try rewrite Z.opp_involutive; auto. rewrite H'2; auto. rewrite FPredSimpl4; auto; rewrite FSuccSimpl4; auto. unfold Fopp in |- *; simpl in |- *; rewrite <- Zopp_Zpred_Zs; rewrite Z.opp_involutive; auto. unfold Fopp in |- *; simpl in |- *; Contradict H'1; rewrite <- H'1; rewrite Z.opp_involutive; auto. unfold Fopp in |- *; simpl in |- *; Contradict H'2; auto with zarith. Qed. Theorem FPredDiff1 : forall x : float, Fnum x <> nNormMin radix precision -> Fminus radix x (FPred x) = Float 1%nat (Fexp x) :>R. intros x H'; rewrite (FPredFopFSucc x). pattern x at 1 in |- *; rewrite <- (Fopp_Fopp x). rewrite <- Fopp_Fminus_dist. rewrite Fopp_Fminus. unfold FtoRradix in |- *; rewrite FSuccDiff1; auto. replace (Fnum (Fopp x)) with (- Fnum x)%Z. Contradict H'; rewrite <- (Z.opp_involutive (Fnum x)); rewrite H'; auto with zarith. case x; simpl in |- *; auto. Qed. Theorem FPredDiff2 : forall x : float, Fnum x = nNormMin radix precision -> Fexp x = (- dExp b)%Z -> Fminus radix x (FPred x) = Float 1%nat (Fexp x) :>R. intros x H' H'0; rewrite (FPredFopFSucc x). pattern x at 1 in |- *; rewrite <- (Fopp_Fopp x). rewrite <- Fopp_Fminus_dist. rewrite Fopp_Fminus. unfold FtoRradix in |- *; rewrite FSuccDiff2; auto. rewrite <- H'; case x; auto. Qed. Theorem FPredDiff3 : forall x : float, Fnum x = nNormMin radix precision -> Fexp x <> (- dExp b)%Z -> Fminus radix x (FPred x) = Float 1%nat (Z.pred (Fexp x)) :>R. intros x H' H'0; rewrite (FPredFopFSucc x). pattern x at 1 in |- *; rewrite <- (Fopp_Fopp x). rewrite <- Fopp_Fminus_dist. rewrite Fopp_Fminus. unfold FtoRradix in |- *; rewrite FSuccDiff3; auto. rewrite <- H'; case x; auto. Qed. Theorem FBoundedPred : forall f : float, Fbounded b f -> Fbounded b (FPred f). intros f H'; rewrite (FPredFopFSucc f); auto with float. Qed. Theorem FPredCanonic : forall a : float, Fcanonic radix b a -> Fcanonic radix b (FPred a). intros a H'. rewrite FPredFopFSucc; auto with float. Qed. Theorem FPredLt : forall a : float, (FPred a < a)%R. intros a; rewrite FPredFopFSucc. pattern a at 2 in |- *; rewrite <- (Fopp_Fopp a). unfold FtoRradix in |- *; repeat rewrite Fopp_correct. apply Ropp_lt_contravar. rewrite <- Fopp_correct; auto with float. Qed. Theorem R0RltRlePred : forall x : float, (0 < x)%R -> (0 <= FPred x)%R. intros x H'; rewrite FPredFopFSucc. unfold FtoRradix in |- *; repeat rewrite Fopp_correct. replace 0%R with (-0)%R; auto with real. apply Ropp_le_contravar. apply R0RltRleSucc; auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct. replace 0%R with (-0)%R; auto with real. Qed. Theorem FPredProp : forall x y : float, Fcanonic radix b x -> Fcanonic radix b y -> (x < y)%R -> (x <= FPred y)%R. intros x y H' H'0 H'1; rewrite FPredFopFSucc. rewrite <- (Fopp_Fopp x). unfold FtoRradix in |- *; rewrite Fopp_correct with (x := Fopp x). rewrite Fopp_correct with (x := FSucc b radix precision (Fopp y)); auto with float real. apply Ropp_le_contravar. apply FSuccProp; auto with float. repeat rewrite Fopp_correct; auto with real. Qed. Theorem FPredZleEq : forall p q : float, (FPred p < q)%R -> (q <= p)%R -> (Fexp p <= Fexp q)%Z -> p = q :>R. intros p q H' H'0 H'1. rewrite <- (Ropp_involutive p); rewrite <- (Ropp_involutive q); apply Ropp_eq_compat. unfold FtoRradix in |- *; repeat rewrite <- Fopp_correct. apply FSuccZleEq with (b := b) (precision := precision); auto. repeat rewrite Fopp_correct; auto with real. apply Ropp_lt_cancel. repeat rewrite <- Fopp_correct; rewrite <- FPredFopFSucc; rewrite Fopp_Fopp; auto. Qed. Definition FNPred (x : float) := FPred (Fnormalize radix b precision x). Theorem FNPredFopFNSucc : forall x : float, FNPred x = Fopp (FNSucc b radix precision (Fopp x)). intros x; unfold FNPred, FNSucc in |- *; auto. rewrite Fnormalize_Fopp; auto. apply FPredFopFSucc; auto. Qed. Theorem FNPredCanonic : forall a : float, Fbounded b a -> Fcanonic radix b (FNPred a). intros a H'; unfold FNPred in |- *. apply FPredCanonic; auto with float. Qed. Theorem FNPredLt : forall a : float, (FNPred a < a)%R. intros a; unfold FNPred in |- *. unfold FtoRradix in |- *; rewrite <- (FnormalizeCorrect _ radixMoreThanOne b precision a). apply FPredLt; auto. Qed. Theorem FNPredProp : forall x y : float, Fbounded b x -> Fbounded b y -> (x < y)%R -> (x <= FNPred y)%R. intros x y H' H'0 H'1; unfold FNPred in |- *. replace (FtoRradix x) with (FtoRradix (Fnormalize radix b precision x)). apply FPredProp; auto with float. unfold FtoRradix in |- *; repeat rewrite FnormalizeCorrect; auto. unfold FtoRradix in |- *; repeat rewrite FnormalizeCorrect; auto. Qed. Theorem FPredSuc : forall x : float, Fcanonic radix b x -> FPred (FSucc b radix precision x) = x. intros x H; unfold FPred, FSucc in |- *. cut (Fbounded b x); [ intros Fb0 | apply FcanonicBound with (1 := H) ]. generalize (Z_eq_bool_correct (Fnum x) (pPred (vNum b))); case (Z_eq_bool (Fnum x) (pPred (vNum b))); simpl in |- *. generalize (Z_eq_bool_correct (nNormMin radix precision) (- pPred (vNum b))); case (Z_eq_bool (nNormMin radix precision) (- pPred (vNum b))); simpl in |- *. intros H'; Contradict H'; apply sym_not_equal; apply Zlt_not_eq; auto. apply Z.lt_le_trans with (- 0%nat)%Z. apply Zlt_Zopp; unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *; apply vNumbMoreThanOne with (3 := pGivesBound); auto. simpl in |- *; apply Zlt_le_weak; apply nNormPos; auto. generalize (Z_eq_bool_correct (nNormMin radix precision) (nNormMin radix precision)); case (Z_eq_bool (nNormMin radix precision) (nNormMin radix precision)); simpl in |- *. generalize (Z_eq_bool_correct (Z.succ (Fexp x)) (- dExp b)); case (Z_eq_bool (Z.succ (Fexp x)) (- dExp b)); simpl in |- *. intros H' H'0 H'1 H'2; absurd (- dExp b <= Fexp x)%Z; auto with float. rewrite <- H'; auto with float zarith. replace (Z.pred (Z.succ (Fexp x))) with (Fexp x); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]; auto. intros H' H'0 H'1 H'2; rewrite <- H'2; auto. apply floatEq; auto. intros H'; case H'; auto. generalize (Z_eq_bool_correct (Fnum x) (- nNormMin radix precision)); case (Z_eq_bool (Fnum x) (- nNormMin radix precision)); simpl in |- *. generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); simpl in |- *. generalize (Z_eq_bool_correct (Z.succ (Fnum x)) (- pPred (vNum b))); case (Z_eq_bool (Z.succ (Fnum x)) (- pPred (vNum b))); simpl in |- *. intros H0 H1 H2; absurd (Z.succ (Fnum x) <= Fnum x)%Z; auto with zarith. rewrite H0; rewrite H2; (apply Zle_Zopp; auto with float arith). unfold pPred in |- *; apply Zle_Zpred; apply ZltNormMinVnum; auto with zarith. generalize (Z_eq_bool_correct (Z.succ (Fnum x)) (nNormMin radix precision)); case (Z_eq_bool (Z.succ (Fnum x)) (nNormMin radix precision)); simpl in |- *. intros H' H'0 H'1 H'2; Contradict H'2. rewrite <- H'; auto with zarith. replace (Z.pred (Z.succ (Fnum x))) with (Fnum x); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]; auto. intros H' H'0 H'1 H'2 H'3; apply floatEq; auto. generalize (Z_eq_bool_correct (- pPred (vNum b)) (- pPred (vNum b))); case (Z_eq_bool (- pPred (vNum b)) (- pPred (vNum b))); auto. intros H' H'0 H'1 H'2; rewrite <- H'1. replace (Z.succ (Z.pred (Fexp x))) with (Fexp x); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]; auto. apply floatEq; auto. intros H'; case H'; auto. generalize (Z_eq_bool_correct (Z.succ (Fnum x)) (- pPred (vNum b))); case (Z_eq_bool (Z.succ (Fnum x)) (- pPred (vNum b))); simpl in |- *. intros H'; absurd (- pPred (vNum b) <= Fnum x)%Z; auto with float. rewrite <- H'; auto with zarith. apply Zle_Zabs_inv1; auto with float. unfold pPred in |- *; apply Zle_Zpred; auto with float. generalize (Z_eq_bool_correct (Z.succ (Fnum x)) (nNormMin radix precision)); case (Z_eq_bool (Z.succ (Fnum x)) (nNormMin radix precision)); simpl in |- *. generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); simpl in |- *. intros H' H'0 H'1 H'2 H'3. replace (Z.pred (Z.succ (Fnum x))) with (Fnum x); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]; auto. apply floatEq; auto. intros H' H'0 H'1 H'2 H'3; case H. intros H'4; absurd (nNormMin radix precision <= Z.abs (Fnum x))%Z. replace (Fnum x) with (Z.pred (Z.succ (Fnum x))); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]; auto. rewrite H'0. apply Zlt_not_le; rewrite Z.abs_eq; auto with zarith. apply Zle_Zpred; apply nNormPos; auto with float zarith. apply pNormal_absolu_min with (b := b); auto. intros H'4; Contradict H'; apply FsubnormalFexp with (1 := H'4). intros H' H'0 H'1 H'2; apply floatEq; simpl in |- *; auto. unfold Z.pred, Z.succ in |- *; ring. Qed. Theorem FSucPred : forall x : float, Fcanonic radix b x -> FSucc b radix precision (FPred x) = x. intros x H; unfold FPred, FSucc in |- *. cut (Fbounded b x); [ intros Fb0 | apply FcanonicBound with (1 := H) ]. generalize (Z_eq_bool_correct (Fnum x) (- pPred (vNum b))); case (Z_eq_bool (Fnum x) (- pPred (vNum b))); simpl in |- *. generalize (Z_eq_bool_correct (- nNormMin radix precision) (pPred (vNum b))); case (Z_eq_bool (- nNormMin radix precision) (pPred (vNum b))); simpl in |- *. intros H'; Contradict H'; apply Zlt_not_eq; auto. rewrite <- (Z.opp_involutive (pPred (vNum b))); apply Zlt_Zopp. apply Z.lt_le_trans with (- 0%nat)%Z. apply Zlt_Zopp; unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *. apply (vNumbMoreThanOne radix) with (precision := precision); auto. simpl in |- *; apply Zlt_le_weak; apply nNormPos; auto with zarith arith. generalize (Z_eq_bool_correct (- nNormMin radix precision) (- nNormMin radix precision)); case (Z_eq_bool (- nNormMin radix precision) (- nNormMin radix precision)); simpl in |- *. generalize (Z_eq_bool_correct (Z.succ (Fexp x)) (- dExp b)); case (Z_eq_bool (Z.succ (Fexp x)) (- dExp b)); simpl in |- *. intros H' H'0 H'1 H'2; absurd (- dExp b <= Fexp x)%Z; auto with float. rewrite <- H'; auto with zarith. intros H' H'0 H'1 H'2; rewrite <- H'2; apply floatEq; simpl in |- *; auto; unfold Z.succ, Z.pred in |- *; ring. intros H'; case H'; auto. generalize (Z_eq_bool_correct (Fnum x) (nNormMin radix precision)); case (Z_eq_bool (Fnum x) (nNormMin radix precision)); simpl in |- *. generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); simpl in |- *. generalize (Z_eq_bool_correct (Z.pred (Fnum x)) (pPred (vNum b))); case (Z_eq_bool (Z.pred (Fnum x)) (pPred (vNum b))); simpl in |- *. intros H' H'0 H'1 H'2; absurd (nNormMin radix precision <= pPred (vNum b))%Z; auto with float. rewrite <- H'; rewrite H'1; auto with zarith. rewrite <- H'1; auto with float. apply Zle_Zabs_inv2; auto with float zarith. unfold pPred in |- *; apply Zle_Zpred; auto with float. generalize (Z_eq_bool_correct (Z.pred (Fnum x)) (- nNormMin radix precision)); case (Z_eq_bool (Z.pred (Fnum x)) (- nNormMin radix precision)); simpl in |- *. intros H' H'0 H'1 H'2 H'3; absurd (Z.pred (nNormMin radix precision) = (- nNormMin radix precision)%Z); auto with zarith. intros H' H'0 H'1 H'2 H'3; apply floatEq; simpl in |- *; auto; unfold Z.pred, Z.succ in |- *; ring. generalize (Z_eq_bool_correct (pPred (vNum b)) (pPred (vNum b))); case (Z_eq_bool (pPred (vNum b)) (pPred (vNum b))); auto. intros H' H'0 H'1 H'2; rewrite <- H'1; apply floatEq; simpl in |- *; auto; unfold Z.pred, Z.succ in |- *; ring. intros H'; case H'; auto. generalize (Z_eq_bool_correct (Z.pred (Fnum x)) (pPred (vNum b))); case (Z_eq_bool (Z.pred (Fnum x)) (pPred (vNum b))); simpl in |- *. intros H'; absurd (Fnum x <= pPred (vNum b))%Z; auto with float. rewrite <- H'. apply Zlt_not_le; apply Zlt_pred; auto. apply Zle_Zabs_inv2; unfold pPred in |- *; apply Zle_Zpred; auto with float. generalize (Z_eq_bool_correct (Z.pred (Fnum x)) (- nNormMin radix precision)); case (Z_eq_bool (Z.pred (Fnum x)) (- nNormMin radix precision)); simpl in |- *. generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); simpl in |- *. intros H' H'0 H'1 H'2 H'3; apply floatEq; simpl in |- *; auto; unfold Z.succ, Z.pred in |- *; ring. intros H' H'0 H'1 H'2 H'3; case H; intros C0. absurd (nNormMin radix precision <= Z.abs (Fnum x))%Z; auto with float. replace (Fnum x) with (Z.succ (Z.pred (Fnum x))); [ idtac | unfold Z.succ, Z.pred in |- *; ring ]. rewrite H'0. rewrite <- Zopp_Zpred_Zs; rewrite Zabs_Zopp. rewrite Z.abs_eq; auto with zarith. apply Zle_Zpred; simpl in |- *; apply nNormPos; auto with float zarith. apply pNormal_absolu_min with (b := b); auto. Contradict H'; apply FsubnormalFexp with (1 := C0). intros H' H'0 H'1 H'2; apply floatEq; simpl in |- *; auto. unfold Z.pred, Z.succ in |- *; ring. Qed. Theorem FNPredSuc : forall x : float, Fbounded b x -> FNPred (FNSucc b radix precision x) = x :>R. intros x H'; unfold FNPred in |- *; rewrite FcanonicFnormalizeEq; auto. unfold FNSucc in |- *; rewrite FPredSuc; auto. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. apply FnormalizeCanonic; auto. apply FNSuccCanonic; auto. Qed. Theorem FNPredSucEq : forall x : float, Fcanonic radix b x -> FNPred (FNSucc b radix precision x) = x. intros x H'. apply FcanonicUnique with (precision := precision) (5 := H'); auto. apply FNPredCanonic; auto with float. apply FcanonicBound with (radix := radix); auto. apply FNSuccCanonic; auto. apply FcanonicBound with (radix := radix); auto. apply FNPredSuc; auto. apply FcanonicBound with (radix := radix); auto. Qed. Theorem FNSucPred : forall x : float, Fbounded b x -> FNSucc b radix precision (FNPred x) = x :>R. intros x H'; unfold FNSucc in |- *; rewrite FcanonicFnormalizeEq; auto. unfold FNPred in |- *; rewrite FSucPred; auto. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. apply FnormalizeCanonic; auto. apply FNPredCanonic; auto. Qed. Theorem FNSucPredEq : forall x : float, Fcanonic radix b x -> FNSucc b radix precision (FNPred x) = x. intros x H'. apply FcanonicUnique with (5 := H') (precision := precision); auto. apply FNSuccCanonic; auto. apply FcanonicBound with (radix := radix); auto. apply FNPredCanonic; auto. apply FcanonicBound with (radix := radix); auto. apply FNSucPred; auto. apply FcanonicBound with (radix := radix); auto. Qed. End pred. Hint Resolve FBoundedPred FPredCanonic FPredLt R0RltRleSucc FPredProp FNPredCanonic FNPredLt FNPredProp: float.float-8.10.0/FSucc.v000066400000000000000000001161761357127175600141310ustar00rootroot00000000000000(**************************************************************************** IEEE754 : FSucc Laurent Thery ******************************************************************************) Require Export List. Require Export Fnorm. Section suc. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Hypothesis precisionNotZero : precision <> 0. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Definition FSucc (x : float) := match Z_eq_bool (Fnum x) (pPred (vNum b)) with | true => Float (nNormMin radix precision) (Z.succ (Fexp x)) | false => match Z_eq_bool (Fnum x) (- nNormMin radix precision) with | true => match Z_eq_bool (Fexp x) (- dExp b) with | true => Float (Z.succ (Fnum x)) (Fexp x) | false => Float (- pPred (vNum b)) (Z.pred (Fexp x)) end | false => Float (Z.succ (Fnum x)) (Fexp x) end end. Theorem FSuccSimpl1 : forall x : float, Fnum x = pPred (vNum b) -> FSucc x = Float (nNormMin radix precision) (Z.succ (Fexp x)). intros x H'; unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum x) (pPred (vNum b))); case (Z_eq_bool (Fnum x) (pPred (vNum b))); auto. intros H'0; Contradict H'0; auto. Qed. Theorem FSuccSimpl2 : forall x : float, Fnum x = (- nNormMin radix precision)%Z -> Fexp x <> (- dExp b)%Z -> FSucc x = Float (- pPred (vNum b)) (Z.pred (Fexp x)). intros x H' H'0; unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum x) (pPred (vNum b))); case (Z_eq_bool (Fnum x) (pPred (vNum b))); auto. intros H'1; absurd (0%nat <= pPred (vNum b))%Z; auto with zarith arith. rewrite <- H'1; rewrite H'. unfold nNormMin in |- *; simpl in |- *; auto with zarith. replace 0%Z with (- (0))%Z; auto with zarith. unfold pPred in |- *; apply Zle_Zpred; auto with zarith. intros H'1; generalize (Z_eq_bool_correct (Fnum x) (- nNormMin radix precision)); case (Z_eq_bool (Fnum x) (- nNormMin radix precision)). intros H'2; generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); auto. intros H'3; Contradict H'0; auto. intros H'2; Contradict H'2; auto. Qed. Theorem FSuccSimpl3 : FSucc (Float (- nNormMin radix precision) (- dExp b)) = Float (Z.succ (- nNormMin radix precision)) (- dExp b). unfold FSucc in |- *; simpl in |- *. generalize (Z_eq_bool_correct (- nNormMin radix precision) (pPred (vNum b))); case (Z_eq_bool (- nNormMin radix precision) (pPred (vNum b))); auto. intros H'1; absurd (0%nat <= pPred (vNum b))%Z; auto with zarith arith. rewrite <- H'1. unfold nNormMin in |- *; simpl in |- *; auto with zarith. replace 0%Z with (- (0))%Z; auto with zarith. unfold pPred in |- *; apply Zle_Zpred; auto with zarith. intros H'; generalize (Z_eq_bool_correct (- nNormMin radix precision) (- nNormMin radix precision)); case (Z_eq_bool (- nNormMin radix precision) (- nNormMin radix precision)). intros H'0; generalize (Z_eq_bool_correct (- dExp b) (- dExp b)); case (Z_eq_bool (- dExp b) (- dExp b)); auto. intros H'1; Contradict H'1; auto. intros H'1; Contradict H'1; auto. Qed. Theorem FSuccSimpl4 : forall x : float, Fnum x <> pPred (vNum b) -> Fnum x <> (- nNormMin radix precision)%Z -> FSucc x = Float (Z.succ (Fnum x)) (Fexp x). intros x H' H'0; unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum x) (pPred (vNum b))); case (Z_eq_bool (Fnum x) (pPred (vNum b))); auto. intros H'1; Contradict H'; auto. intros H'1; generalize (Z_eq_bool_correct (Fnum x) (- nNormMin radix precision)); case (Z_eq_bool (Fnum x) (- nNormMin radix precision)); auto. intros H'2; Contradict H'0; auto. Qed. Theorem FSuccDiff1 : forall x : float, Fnum x <> (- nNormMin radix precision)%Z -> Fminus radix (FSucc x) x = Float 1%nat (Fexp x) :>R. intros x H'. generalize (Z_eq_bool_correct (Fnum x) (pPred (vNum b))); case (Z_eq_bool (Fnum x) (pPred (vNum b))); intros H'1. rewrite FSuccSimpl1; auto. unfold FtoRradix, FtoR, Fminus, Fopp, Fplus in |- *; simpl in |- *; auto. repeat rewrite Zmin_le2; auto with zarith. rewrite <- Zminus_succ_l; repeat rewrite <- Zminus_diag_reverse. rewrite absolu_Zs; auto with zarith; simpl in |- *. rewrite H'1; unfold pPred in |- *; rewrite pGivesBound; unfold nNormMin in |- *. replace (Zpower_nat radix (pred precision) * (radix * 1))%Z with (Zpower_nat radix precision). f_equal. unfold Z.pred. rewrite Z.opp_add_distr. rewrite Z.mul_1_r. rewrite Z.add_assoc. now rewrite Z.add_opp_diag_r. (*rewrite plus_IZR; rewrite Rmult_IZR; simpl in |- *. unfold Zpred in |- *; unfold Zminus in |- *; simpl in |- *. repeat ring_simplify. ring.*) rewrite Z.mul_1_r. pattern precision at 1 in |- *; replace precision with (pred precision + 1). rewrite Zpower_nat_is_exp; rewrite Zpower_nat_1; auto. generalize precisionNotZero; case precision; simpl in |- *; auto with zarith arith. rewrite FSuccSimpl4; auto. unfold FtoRradix, FtoR, Fminus, Fopp, Fplus in |- *; simpl in |- *; auto. repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; simpl in |- *. repeat rewrite Zmult_1_r. replace (Z.succ (Fnum x) + - Fnum x)%Z with (Z_of_nat 1). simpl in |- *; auto. simpl in |- *; unfold Z.succ in |- *; ring. Qed. Theorem FSuccDiff2 : forall x : float, Fnum x = (- nNormMin radix precision)%Z -> Fexp x = (- dExp b)%Z -> Fminus radix (FSucc x) x = Float 1%nat (Fexp x) :>R. intros x H' H'0; replace x with (Float (Fnum x) (Fexp x)). rewrite H'; rewrite H'0; rewrite FSuccSimpl3; auto. unfold FtoRradix, FtoR, Fminus, Fopp, Fplus in |- *; simpl in |- *; auto. repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; auto with zarith. simpl in |- *; repeat rewrite Zmult_1_r. rewrite Zplus_succ_l; rewrite Zplus_opp_r; simpl in |- *; auto. case x; simpl in |- *; auto. Qed. Theorem FSuccDiff3 : forall x : float, Fnum x = (- nNormMin radix precision)%Z -> Fexp x <> (- dExp b)%Z -> Fminus radix (FSucc x) x = Float 1%nat (Z.pred (Fexp x)) :>R. intros x H' H'1; rewrite FSuccSimpl2; auto. unfold FtoRradix, FtoR, Fminus, Fopp, Fplus in |- *; simpl in |- *; auto. repeat rewrite Zmin_le1; auto with zarith. rewrite <- Zminus_diag_reverse; rewrite <- Zminus_n_predm; repeat rewrite <- Zminus_diag_reverse. rewrite absolu_Zs; auto with zarith; simpl in |- *. rewrite H'; unfold pPred in |- *; rewrite pGivesBound; unfold nNormMin in |- *. rewrite Z.opp_involutive; repeat rewrite Zmult_1_r. replace (Zpower_nat radix (pred precision) * radix)%Z with (Zpower_nat radix precision). unfold Z.pred in |- *; simpl in |- *; repeat rewrite plus_IZR || rewrite Ropp_Ropp_IZR. f_equal. simpl in |- *; ring. pattern precision at 1 in |- *; replace precision with (pred precision + 1). rewrite Zpower_nat_is_exp; rewrite Zpower_nat_1; auto. generalize precisionNotZero; case precision; simpl in |- *; auto with zarith arith. Qed. Theorem ZltNormMinVnum : (nNormMin radix precision < Zpos (vNum b))%Z. unfold nNormMin in |- *; rewrite pGivesBound; auto with zarith. Qed. Hint Resolve ZltNormMinVnum: float. Theorem FSuccNormPos : forall a : float, (0 <= a)%R -> Fnormal radix b a -> Fnormal radix b (FSucc a). intros a H' H'0; unfold FSucc in |- *. cut (Fbounded b a); [ intros B0 | apply FnormalBounded with (1 := H'0); auto ]. generalize (Z_eq_bool_correct (Fnum a) (pPred (vNum b))); case (Z_eq_bool (Fnum a) (pPred (vNum b))); auto. intros H'3; repeat split; simpl in |- *; auto. rewrite Z.abs_eq; auto with float zarith. unfold nNormMin in |- *; auto with zarith. apply Z.le_trans with (m := Fexp a); auto with float zarith arith. rewrite pGivesBound; rewrite Z.abs_eq; auto with zarith. pattern precision at 1 in |- *; replace precision with (1 + pred precision). rewrite Zpower_nat_is_exp; rewrite Zpower_nat_1; unfold nNormMin in |- *; auto with zarith. generalize precisionNotZero; case precision; auto with zarith. apply Zle_mult_gen; simpl in |- *; auto with zarith. apply Z.le_trans with 1%Z; auto with zarith. unfold nNormMin in |- *; auto with zarith. intros H'3; generalize (Z_eq_bool_correct (Fnum a) (- nNormMin radix precision)); case (Z_eq_bool (Fnum a) (- nNormMin radix precision)). intros H'4; absurd (0 <= Fnum a)%Z; auto. 2: apply LeR0Fnum with (radix := radix); auto with zarith. rewrite H'4; auto. apply Zlt_not_le. replace 0%Z with (- 0%nat)%Z; unfold nNormMin in |- *; auto with zarith. intros H'4; repeat split; simpl in |- *; auto with float zarith arith. apply Z.le_lt_trans with (Z.succ (Z.abs (Fnum a))); auto with float zarith. case (Zlt_next (Z.abs (Fnum a)) (Zpos (vNum b))); auto with float zarith arith. intros H1; Contradict H'3. unfold pPred in |- *; rewrite H1; rewrite Z.abs_eq; auto with zarith. apply LeR0Fnum with (radix := radix); auto with zarith. apply Z.le_trans with (Z.abs (radix * Fnum a)); auto with float zarith. case H'0; auto. repeat rewrite Zabs_Zmult. cut (0 <= Fnum a)%Z; [ intros Z1 | apply LeR0Fnum with (radix := radix) ]; auto. rewrite (Z.abs_eq (Fnum a)); auto. rewrite (Z.abs_eq (Z.succ (Fnum a))); auto with zarith. Qed. Theorem FSuccSubnormNotNearNormMin : forall a : float, Fsubnormal radix b a -> Fnum a <> Z.pred (nNormMin radix precision) -> Fsubnormal radix b (FSucc a). intros a H' H'0. cut (Fbounded b a); [ intros B0 | apply FsubnormalFbounded with (1 := H'); auto ]. unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum a) (pPred (vNum b))); case (Z_eq_bool (Fnum a) (pPred (vNum b))); auto. intros H'2; absurd (Fdigit radix a < precision); auto with float. 2: apply FsubnormalDigit with (b := b); auto. unfold Fdigit in |- *; rewrite H'2. unfold pPred in |- *; rewrite (digitPredVNumiSPrecision radix) with (b := b) (precision := precision); auto with arith. intros H'3; generalize (Z_eq_bool_correct (Fnum a) (- nNormMin radix precision)); case (Z_eq_bool (Fnum a) (- nNormMin radix precision)). intros H'2; absurd (Fdigit radix a < precision); auto with float. unfold Fdigit in |- *; rewrite H'2. replace (digit radix (- nNormMin radix precision)) with (digit radix (nNormMin radix precision)). rewrite digitnNormMin; auto with arith. case (nNormMin radix precision); simpl in |- *; auto. apply FsubnormalDigit with (b := b); auto. intros H'4; repeat split; simpl in |- *; auto with float zarith arith. apply Z.le_lt_trans with (m := Z.succ (Z.abs (Fnum a))); auto with float zarith arith. apply Z.lt_le_trans with (m := Z.succ (nNormMin radix precision)); auto with float zarith arith. apply Zsucc_lt_compat; apply pSubnormal_absolu_min with (3 := pGivesBound); auto with float zarith arith. case H'; intros H1 (H2, H3); auto with float. rewrite Zabs_Zmult. rewrite (Z.abs_eq radix); auto with zarith. apply Z.lt_le_trans with (m := (radix * nNormMin radix precision)%Z); auto with float zarith arith. apply Zmult_gt_0_lt_compat_l; try apply Z.lt_gt; auto with zarith. apply Zlt_Zabs_Zpred; auto with float zarith arith. apply pSubnormal_absolu_min with (3 := pGivesBound); auto. pattern radix at 1 in |- *; rewrite <- (Zpower_nat_1 radix); unfold nNormMin in |- *; rewrite <- Zpower_nat_is_exp. rewrite pGivesBound. generalize precisionNotZero; case precision; simpl in |- *; auto with zarith. Qed. Theorem FSuccSubnormNearNormMin : forall a : float, Fsubnormal radix b a -> Fnum a = Z.pred (nNormMin radix precision) -> Fnormal radix b (FSucc a). intros a H' H'0. cut (Fbounded b a); [ intros Fb0 | apply FsubnormalFbounded with (1 := H') ]. unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum a) (pPred (vNum b))); case (Z_eq_bool (Fnum a) (pPred (vNum b))); auto. intros H'1; absurd (nNormMin radix precision < Zpos (vNum b))%Z; auto with float. apply Zle_not_lt. apply Zle_n_Zpred; unfold pPred in H'1; rewrite <- H'1; rewrite H'0; auto with zarith. intros H'3; generalize (Z_eq_bool_correct (Fnum a) (- nNormMin radix precision)); case (Z_eq_bool (Fnum a) (- nNormMin radix precision)). intros H'1; absurd (- nNormMin radix precision < Z.pred (nNormMin radix precision))%Z. rewrite <- H'1; rewrite <- H'0; auto with zarith. unfold nNormMin in |- *; apply Z.lt_le_trans with (m := (- (0))%Z); auto with zarith. intros H'4; repeat split; simpl in |- *; auto with float zarith arith. rewrite H'0. rewrite <- Zsucc_pred. rewrite Z.abs_eq; auto with float zarith. unfold nNormMin in |- *; auto with zarith. rewrite H'0. rewrite <- Zsucc_pred. pattern radix at 1 in |- *; rewrite <- (Zpower_nat_1 radix); unfold nNormMin in |- *; rewrite <- Zpower_nat_is_exp. rewrite pGivesBound. generalize precisionNotZero; case precision; simpl in |- *; auto with zarith. Qed. Theorem FBoundedSuc : forall f : float, Fbounded b f -> Fbounded b (FSucc f). intros f H'; unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum f) (pPred (vNum b))); case (Z_eq_bool (Fnum f) (pPred (vNum b))); intros H'1. repeat split; simpl in |- *; auto with zarith arith. rewrite Z.abs_eq; auto with float zarith. unfold nNormMin in |- *; auto with zarith. apply Z.le_trans with (Fexp f); auto with float zarith. generalize (Z_eq_bool_correct (Fnum f) (- nNormMin radix precision)); case (Z_eq_bool (Fnum f) (- nNormMin radix precision)); intros H'2. generalize (Z_eq_bool_correct (Fexp f) (- dExp b)); case (Z_eq_bool (Fexp f) (- dExp b)); intros H'3. repeat split; simpl in |- *; auto with float zarith arith. apply Zlt_Zabs_Zpred; auto with float zarith arith. repeat split; simpl in |- *; auto with float zarith arith. rewrite Zabs_Zopp. rewrite Z.abs_eq; unfold pPred in |- *; auto with zarith. case (Zle_next (- dExp b) (Fexp f)); auto with float zarith arith. repeat split; simpl in |- *; auto with float zarith arith. apply Zlt_Zabs_Zpred; auto with float zarith arith. Qed. Theorem FSuccSubnormal : forall a : float, Fsubnormal radix b a -> Fcanonic radix b (FSucc a). intros a H'. generalize (Z_eq_bool_correct (Fnum a) (Z.pred (nNormMin radix precision))); case (Z_eq_bool (Fnum a) (Z.pred (nNormMin radix precision))); intros H'1. left; apply FSuccSubnormNearNormMin; auto. right; apply FSuccSubnormNotNearNormMin; auto. Qed. Theorem FSuccPosNotMax : forall a : float, (0 <= a)%R -> Fcanonic radix b a -> Fcanonic radix b (FSucc a). intros a H' H'0; case H'0; intros H'2. left; apply FSuccNormPos; auto. apply FSuccSubnormal; auto. Qed. Theorem FSuccNormNegNotNormMin : forall a : float, (a <= 0)%R -> Fnormal radix b a -> a <> Float (- nNormMin radix precision) (- dExp b) -> Fnormal radix b (FSucc a). intros a H' H'0 H'1; cut (Fbounded b a); [ intros Fb0 | apply FnormalBounded with (1 := H'0) ]. cut (Fnum a <= 0)%Z; [ intros Z0 | apply R0LeFnum with (radix := radix) ]; auto with zarith. case (Zle_lt_or_eq _ _ Z0); intros Z1. 2: absurd (is_Fzero a); auto with float. 2: apply FnormalNotZero with (1 := H'0); auto. unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum a) (pPred (vNum b))); case (Z_eq_bool (Fnum a) (pPred (vNum b))); auto. intros H'2; absurd (0 < Fnum a)%Z; auto with zarith arith. rewrite H'2; unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *; apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith arith. intros H'3; generalize (Z_eq_bool_correct (Fnum a) (- nNormMin radix precision)); case (Z_eq_bool (Fnum a) (- nNormMin radix precision)); auto. intros H'2; generalize (Z_eq_bool_correct (Fexp a) (- dExp b)); case (Z_eq_bool (Fexp a) (- dExp b)). intros H'4; Contradict H'1; auto. apply floatEq; auto. intros H'4; repeat split; simpl in |- *; auto with zarith. rewrite Zabs_Zopp. unfold pPred in |- *; rewrite Z.abs_eq; auto with zarith. case (Zle_next (- dExp b) (Fexp a)); auto with float zarith. rewrite <- Zopp_mult_distr_r; rewrite Zabs_Zopp. rewrite Zabs_Zmult. repeat rewrite Z.abs_eq; auto with float zarith. pattern (Zpos (vNum b)) at 1 in |- *; rewrite (PosNormMin radix) with (precision := precision); auto with zarith. apply Zle_Zmult_comp_l; auto with zarith. unfold pPred in |- *; apply Zle_Zpred; auto with float zarith. unfold pPred in |- *; apply Zle_Zpred; auto with float zarith. intros H'2; repeat split; simpl in |- *; auto with float zarith arith. apply Z.lt_trans with (Z.abs (Fnum a)); auto with float zarith. repeat rewrite Zabs_eq_opp; auto with float zarith. rewrite Zabs_Zmult. rewrite (Z.abs_eq radix); [ idtac | apply Z.le_trans with 1%Z; auto with zarith ]. repeat rewrite Zabs_eq_opp; auto with float zarith. pattern (Zpos (vNum b)) at 1 in |- *; rewrite (PosNormMin radix) with (precision := precision); auto with zarith. apply Zle_Zmult_comp_l; auto with zarith. replace (- Z.succ (Fnum a))%Z with (Z.pred (- Fnum a)). auto with float zarith. unfold pPred in |- *; apply Zle_Zpred. case (Zle_lt_or_eq (nNormMin radix precision) (- Fnum a)); auto. rewrite <- Zabs_eq_opp; auto with float zarith. apply pNormal_absolu_min with (b := b); auto. intros H'4; Contradict H'2; rewrite H'4; ring. apply Zpred_Zopp_Zs; auto. Qed. Theorem FSuccNormNegNormMin : Fsubnormal radix b (FSucc (Float (- nNormMin radix precision) (- dExp b))). unfold FSucc in |- *; simpl in |- *. generalize (Z_eq_bool_correct (- nNormMin radix precision) (pPred (vNum b))); case (Z_eq_bool (- nNormMin radix precision) (pPred (vNum b))); intros H'; auto. absurd (0%nat < pPred (vNum b))%Z; auto. rewrite <- H'; auto with float zarith. replace (Z_of_nat 0) with (- (0))%Z; [ idtac | simpl in |- *; auto ]. apply Zle_not_lt; apply Zle_Zopp; auto with float zarith. apply Zlt_le_weak; auto with float zarith. apply nNormPos; auto with float zarith. unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *; auto with float zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with float zarith. generalize (Z_eq_bool_correct (- nNormMin radix precision) (- nNormMin radix precision)); case (Z_eq_bool (- nNormMin radix precision) (- nNormMin radix precision)); intros H'0. 2: Contradict H'0; auto. generalize (Z_eq_bool_correct (- dExp b) (- dExp b)); case (Z_eq_bool (- dExp b) (- dExp b)); intros H'1. 2: Contradict H'1; auto. repeat split; simpl in |- *; auto with zarith. apply Z.le_lt_trans with (m := nNormMin radix precision); auto with float zarith. rewrite <- Zopp_Zpred_Zs; rewrite Zabs_Zopp; rewrite Z.abs_eq; auto with float zarith. apply Zle_Zpred; simpl in |- *; auto with float zarith. apply nNormPos; auto with float zarith. rewrite Zabs_Zmult; rewrite (Z.abs_eq radix); auto with zarith. rewrite (PosNormMin radix) with (precision := precision); auto with zarith. apply Zmult_gt_0_lt_compat_l; auto with float zarith. rewrite <- Zopp_Zpred_Zs; rewrite Zabs_Zopp. rewrite Z.abs_eq; auto with zarith. apply Zle_Zpred; simpl in |- *; auto with float zarith. apply nNormPos; auto with float zarith. Qed. Theorem FSuccNegCanonic : forall a : float, (a <= 0)%R -> Fcanonic radix b a -> Fcanonic radix b (FSucc a). intros a H' H'0; case H'0; intros H'1. case (floatDec a (Float (- nNormMin radix precision) (- dExp b))); intros H'2. rewrite H'2; right; apply FSuccNormNegNormMin; auto. left; apply FSuccNormNegNotNormMin; auto. apply FSuccSubnormal; auto. Qed. Theorem FSuccCanonic : forall a : float, Fcanonic radix b a -> Fcanonic radix b (FSucc a). intros a H'. case (Rle_or_lt 0 a); intros H'3. apply FSuccPosNotMax; auto. apply FSuccNegCanonic; auto with real. Qed. Theorem FSuccLt : forall a : float, (a < FSucc a)%R. intros a; unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum a) (pPred (vNum b))); case (Z_eq_bool (Fnum a) (pPred (vNum b))); auto. intros H'; unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite H'. unfold pPred in |- *; rewrite (PosNormMin radix) with (precision := precision); auto with zarith; unfold nNormMin in |- *. rewrite powerRZ_Zs; auto with real zarith. repeat rewrite <- Rmult_assoc. apply Rlt_monotony_exp; auto with zarith. rewrite Zmult_comm. rewrite <- Rmult_IZR. apply Rlt_IZR; auto with zarith. intros H'; generalize (Z_eq_bool_correct (Fnum a) (- nNormMin radix precision)); case (Z_eq_bool (Fnum a) (- nNormMin radix precision)). intros H'0; generalize (Z_eq_bool_correct (Fexp a) (- dExp b)); case (Z_eq_bool (Fexp a) (- dExp b)). intros H'1; unfold FtoRradix, FtoR in |- *; simpl in |- *. apply Rlt_monotony_exp; auto with real zarith. intros H'1; unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite H'0. pattern (Fexp a) at 1 in |- *; replace (Fexp a) with (Z.succ (Z.pred (Fexp a))). rewrite powerRZ_Zs; auto with real zarith. repeat rewrite <- Rmult_assoc. apply Rlt_monotony_exp; auto with real zarith. rewrite <- Rmult_IZR. apply Rlt_IZR; auto with zarith. rewrite <- Zopp_mult_distr_l. apply Zlt_Zopp. rewrite Zmult_comm. unfold pPred in |- *; rewrite (PosNormMin radix) with (precision := precision); auto with zarith. apply sym_equal; apply Zsucc_pred. intros H'1; unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real zarith. Qed. Theorem FSuccPropPos : forall x y : float, (0 <= x)%R -> Fcanonic radix b x -> Fcanonic radix b y -> (x < y)%R -> (FSucc x <= y)%R. intros x y H' H'0 H'1 H'2. cut (Fbounded b x); [ intros Fb0 | apply FcanonicBound with (1 := H'0) ]. cut (Fbounded b y); [ intros Fb1 | apply FcanonicBound with (1 := H'1) ]. case FcanonicLtPos with (p := x) (q := y) (3 := pGivesBound); auto. case (Z.eq_dec (Fnum x) (pPred (vNum b))); intros H'4. rewrite FSuccSimpl1; auto. intros H'5; case (Zlt_next _ _ H'5); intros H'6. replace y with (Float (Fnum y) (Fexp y)). rewrite H'6. generalize Fle_Zle; unfold Fle, FtoRradix in |- *; intros H'7; apply H'7; clear H'7; auto with arith. rewrite <- (Z.abs_eq (Fnum y)); auto with float zarith. apply pNormal_absolu_min with (b := b); auto. case H'1; auto with float. intros H'7; Contradict H'5; apply Zle_not_lt. replace (Fexp y) with (- dExp b)%Z; auto with float. case H'7; intros H'8 (H'9, H'10); auto. apply LeR0Fnum with (radix := radix); auto with zarith. apply Rle_trans with (r2 := FtoR radix x); auto with real. case y; auto. apply Rlt_le; auto. unfold FtoRradix in |- *; apply FcanonicPosFexpRlt with (3 := pGivesBound); auto. apply LeFnumZERO with (radix := radix); auto with zarith. simpl in |- *; auto with zarith. apply Zlt_le_weak; apply nNormPos. auto with zarith. apply Rle_trans with (r2 := FtoR radix x); auto with real. rewrite <- FSuccSimpl1; auto. apply FSuccCanonic; auto. intros H'5; apply Rlt_le. unfold FtoRradix in |- *; apply FcanonicPosFexpRlt with (3 := pGivesBound); auto. apply Rle_trans with (r2 := FtoR radix x); auto. apply Rlt_le; auto. apply FSuccLt; auto. apply Rle_trans with (r2 := FtoR radix x); auto with real. apply FSuccCanonic; auto. rewrite FSuccSimpl4; auto. apply sym_not_equal; apply Zlt_not_eq. apply Z.lt_le_trans with (m := 0%Z); auto with zarith. replace 0%Z with (- 0%nat)%Z; auto with zarith. apply Zlt_Zopp. apply nNormPos; auto. apply LeR0Fnum with (radix := radix); auto with zarith. intros H'4; elim H'4; intros H'5 H'6; clear H'4. generalize (Z_eq_bool_correct (Fnum x) (Zpos (vNum b))); case (Z_eq_bool (Fnum x) (Zpos (vNum b))); intros H'4. Contradict H'6; auto. apply Zle_not_lt; apply Zlt_le_weak. rewrite H'4; auto with float zarith. rewrite <- (Z.abs_eq (Fnum y)); auto with float zarith. apply LeR0Fnum with (radix := radix); auto with zarith. apply Rle_trans with (FtoRradix x); auto with real. case (Zlt_next _ _ H'6); intros H'7. rewrite FSuccSimpl4; auto. rewrite <- H'7; rewrite H'5; unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real. apply Zlt_not_eq. unfold pPred in |- *; apply Zlt_succ_pred; rewrite <- H'7; auto with float. rewrite <- (Z.abs_eq (Fnum y)); auto with float zarith. apply LeR0Fnum with (radix := radix); auto with zarith. apply Rle_trans with (FtoRradix x); auto with real. apply Zlt_not_eq_rev. apply Z.lt_le_trans with (m := 0%Z); auto with zarith. replace 0%Z with (- 0%nat)%Z; auto with zarith. apply Zlt_Zopp. apply nNormPos; auto. apply LeR0Fnum with (radix := radix); auto with zarith. rewrite FSuccSimpl4; auto. replace y with (Float (Fnum y) (Fexp y)). rewrite H'5. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real float. case y; simpl in |- *; auto. Contradict H'7; auto. apply Zle_not_lt; apply Zlt_le_weak. rewrite H'7; auto with float zarith. unfold pPred in |- *; rewrite <- Zsucc_pred. rewrite <- (Z.abs_eq (Fnum y)); auto with float zarith. apply LeR0Fnum with (radix := radix); auto with zarith. apply Rle_trans with (FtoRradix x); auto with real. apply Zlt_not_eq_rev. apply Z.lt_le_trans with (m := 0%Z); auto with zarith. replace 0%Z with (- 0%nat)%Z; auto with zarith. apply Zlt_Zopp. apply nNormPos; auto. apply LeR0Fnum with (radix := radix); auto with zarith. Qed. Theorem R0RltRleSucc : forall x : float, (x < 0)%R -> (FSucc x <= 0)%R. intros a H'; unfold FSucc in |- *. generalize (Z_eq_bool_correct (Fnum a) (pPred (vNum b))); case (Z_eq_bool (Fnum a) (pPred (vNum b))); auto. intros H'0; absurd (Fnum a < 0)%Z; auto. rewrite H'0; auto with zarith arith. apply Zle_not_lt; unfold pPred in |- *; apply Zle_Zpred; auto with float. apply Z.lt_trans with 1%Z; auto with zarith; apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. apply R0LtFnum with (radix := radix); auto with zarith. generalize (Z_eq_bool_correct (Fnum a) (- nNormMin radix precision)); case (Z_eq_bool (Fnum a) (- nNormMin radix precision)); intros H'1. generalize (Z_eq_bool_correct (Fexp a) (- dExp b)); case (Z_eq_bool (Fexp a) (- dExp b)); intros H'2. intros H'0. apply LeZEROFnum with (radix := radix); simpl in |- *; auto with zarith. apply Zlt_le_succ. apply R0LtFnum with (radix := radix); auto with zarith. intros H'0. apply LeZEROFnum with (radix := radix); simpl in |- *; auto with zarith. replace 0%Z with (- (0))%Z; [ apply Zle_Zopp | simpl in |- *; auto ]. unfold pPred in |- *; apply Zle_Zpred; apply Z.lt_trans with 1%Z; auto with zarith; apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. intros H'0. apply LeZEROFnum with (radix := radix); simpl in |- *; auto with zarith. apply Zlt_le_succ. apply R0LtFnum with (radix := radix); auto with zarith. Qed. Theorem FSuccPropNeg : forall x y : float, (x < 0)%R -> Fcanonic radix b x -> Fcanonic radix b y -> (x < y)%R -> (FSucc x <= y)%R. intros x y H' H'0 H'1 H'2. cut (Fbounded b x); [ intros Fb0 | apply FcanonicBound with (1 := H'0) ]. cut (Fbounded b y); [ intros Fb1 | apply FcanonicBound with (1 := H'1) ]. case (Rle_or_lt 0 y); intros Rle0. apply Rle_trans with (r2 := 0%R); auto. apply R0RltRleSucc; auto. cut (Fnum x <> pPred (vNum b)); [ intros N0 | idtac ]; auto with zarith. generalize (Z_eq_bool_correct (Fnum x) (- nNormMin radix precision)); case (Z_eq_bool (Fnum x) (- nNormMin radix precision)); intros H'4. generalize (Z_eq_bool_correct (Fexp x) (- dExp b)); case (Z_eq_bool (Fexp x) (- dExp b)); intros H'5. replace x with (Float (Fnum x) (Fexp x)). rewrite H'4; rewrite H'5; rewrite FSuccSimpl3; auto. case FcanonicLtNeg with (p := x) (q := y) (3 := pGivesBound); auto with real. intros H'6; Contradict H'6; rewrite H'5; apply Zle_not_lt; auto with float. intros H'6; elim H'6; intros H'7 H'8; clear H'6; replace y with (Float (Fnum y) (Fexp y)). rewrite <- H'7; rewrite H'5. generalize Fle_Zle; unfold Fle, FtoRradix in |- *; intros H'9; apply H'9; clear H'9; auto with arith. rewrite <- H'4; auto with zarith. case y; auto. case x; auto. rewrite FSuccSimpl2; auto. case FcanonicLtNeg with (p := x) (q := y) (3 := pGivesBound); auto with real. intros H'6; replace y with (Float (Fnum y) (Fexp y)). case (Zlt_next _ _ H'6); intros H'7. rewrite H'7. rewrite <- Zpred_succ. unfold FtoRradix, FtoR in |- *; simpl in |- *. apply Rle_monotone_exp; auto with zarith. rewrite <- (Z.opp_involutive (Fnum y)); apply Rle_IZR; apply Zle_Zopp. unfold pPred in |- *; apply Zle_Zpred; rewrite <- Zabs_eq_opp; auto with float zarith. apply Zlt_le_weak; apply R0LtFnum with (radix := radix); auto with zarith. apply Rlt_le; auto with real. unfold FtoRradix in |- *; apply FcanonicNegFexpRlt with (3 := pGivesBound); auto. apply Rlt_le; auto. rewrite <- FSuccSimpl2; auto. apply R0RltRleSucc; auto. rewrite <- FSuccSimpl2; auto. apply FSuccCanonic; auto. simpl in |- *; auto. apply Zsucc_lt_reg; auto. rewrite <- Zsucc_pred; auto with zarith. case y; auto. intros H'6; elim H'6; intros H'7 H'8; clear H'6; apply Rlt_le. Contradict H'8; rewrite H'4. apply Zle_not_lt. replace (Fnum y) with (- Z.abs (Fnum y))%Z. apply Zle_Zopp. apply pNormal_absolu_min with (3 := pGivesBound); auto. case H'1; auto. intros H'6; Contradict H'5; rewrite H'7; auto with float. apply FsubnormalFexp with (1 := H'6). rewrite Zabs_eq_opp. ring. apply R0LeFnum with (radix := radix); auto with zarith. apply Rlt_le; auto. rewrite FSuccSimpl4; auto. case FcanonicLtNeg with (p := x) (q := y) (3 := pGivesBound); auto. apply Rlt_le; auto with real. intros H'5; apply Rlt_le; auto. unfold FtoRradix in |- *; apply FcanonicNegFexpRlt with (3 := pGivesBound); auto. apply Rlt_le; auto. rewrite <- FSuccSimpl4; auto. apply R0RltRleSucc; auto. rewrite <- FSuccSimpl4; auto. apply FSuccCanonic; auto. intros H'5; elim H'5; intros H'6 H'7; clear H'5. replace y with (Float (Fnum y) (Fexp y)). rewrite H'6. generalize Fle_Zle; unfold Fle, FtoRradix in |- *; intros H'8; apply H'8; clear H'8; auto with zarith arith. case y; auto. apply Zlt_not_eq. apply Z.lt_trans with 0%Z; auto with zarith. apply R0LtFnum with (radix := radix); auto with zarith. unfold pPred in |- *; apply Zlt_succ_pred. replace (Z.succ 0) with (Z_of_nat 1); [ apply (vNumbMoreThanOne radix) with (precision := precision) | simpl in |- * ]; auto with zarith. Qed. Theorem FSuccProp : forall x y : float, Fcanonic radix b x -> Fcanonic radix b y -> (x < y)%R -> (FSucc x <= y)%R. intros x y H' H'0 H'1; case (Rle_or_lt 0 x); intros H'2. apply FSuccPropPos; auto. apply FSuccPropNeg; auto. Qed. Theorem FSuccZleEq : forall p q : float, (p <= q)%R -> (q < FSucc p)%R -> (Fexp p <= Fexp q)%Z -> p = q :>R. intros p q H'. generalize (Z_eq_bool_correct (Fnum p) (pPred (vNum b))); case (Z_eq_bool (Fnum p) (pPred (vNum b))); intros H'0. rewrite FSuccSimpl1; simpl in |- *; auto with arith. intros H'1 H'2. replace p with (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q). unfold FtoRradix in |- *; rewrite FshiftCorrect; auto with real. cut (Fexp (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q) = Fexp p); [ intros Eq0 | idtac ]. apply floatEq; auto. apply sym_equal; apply Zeq_Zs; auto. apply Rle_Fexp_eq_Zle with (radix := radix); auto with arith. rewrite FshiftCorrect; auto. replace (Z.succ (Fnum p)) with (Fnum (Fshift radix 1 (FSucc p))); auto. apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with arith. repeat rewrite FshiftCorrect; auto. rewrite FSuccSimpl1; simpl in |- *; auto with arith. unfold Fshift in |- *; simpl in |- *. rewrite FSuccSimpl1; simpl in |- *; auto with arith. rewrite inj_abs; auto with zarith. unfold Fshift in |- *; simpl in |- *. rewrite FSuccSimpl1; simpl in |- *; auto with arith. rewrite Z.mul_1_r. rewrite H'0. unfold pPred in |- *; rewrite <- Zsucc_pred. rewrite (PosNormMin radix) with (precision := precision); auto with zarith; apply Zmult_comm. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; auto with zarith. generalize (Z_eq_bool_correct (Fnum p) (- nNormMin radix precision)); case (Z_eq_bool (Fnum p) (- nNormMin radix precision)); intros H'1. generalize (Z_eq_bool_correct (Fexp p) (- dExp b)); case (Z_eq_bool (Fexp p) (- dExp b)); intros H'2. pattern p at 1 in |- *; replace p with (Float (Fnum p) (Fexp p)). rewrite H'1; rewrite H'2. rewrite FSuccSimpl3; auto with arith. intros H'3 H'4. replace p with (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q). unfold FtoRradix in |- *; rewrite FshiftCorrect; auto with real. cut (Fexp (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q) = Fexp p); [ intros Eq0 | idtac ]. apply floatEq; auto. apply sym_equal; apply Zeq_Zs; auto. apply Rle_Fexp_eq_Zle with (radix := radix); auto with arith. rewrite FshiftCorrect; auto. replace (Z.succ (Fnum p)) with (Fnum (FSucc p)); auto. pattern p at 2 in |- *; replace p with (Float (Fnum p) (Fexp p)). rewrite H'1; rewrite H'2. rewrite FSuccSimpl3; auto with arith. rewrite <- H'2. apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with arith. rewrite FshiftCorrect; auto. rewrite H'2; auto. case p; simpl in |- *; auto. pattern p at 1 in |- *; replace p with (Float (Fnum p) (Fexp p)). rewrite H'1; rewrite H'2. rewrite FSuccSimpl3; auto with arith. case p; simpl in |- *; auto. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; auto with zarith. case p; simpl in |- *; auto. rewrite FSuccSimpl2; auto with arith. intros H'3 H'4. unfold FtoRradix in |- *; rewrite <- FshiftCorrect with (n := 1) (x := p); auto. replace (Fshift radix 1 p) with (Fshift radix (S (Z.abs_nat (Fexp q - Fexp p))) q). repeat rewrite FshiftCorrect; auto with real. cut (Fexp (Fshift radix (S (Z.abs_nat (Fexp q - Fexp p))) q) = Fexp (Fshift radix 1 p)); [ intros Eq0 | idtac ]. apply floatEq; auto. apply sym_equal; apply Zeq_Zs; auto. apply Rle_Fexp_eq_Zle with (radix := radix); auto with arith. repeat rewrite FshiftCorrect; auto. replace (Z.succ (Fnum (Fshift radix 1 p))) with (Fnum (FSucc p)); auto. apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with arith. repeat rewrite FshiftCorrect; auto. rewrite FSuccSimpl2; auto with arith. rewrite FSuccSimpl2; auto with arith. rewrite FSuccSimpl2; auto with arith. unfold Fshift in |- *; simpl in |- *. rewrite Z.mul_1_r; auto. unfold pPred in |- *; rewrite (PosNormMin radix) with (precision := precision); auto with zarith; rewrite H'1. rewrite Zopp_mult_distr_l_reverse. rewrite (Zmult_comm radix). apply Zopp_Zpred_Zs. unfold Fshift in |- *; simpl in |- *. replace (Zpos (P_of_succ_nat (Z.abs_nat (Fexp q - Fexp p)))) with (Z.succ (Fexp q - Fexp p)). unfold Z.succ, Z.pred in |- *; ring. rewrite <- (inj_abs (Fexp q - Fexp p)); auto with zarith. rewrite <- inj_S; simpl in |- *; auto. rewrite inj_abs; auto with zarith. rewrite FSuccSimpl4; auto. intros H'2 H'3. replace p with (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q). unfold FtoRradix in |- *; rewrite FshiftCorrect; auto with real. cut (Fexp (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q) = Fexp p); [ intros Eq0 | idtac ]. apply floatEq; auto. apply sym_equal; apply Zeq_Zs; auto. apply Rle_Fexp_eq_Zle with (radix := radix); auto with arith. rewrite FshiftCorrect; auto. replace (Z.succ (Fnum p)) with (Fnum (FSucc p)); auto. rewrite FSuccSimpl4; auto. apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with arith. repeat rewrite FshiftCorrect; auto. rewrite FSuccSimpl4; auto. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; auto with zarith. Qed. Definition FNSucc x := FSucc (Fnormalize radix b precision x). Theorem FNSuccCanonic : forall a : float, Fbounded b a -> Fcanonic radix b (FNSucc a). intros a H'; unfold FNSucc in |- *. apply FSuccCanonic; auto with float. Qed. Theorem FNSuccLt : forall a : float, (a < FNSucc a)%R. intros a; unfold FNSucc in |- *. unfold FtoRradix in |- *; rewrite <- (FnormalizeCorrect _ radixMoreThanOne b precision a). apply FSuccLt; auto. Qed. Theorem FNSuccProp : forall x y : float, Fbounded b x -> Fbounded b y -> (x < y)%R -> (FNSucc x <= y)%R. intros x y H' H'0 H'1; unfold FNSucc in |- *. replace (FtoRradix y) with (FtoRradix (Fnormalize radix b precision y)). apply FSuccProp; auto with float. unfold FtoRradix in |- *; repeat rewrite FnormalizeCorrect; auto. unfold FtoRradix in |- *; repeat rewrite FnormalizeCorrect; auto. Qed. Theorem FNSuccEq : forall p q : float, Fbounded b p -> Fbounded b q -> p = q :>R -> FNSucc p = FNSucc q. intros p q H' H'0 H'1; unfold FNSucc in |- *. replace (Fnormalize radix b precision p) with (Fnormalize radix b precision q); auto. apply FcanonicUnique with (radix := radix) (b := b) (precision := precision); auto with float. repeat rewrite FnormalizeCorrect; auto. Qed. End suc. Hint Resolve FSuccNormPos FBoundedSuc FSuccSubnormal FSuccNegCanonic FSuccCanonic FSuccLt FSuccPropPos R0RltRleSucc FSuccPropNeg FSuccProp FNSuccCanonic FNSuccLt: float. Section suc1. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Hypothesis precisionNotZero : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem nNormMimLtvNum : (nNormMin radix precision < pPred (vNum b))%Z. unfold pPred in |- *; rewrite PosNormMin with (radix := radix) (precision := precision); auto with zarith. apply Z.lt_le_trans with (Z.pred (2 * nNormMin radix precision)). replace (Z.pred (2 * nNormMin radix precision)) with (Z.pred (nNormMin radix precision) + nNormMin radix precision)%Z; [ idtac | unfold Z.pred in |- *; ring ]. pattern (nNormMin radix precision) at 1 in |- *; replace (nNormMin radix precision) with (0 + nNormMin radix precision)%Z; [ idtac | ring ]. apply Zplus_lt_compat_r; auto. apply Zlt_succ_pred. replace (Z.succ 0) with (Z_of_nat 1); [ idtac | simpl in |- *; auto ]. rewrite <- (Zpower_nat_O radix); unfold nNormMin in |- *. apply Zpower_nat_monotone_lt. assumption. now apply lt_pred. apply Zle_Zpred_Zpred. apply Zle_Zmult_comp_r; auto with zarith. apply Z.lt_le_incl; apply nNormPos; auto with zarith. Qed. Theorem FSucFSucMid : forall p : float, Fnum (FSucc b radix precision p) <> nNormMin radix precision -> Fnum (FSucc b radix precision p) <> (- nNormMin radix precision)%Z -> Fminus radix (FSucc b radix precision (FSucc b radix precision p)) (FSucc b radix precision p) = Fminus radix (FSucc b radix precision p) p :>R. intros p. generalize (Z_eq_bool_correct (Fnum p) (- nNormMin radix precision)); case (Z_eq_bool (Fnum p) (- nNormMin radix precision)); intros H'1. generalize (Z_eq_bool_correct (Fexp p) (- dExp b)); case (Z_eq_bool (Fexp p) (- dExp b)); intros H'2. rewrite FSuccDiff2 with (2 := H'1); auto with arith. replace p with (Float (Fnum p) (Fexp p)). repeat (rewrite H'1; rewrite H'2). rewrite FSuccSimpl3; auto with arith. rewrite FSuccDiff1 with (2 := pGivesBound); auto with arith. simpl in |- *; auto with zarith. apply floatEq; auto. unfold FtoRradix in |- *; rewrite FSuccDiff3 with (x := p) (3 := pGivesBound); auto with arith. rewrite FSuccSimpl2; auto with arith. rewrite FSuccDiff1; simpl in |- *; auto with arith. apply Zlt_not_eq; auto. apply Zlt_Zopp; auto. apply nNormMimLtvNum; auto. unfold FtoRradix in |- *; rewrite FSuccDiff1 with (x := p); simpl in |- *; auto with arith. generalize (Z_eq_bool_correct (Fnum p) (pPred (vNum b))); case (Z_eq_bool (Fnum p) (pPred (vNum b))); intros H'2. rewrite FSuccSimpl1; simpl in |- *; auto with arith. intros H'; case H'; auto. rewrite FSuccSimpl4; simpl in |- *; auto with arith. intros H' H'0. rewrite FSuccDiff1; simpl in |- *; auto with arith. Qed. Theorem FNSuccFNSuccMid : forall p : float, Fbounded b p -> Fnum (FNSucc b radix precision p) <> nNormMin radix precision -> Fnum (FNSucc b radix precision p) <> (- nNormMin radix precision)%Z -> Fminus radix (FNSucc b radix precision (FNSucc b radix precision p)) (FNSucc b radix precision p) = Fminus radix (FNSucc b radix precision p) p :>R. intros p Fb; unfold FNSucc in |- *. intros H' H'0. rewrite FcanonicFnormalizeEq with (p := FSucc b radix precision (Fnormalize radix b precision p)); auto with float arith. rewrite FSucFSucMid; auto. unfold FtoRradix in |- *; repeat rewrite Fminus_correct; auto with float arith. rewrite FnormalizeCorrect; auto. apply Z.lt_trans with 1%Z; auto with zarith. apply Z.lt_trans with 1%Z; auto with zarith. Qed. End suc1. Hint Resolve nNormMimLtvNum: float. float-8.10.0/Faux.v000066400000000000000000001053131357127175600140200ustar00rootroot00000000000000(**************************************************************************** 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 *) Theorem minus_minus : forall a b : nat, a <= b -> b - (b - a) = a. intros a b H'. apply sym_equal. apply plus_minus; auto. rewrite plus_comm; apply le_plus_minus; auto. Qed. Theorem lte_comp_mult : forall p q r t : nat, p <= q -> r <= t -> p * r <= q * t. 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. Theorem le_refl_eq : forall n m : nat, n = m -> n <= m. intros n m H'; rewrite H'; auto. Qed. Theorem lt_le_pred : forall n m : nat, n < m -> n <= pred m. intros n m H'; inversion H'; simpl in |- *; auto. apply le_trans with (S n); auto. Qed. Theorem lt_comp_mult_l : forall p q r : nat, 0 < p -> q < r -> p * q < p * r. 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. Theorem lt_comp_mult_r : forall p q r : nat, 0 < p -> q < r -> q * p < r * p. intros; repeat rewrite (fun x : nat => mult_comm x p); auto with arith. Qed. Hint Resolve lt_comp_mult_r: arith. Theorem lt_comp_mult : forall p q r s : nat, p < q -> r < s -> p * r < q * s. 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. Theorem mult_eq_inv : forall n m p : nat, 0 < n -> n * m = n * p -> m = p. 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. Theorem notEqLt : forall n : nat, 0 < n -> n <> 0. intros n H'; Contradict H'; auto. rewrite H'; auto with arith. Qed. Hint Resolve notEqLt: arith. Theorem lt_next : forall n m : nat, n < m -> m = S n \/ S n < m. intros n m H'; elim H'; auto with arith. Qed. Theorem le_next : forall n m : nat, n <= m -> m = n \/ S n <= m. intros n m H'; case (le_lt_or_eq _ _ H'); auto with arith. Qed. Theorem min_or : forall n m : nat, min n m = n /\ n <= m \/ min n m = m /\ m < n. 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. Theorem minus_inv_lt_aux : forall n m : nat, n - m = 0 -> n - S m = 0. intros n; elim n; simpl in |- *; auto with arith. intros n0 H' m; case m; auto with arith. intros H'0; discriminate. Qed. Theorem minus_inv_lt : forall n m : nat, m <= n -> m - n = 0. intros n m H'; elim H'; simpl in |- *; auto with arith. intros m0 H'0 H'1; apply minus_inv_lt_aux; auto. Qed. Theorem minus_le : forall m n p q : nat, m <= n -> p <= q -> m - q <= n - p. 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. Theorem lt_minus_inv : forall n m p : nat, n <= p -> m < n -> p - n < p - m. 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. Theorem lt_mult_anti_compatibility : forall n n1 n2 : nat, 0 < n -> n * n1 < n * n2 -> n1 < n2. 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. Theorem le_mult_anti_compatibility : forall n n1 n2 : nat, 0 < n -> n * n1 <= n * n2 -> n1 <= n2. 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. Theorem min_n_0 : forall n : nat, min n 0 = 0. intros n; case n; simpl in |- *; auto. Qed. (*Simplification rules missing in R *) Hint Resolve Rabs_pos: real. Theorem Rlt_Rminus_ZERO : forall r1 r2 : R, (r2 < r1)%R -> (0 < r1 - r2)%R. intros r1 r2 H; replace 0%R with (r1 - r1)%R; unfold Rminus in |- *; auto with real. Qed. Hint Resolve Rlt_Rminus_ZERO: real. Theorem Rabsolu_left1 : forall a : R, (a <= 0)%R -> Rabs a = (- a)%R. intros a H; case H; intros H1. apply Rabs_left; auto. rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real. Qed. Theorem RmaxLess1 : forall r1 r2 : R, (r1 <= Rmax r1 r2)%R. intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. Qed. Theorem RmaxLess2 : forall r1 r2 : R, (r2 <= Rmax r1 r2)%R. intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real; intros; apply Ropp_le_cancel; auto with real. Qed. Theorem RmaxSym : forall p q : R, Rmax p q = Rmax q p. 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. Theorem RmaxAbs : forall p q r : R, (p <= q)%R -> (q <= r)%R -> (Rabs q <= Rmax (Rabs p) (Rabs r))%R. 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. Theorem Rabsolu_Zabs : forall z : Z, Rabs (IZR z) = IZR (Z.abs z). 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. Theorem RmaxRmult : forall p q r : R, (0 <= r)%R -> Rmax (r * p) (r * q) = (r * Rmax p q)%R. 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. Theorem Rle_R0_Ropp : forall p : R, (p <= 0)%R -> (0 <= - p)%R. intros p H; rewrite <- Ropp_0; auto with real. Qed. Theorem Rlt_R0_Ropp : forall p : R, (p < 0)%R -> (0 < - p)%R. intros p H; rewrite <- Ropp_0; auto with real. Qed. Hint Resolve Rle_R0_Ropp Rlt_R0_Ropp: real. (* Properties of Z *) Theorem convert_not_O : forall p : positive, nat_of_P p <> 0. 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. Theorem inj_abs : forall x : Z, (0 <= x)%Z -> Z_of_nat (Z.abs_nat x) = x. 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. Theorem inject_nat_convert : forall (p : Z) (q : positive), p = Zpos q -> Z_of_nat (nat_of_P q) = p. 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. Theorem ZleLe : forall x y : nat, (Z_of_nat x <= Z_of_nat y)%Z -> x <= y. intros x y H'. case (le_or_lt x y); auto with arith. intros H'0; Contradict H'; auto with zarith. Qed. Theorem inject_nat_eq : forall x y : nat, Z_of_nat x = Z_of_nat y -> x = y. 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. Theorem Zcompare_EGAL : forall p q : Z, (p ?= q)%Z = Datatypes.Eq -> p = q. 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. Theorem Zlt_Zopp : forall x y : Z, (x < y)%Z -> (- y < - x)%Z. 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. Theorem Zle_Zopp : forall x y : Z, (x <= y)%Z -> (- y <= - x)%Z. intros x y H'; case (Zle_lt_or_eq _ _ H'); auto with zarith. Qed. Hint Resolve Zle_Zopp: zarith. Theorem absolu_INR : forall n : nat, Z.abs_nat (Z_of_nat n) = n. 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. Theorem absolu_Zopp : forall p : Z, Z.abs_nat (- p) = Z.abs_nat p. intros p; case p; simpl in |- *; auto. Qed. Theorem Zabs_absolu : forall z : Z, Z.abs z = Z_of_nat (Z.abs_nat z). intros z; case z; simpl in |- *; auto; intros p; apply sym_equal; apply inject_nat_convert; auto. Qed. Theorem absolu_comp_mult : forall p q : Z, Z.abs_nat (p * q) = Z.abs_nat p * Z.abs_nat q. 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. Theorem Zmin_sym : forall m n : Z, Z.min n m = Z.min m n. 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. Theorem Zpower_nat_O : forall z : Z, Zpower_nat z 0 = Z_of_nat 1. intros z; unfold Zpower_nat in |- *; simpl in |- *; auto. Qed. Theorem Zpower_nat_1 : forall z : Z, Zpower_nat z 1 = z. intros z; unfold Zpower_nat in |- *; simpl in |- *; rewrite Zmult_1_r; auto. Qed. Theorem Zmin_le1 : forall z1 z2 : Z, (z1 <= z2)%Z -> Z.min z1 z2 = z1. intros z1 z2; unfold Z.le, Z.min in |- *; case (z1 ?= z2)%Z; auto; intros H; Contradict H; auto. Qed. Theorem Zmin_le2 : forall z1 z2 : Z, (z2 <= z1)%Z -> Z.min z1 z2 = z2. intros z1 z2 H; rewrite Zmin_sym; apply Zmin_le1; auto. Qed. Theorem Zmin_Zle : forall z1 z2 z3 : Z, (z1 <= z2)%Z -> (z1 <= z3)%Z -> (z1 <= Z.min z2 z3)%Z. intros z1 z2 z3 H' H'0; unfold Z.min in |- *. case (z2 ?= z3)%Z; auto. Qed. Theorem Zminus_n_predm : forall n m : Z, Z.succ (n - m) = (n - Z.pred m)%Z. intros n m. unfold Z.pred in |- *; unfold Z.succ in |- *; ring. Qed. Theorem Zopp_Zpred_Zs : forall z : Z, (- Z.pred z)%Z = Z.succ (- z). intros z; unfold Z.pred, Z.succ in |- *; ring. Qed. Theorem Zle_mult_gen : forall x y : Z, (0 <= x)%Z -> (0 <= y)%Z -> (0 <= x * y)%Z. 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. Theorem ZmaxLe1 : forall z1 z2 : Z, (z1 <= Zmax z1 z2)%Z. 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. Theorem ZmaxSym : forall z1 z2 : Z, Zmax z1 z2 = Zmax z2 z1. 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. Theorem Zmax_le2 : forall z1 z2 : Z, (z1 <= z2)%Z -> Zmax z1 z2 = z2. intros z1 z2; unfold Z.le, Zmax in |- *; case (z1 ?= z2)%Z; auto. intros H'; case H'; auto. Qed. Theorem Zmax_le1 : forall z1 z2 : Z, (z2 <= z1)%Z -> Zmax z1 z2 = z1. intros z1 z2 H'; rewrite ZmaxSym; apply Zmax_le2; auto. Qed. Theorem ZmaxLe2 : forall z1 z2 : Z, (z2 <= Zmax z1 z2)%Z. intros z1 z2; rewrite ZmaxSym; apply ZmaxLe1. Qed. Hint Resolve ZmaxLe1 ZmaxLe2: zarith. Theorem Zeq_Zs : forall p q : Z, (p <= q)%Z -> (q < Z.succ p)%Z -> p = q. intros p q H' H'0; apply Zle_antisym; auto. apply Zlt_succ_le; auto. Qed. Theorem Zmin_Zmax : forall z1 z2 : Z, (Z.min z1 z2 <= Zmax z1 z2)%Z. 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. Theorem Zabs_Zmult : forall z1 z2 : Z, Z.abs (z1 * z2) = (Z.abs z1 * Z.abs z2)%Z. intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith. Qed. Theorem Zle_Zmult_comp_r : forall x y z : Z, (0 <= z)%Z -> (x <= y)%Z -> (x * z <= y * z)%Z. 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. Theorem Zle_Zmult_comp_l : forall x y z : Z, (0 <= z)%Z -> (x <= y)%Z -> (z * x <= z * y)%Z. intros x y z H' H'0; repeat rewrite (Zmult_comm z); apply Zle_Zmult_comp_r; auto. Qed. Theorem NotZmultZero : forall z1 z2 : Z, z1 <> 0%Z -> z2 <> 0%Z -> (z1 * z2)%Z <> 0%Z. intros z1 z2; case z1; case z2; simpl in |- *; intros; auto; try discriminate. Qed. Hint Resolve NotZmultZero: zarith. (* Conversions from R <-> Z <-> N *) Theorem IZR_zero : forall p : Z, p = 0%Z -> IZR p = 0%R. intros p H'; rewrite H'; auto. Qed. Hint Resolve not_O_INR: real. Theorem IZR_zero_r : forall p : Z, IZR p = 0%R -> p = 0%Z. 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. Theorem INR_lt_nm : forall n m : nat, n < m -> (INR n < INR m)%R. 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. Theorem Rlt_INR1 : forall n : nat, 1 < n -> (1 < INR n)%R. replace 1%R with (INR 1); auto with real. Qed. Hint Resolve Rlt_INR1: real. Theorem NEq_INR : forall n m : nat, n <> m -> INR n <> INR m. 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. Theorem NEq_INRO : forall n : nat, n <> 0 -> INR n <> 0%R. replace 0%R with (INR 0); auto with real. Qed. Hint Resolve NEq_INRO: real. Theorem NEq_INR1 : forall n : nat, n <> 1 -> INR n <> 1%R. replace 1%R with (INR 1); auto with real. Qed. Hint Resolve NEq_INR1: real. Theorem not_O_lt : forall n : nat, n <> 0 -> 0 < n. intros n; elim n; simpl in |- *; auto with arith. Qed. Hint Resolve not_O_lt: arith. Theorem NEq_IZRO : forall n : Z, n <> 0%Z -> IZR n <> 0%R. intros n H; Contradict H. apply IZR_zero_r; auto. Qed. Hint Resolve NEq_IZRO: real. Theorem Rlt_IZR : forall p q : Z, (p < q)%Z -> (IZR p < IZR q)%R. 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. Theorem Rle_IZR : forall x y : Z, (x <= y)%Z -> (IZR x <= IZR y)%R. 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. Theorem Rlt_IZRO : forall p : Z, (0 < p)%Z -> (0 < IZR p)%R. intros p H; replace 0%R with (IZR 0); auto with real. Qed. Hint Resolve Rlt_IZRO: real. Theorem Rle_IZRO : forall x y : Z, (0 <= y)%Z -> (0 <= IZR y)%R. intros; replace 0%R with (IZR 0); auto with real. Qed. Hint Resolve Rle_IZRO: real. Theorem Rlt_IZR1 : forall p q : Z, (1 < q)%Z -> (1 < IZR q)%R. intros; replace 1%R with (IZR 1); auto with real. Qed. Hint Resolve Rlt_IZR1: real. Theorem Rle_IZR1 : forall x y : Z, (1 <= y)%Z -> (1 <= IZR y)%R. intros; replace 1%R with (IZR 1); auto with real. Qed. Hint Resolve Rle_IZR1: real. Theorem lt_Rlt : forall n m : nat, (INR n < INR m)%R -> n < m. 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. Theorem INR_inv : forall n m : nat, INR n = INR m -> n = m. 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. Theorem Rle_INR : forall x y : nat, x <= y -> (INR x <= INR y)%R. intros x y H; repeat rewrite INR_IZR_INZ. apply Rle_IZR; auto with zarith. Qed. Hint Resolve Rle_INR: real. Theorem le_Rle : forall n m : nat, (INR n <= INR m)%R -> n <= m. 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. Theorem Rmult_IZR : forall z t : Z, IZR (z * t) = (IZR z * IZR t)%R. 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. Theorem absolu_Zs : forall z : Z, (0 <= z)%Z -> Z.abs_nat (Z.succ z) = S (Z.abs_nat z). 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. Theorem Zlt_next : forall n m : Z, (n < m)%Z -> m = Z.succ n \/ (Z.succ n < m)%Z. intros n m H'; case (Zle_lt_or_eq (Z.succ n) m); auto with zarith. Qed. Theorem Zle_next : forall n m : Z, (n <= m)%Z -> m = n \/ (Z.succ n <= m)%Z. intros n m H'; case (Zle_lt_or_eq _ _ H'); auto with zarith. Qed. Theorem Zlt_Zopp_Inv : forall p q : Z, (- p < - q)%Z -> (q < p)%Z. intros x y H'; case (Zle_or_lt x y); auto with zarith. Qed. Theorem Zle_Zopp_Inv : forall p q : Z, (- p <= - q)%Z -> (q <= p)%Z. intros p q H'; case (Zle_lt_or_eq _ _ H'); auto with zarith. Qed. Theorem absolu_Zs_neg : forall z : Z, (z < 0)%Z -> S (Z.abs_nat (Z.succ z)) = Z.abs_nat z. 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. Theorem Zlt_absolu : forall (x : Z) (n : nat), Z.abs_nat x < n -> (x < Z_of_nat n)%Z. 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. Theorem inj_pred : forall n : nat, n <> 0 -> Z_of_nat (pred n) = Z.pred (Z_of_nat n). intros n; case n; auto. intros H'; Contradict H'; auto. intros n0 H'; rewrite inj_S; rewrite <- Zpred_succ; auto. Qed. Theorem Zle_abs : forall p : Z, (p <= Z_of_nat (Z.abs_nat p))%Z. 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. Theorem ZleAbs : forall (z : Z) (n : nat), (- Z_of_nat n <= z)%Z -> (z <= Z_of_nat n)%Z -> Z.abs_nat z <= n. 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. Theorem lt_Zlt_inv : forall n m : nat, (Z_of_nat n < Z_of_nat m)%Z -> n < m. 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. Theorem NconvertO : forall p : positive, nat_of_P p <> 0. 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. Theorem absolu_lt_nz : forall z : Z, z <> 0%Z -> 0 < Z.abs_nat z. intros z; case z; simpl in |- *; auto; try (intros H'; case H'; auto; fail); intros p; generalize (NconvertO p); auto with arith. Qed. Theorem Rlt2 : (0 < INR 2)%R. replace 0%R with (INR 0); auto with real arith. Qed. Hint Resolve Rlt2: real. Theorem RlIt2 : (0 < / INR 2)%R. apply Rmult_lt_reg_l with (r := INR 2); auto with real. Qed. Hint Resolve RlIt2: real. Theorem Rledouble : forall r : R, (0 <= r)%R -> (r <= INR 2 * r)%R. 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. Theorem Rltdouble : forall r : R, (0 < r)%R -> (r < INR 2 * r)%R. 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. intros r H'. apply Rmult_lt_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r. apply Rmult_lt_compat_r; replace 1%R with (INR 1); auto with real arith. replace 0%R with (INR 0); auto with real arith. Qed. Hint Resolve Rledouble: real. Theorem Rle_Rinv : forall x y : R, (0 < x)%R -> (x <= y)%R -> (/ y <= / x)%R. intros x y H H1; case H1; intros H2. left; apply Rinv_lt_contravar; auto. apply Rmult_lt_0_compat; auto. apply Rlt_trans with (2 := H2); auto. rewrite H2; auto with real. Qed. Theorem Int_part_INR : forall n : nat, Int_part (INR n) = Z_of_nat n. intros n; unfold Int_part in |- *. cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z). intros H'; rewrite H'; simpl in |- *; ring. apply sym_equal; apply tech_up; auto. replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)). repeat rewrite <- INR_IZR_INZ. apply INR_lt_nm; auto. rewrite Zplus_comm; rewrite <- inj_plus; simpl in |- *; auto. rewrite plus_IZR; simpl in |- *; auto with real. repeat rewrite <- INR_IZR_INZ; auto with real. Qed. Theorem Int_part_IZR : forall z : Z, Int_part (IZR z) = z. intros z; unfold Int_part in |- *. cut (up (IZR z) = (z + 1)%Z). intros Z1; rewrite Z1; rewrite Zplus_comm; apply Zminus_plus; auto with zarith. apply sym_equal; apply tech_up; simpl in |- *; auto with real zarith. replace (IZR z) with (IZR z + IZR 0)%R; try rewrite plus_IZR; auto with real zarith. Qed. Theorem Zlt_Rlt : forall z1 z2 : Z, (IZR z1 < IZR z2)%R -> (z1 < z2)%Z. intros z1 z2 H; case (Zle_or_lt z2 z1); auto. intros H1; Contradict H; auto with real zarith. apply Rle_not_lt; auto with real zarith. Qed. Theorem Zle_Rle : forall z1 z2 : Z, (IZR z1 <= IZR z2)%R -> (z1 <= z2)%Z. intros z1 z2 H; case (Zle_or_lt z1 z2); auto. intros H1; Contradict H; auto with real zarith. apply Rlt_not_le; auto with real zarith. Qed. Theorem IZR_inv : forall z1 z2 : Z, IZR z1 = IZR z2 :>R -> z1 = z2. intros z1 z2 H; apply Zle_antisym; apply Zle_Rle; rewrite H; auto with real. Qed. Theorem Zabs_eq_opp : forall x, (x <= 0)%Z -> Z.abs x = (- x)%Z. intros x; case x; simpl in |- *; auto. intros p H; Contradict H; auto with zarith. Qed. Theorem Zabs_Zs : forall z : Z, (Z.abs (Z.succ z) <= Z.succ (Z.abs z))%Z. intros z; case z; auto. simpl in |- *; auto with zarith. repeat rewrite Z.abs_eq; auto with zarith. intros p; rewrite Zabs_eq_opp; auto with zarith. 2: unfold Z.succ in |- *; replace 0%Z with (-1 + 1)%Z; auto with zarith. 2: case p; simpl in |- *; intros; red in |- *; simpl in |- *; intros; red in |- *; intros; discriminate. replace (- Z.succ (Zneg p))%Z with (Zpos p - 1)%Z. replace (Z.succ (Z.abs (Zneg p))) with (Zpos p + 1)%Z; auto with zarith. unfold Z.succ in |- *; rewrite Zopp_plus_distr. auto with zarith. Qed. Hint Resolve Zabs_Zs: zarith. Theorem Zle_Zpred : forall x y : Z, (x < y)%Z -> (x <= Z.pred y)%Z. intros x y H; apply Zlt_succ_le. rewrite <- Zsucc_pred; auto. Qed. Hint Resolve Zle_Zpred: zarith. Theorem Zabs_Zopp : forall z : Z, Z.abs (- z) = Z.abs z. intros z; case z; simpl in |- *; auto. Qed. Theorem Zle_Zabs : forall z : Z, (z <= Z.abs z)%Z. intros z; case z; simpl in |- *; red in |- *; simpl in |- *; auto; try (red in |- *; intros; discriminate; fail). intros p; elim p; simpl in |- *; auto; try (red in |- *; intros; discriminate; fail). Qed. Hint Resolve Zle_Zabs: zarith. Theorem Zlt_mult_simpl_l : forall a b c : Z, (0 < c)%Z -> (c * a < c * b)%Z -> (a < b)%Z. intros a b0 c H H0; apply Z.gt_lt. apply Zmult_gt_reg_r with (p := c); try apply Z.lt_gt; auto with zarith. repeat rewrite (fun x => Zmult_comm x c); auto with zarith. Qed. (* An equality function on Z that return a bool *) Fixpoint pos_eq_bool (a b : positive) {struct b} : bool := match a, b with | xH, xH => true | xI a', xI b' => pos_eq_bool a' b' | xO a', xO b' => pos_eq_bool a' b' | _, _ => false end. Theorem pos_eq_bool_correct : forall p q : positive, match pos_eq_bool p q with | true => p = q | false => p <> q end. intros p q; generalize p; elim q; simpl in |- *; auto; clear p q. intros p Rec q; case q; simpl in |- *; try (intros; red in |- *; intros; discriminate; fail). intros q'; generalize (Rec q'); case (pos_eq_bool q' p); simpl in |- *; auto. intros H1; rewrite H1; auto. intros H1; Contradict H1; injection H1; auto. intros p Rec q; case q; simpl in |- *; try (intros; red in |- *; intros; discriminate; fail). intros q'; generalize (Rec q'); case (pos_eq_bool q' p); simpl in |- *; auto. intros H1; rewrite H1; auto. intros H1; Contradict H1; injection H1; auto. intros q; case q; simpl in |- *; try (intros; red in |- *; intros; discriminate; fail); auto. Qed. Theorem Z_O_1 : (0 < 1)%Z. red in |- *; simpl in |- *; auto; intros; red in |- *; intros; discriminate. Qed. Hint Resolve Z_O_1: zarith. Definition Z_eq_bool a b := match a, b with | Z0, Z0 => true | Zpos a', Zpos b' => pos_eq_bool a' b' | Zneg a', Zneg b' => pos_eq_bool a' b' | _, _ => false end. Theorem Z_eq_bool_correct : forall p q : Z, match Z_eq_bool p q with | true => p = q | false => p <> q end. intros p q; case p; case q; simpl in |- *; auto; try (intros; red in |- *; intros; discriminate; fail). intros p' q'; generalize (pos_eq_bool_correct q' p'); case (pos_eq_bool q' p'); simpl in |- *; auto. intros H1; rewrite H1; auto. intros H1; Contradict H1; injection H1; auto. intros p' q'; generalize (pos_eq_bool_correct q' p'); case (pos_eq_bool q' p'); simpl in |- *; auto. intros H1; rewrite H1; auto. intros H1; Contradict H1; injection H1; auto. Qed. Theorem Zlt_mult_ZERO : forall x y : Z, (0 < x)%Z -> (0 < y)%Z -> (0 < x * y)%Z. intros x y; case x; case y; unfold Z.lt in |- *; simpl in |- *; auto. Qed. Hint Resolve Zlt_mult_ZERO: zarith. Theorem Zlt_Zminus_ZERO : forall z1 z2 : Z, (z2 < z1)%Z -> (0 < z1 - z2)%Z. intros z1 z2; rewrite (Zminus_diag_reverse z2); auto with zarith. Qed. Theorem Zle_Zminus_ZERO : forall z1 z2 : Z, (z2 <= z1)%Z -> (0 <= z1 - z2)%Z. intros z1 z2; rewrite (Zminus_diag_reverse z2); auto with zarith. Qed. Hint Resolve Zle_Zminus_ZERO Zlt_Zminus_ZERO: zarith. Theorem Zle_Zpred_Zpred : forall z1 z2 : Z, (z1 <= z2)%Z -> (Z.pred z1 <= Z.pred z2)%Z. intros z1 z2 H; apply Zsucc_le_reg. repeat rewrite <- Zsucc_pred; auto. Qed. Hint Resolve Zle_Zpred_Zpred: zarith. Theorem Zle_ZERO_Zabs : forall z : Z, (0 <= Z.abs z)%Z. intros z; case z; simpl in |- *; auto with zarith. Qed. Hint Resolve Zle_ZERO_Zabs: zarith. Theorem Zlt_Zabs_inv1 : forall z1 z2 : Z, (Z.abs z1 < z2)%Z -> (- z2 < z1)%Z. intros z1 z2 H; case (Zle_or_lt 0 z1); intros H1. apply Z.lt_le_trans with (- (0))%Z; auto with zarith. apply Zlt_Zopp; apply Z.le_lt_trans with (2 := H); auto with zarith. rewrite <- (Z.opp_involutive z1); rewrite <- (Zabs_eq_opp z1); auto with zarith. Qed. Theorem Zlt_Zabs_inv2 : forall z1 z2 : Z, (Z.abs z1 < Z.abs z2)%Z -> (z1 < Z.abs z2)%Z. intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith. Qed. Theorem Zle_Zabs_inv1 : forall z1 z2 : Z, (Z.abs z1 <= z2)%Z -> (- z2 <= z1)%Z. intros z1 z2 H; case (Zle_or_lt 0 z1); intros H1. apply Z.le_trans with (- (0))%Z; auto with zarith. apply Zle_Zopp; apply Z.le_trans with (2 := H); auto with zarith. rewrite <- (Z.opp_involutive z1); rewrite <- (Zabs_eq_opp z1); auto with zarith. Qed. Theorem Zle_Zabs_inv2 : forall z1 z2 : Z, (Z.abs z1 <= z2)%Z -> (z1 <= z2)%Z. intros z1 z2 H; case (Zle_or_lt 0 z1); intros H1. rewrite <- (Z.abs_eq z1); auto. apply Z.le_trans with (Z.abs z1); auto with zarith. Qed. Theorem Zlt_Zabs_Zpred : forall z1 z2 : Z, (Z.abs z1 < z2)%Z -> z1 <> Z.pred z2 -> (Z.abs (Z.succ z1) < z2)%Z. intros z1 z2 H H0; case (Zle_or_lt 0 z1); intros H1. rewrite Z.abs_eq; auto with zarith. rewrite Z.abs_eq in H; auto with zarith. apply Z.lt_trans with (2 := H). repeat rewrite Zabs_eq_opp; auto with zarith. Qed. Theorem Zle_n_Zpred : forall z1 z2 : Z, (Z.pred z1 <= Z.pred z2)%Z -> (z1 <= z2)%Z. intros z1 z2 H; rewrite (Zsucc_pred z1); rewrite (Zsucc_pred z2); auto with zarith. Qed. Theorem Zpred_Zopp_Zs : forall z : Z, Z.pred (- z) = (- Z.succ z)%Z. intros z; unfold Z.pred, Z.succ in |- *; ring. Qed. Theorem Zlt_1_O : forall z : Z, (1 <= z)%Z -> (0 < z)%Z. intros z H; apply Zsucc_lt_reg; simpl in |- *; auto with zarith. Qed. Hint Resolve Zlt_succ Zsucc_lt_compat Zle_lt_succ: zarith. Theorem Zlt_not_eq : forall p q : Z, (p < q)%Z -> p <> q. intros p q H; Contradict H; rewrite H; auto with zarith. Qed. Theorem Zlt_not_eq_rev : forall p q : Z, (q < p)%Z -> p <> q. intros p q H; Contradict H; rewrite H; auto with zarith. Qed. Hint Resolve Zlt_not_eq Zlt_not_eq_rev: zarith. Theorem Zle_Zpred_Zlt : forall z1 z2 : Z, (z1 <= z2)%Z -> (Z.pred z1 < z2)%Z. intros z1 z2 H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; auto with zarith. Qed. Hint Resolve Zle_Zpred_Zlt: zarith. Theorem Zle_Zpred_inv : forall z1 z2 : Z, (z1 <= Z.pred z2)%Z -> (z1 < z2)%Z. intros z1 z2 H; rewrite (Zsucc_pred z2); auto with zarith. Qed. Theorem Zabs_intro : forall (P : Z -> Prop) (z : Z), P (- z)%Z -> P z -> P (Z.abs z). intros P z; case z; simpl in |- *; auto. Qed. Theorem Zpred_Zle_Zabs_intro : forall z1 z2 : Z, (- Z.pred z2 <= z1)%Z -> (z1 <= Z.pred z2)%Z -> (Z.abs z1 < z2)%Z. intros z1 z2 H H0; apply Zle_Zpred_inv. apply Zabs_intro with (P := fun x => (x <= Z.pred z2)%Z); auto with zarith. Qed. Theorem Zlt_ZERO_Zle_ONE : forall z : Z, (0 < z)%Z -> (1 <= z)%Z. intros z H; replace 1%Z with (Z.succ 0); auto with zarith; simpl in |- *; auto. Qed. Hint Resolve Zlt_ZERO_Zle_ONE: zarith. Theorem ptonat_def1 : forall p q, 1 < Pmult_nat p (S (S q)). intros p; elim p; simpl in |- *; auto with arith. Qed. Hint Resolve ptonat_def1: arith. Theorem lt_S_le : forall p q, p < q -> S p <= q. intros p q; unfold lt in |- *; simpl in |- *; auto. Qed. Hint Resolve lt_S_le: arith. Theorem Zlt_Zabs_intro : forall z1 z2 : Z, (- z2 < z1)%Z -> (z1 < z2)%Z -> (Z.abs z1 < z2)%Z. intros z1 z2; case z1; case z2; simpl in |- *; auto with zarith. intros p p0 H H0; change (- Zneg p0 < - Zneg p)%Z in |- *; auto with zarith. Qed. float-8.10.0/Fbound.v000066400000000000000000000274441357127175600143420ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fbound Laurent Thery ******************************************************************************) Require Export Fop. Section Fbounded_Def. Variable radix : Z. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Coercion Z_of_N: N >-> Z. Record Fbound : Set := Bound {vNum : positive; dExp : N}. Definition Fbounded (b : Fbound) (d : float) := (Z.abs (Fnum d) < Zpos (vNum b))%Z /\ (- dExp b <= Fexp d)%Z. Theorem FboundedNum : forall (b : Fbound) (p : float), Fbounded b p -> (Z.abs (Fnum p) < Zpos (vNum b))%Z. intros b p H; case H; intros H1 H2; case H1; auto. Qed. Theorem FboundedExp : forall (b : Fbound) (p : float), Fbounded b p -> (- dExp b <= Fexp p)%Z. intros b p H; case H; auto. Qed. Hint Resolve FboundedNum FboundedExp: float. Theorem isBounded : forall (b : Fbound) (p : float), {Fbounded b p} + {~ Fbounded b p}. intros b p; case (Z_le_gt_dec (Zpos (vNum b)) (Z.abs (Fnum p))); intros H'. right; red in |- *; intros H'3; Contradict H'; auto with float zarith. case (Z_le_gt_dec (- dExp b) (Fexp p)); intros H'1. left; repeat split; auto with zarith. right; red in |- *; intros H'3; Contradict H'1; auto with float zarith. Qed. Theorem FzeroisZero : forall b : Fbound, Fzero (- dExp b) = 0%R :>R. intros b; unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real. Qed. Theorem FboundedFzero : forall b : Fbound, Fbounded b (Fzero (- dExp b)). intros b; repeat (split; simpl in |- *). replace 0%Z with (- 0%nat)%Z; [ idtac | simpl in |- *; auto ]. apply Zeq_le; auto with arith. Qed. Hint Unfold Fbounded. Theorem FboundedZeroSameExp : forall (b : Fbound) (p : float), Fbounded b p -> Fbounded b (Fzero (Fexp p)). intros b p H'; (repeat split; simpl in |- *; auto with float zarith). Qed. Theorem FBoundedScale : forall (b : Fbound) (p : float) (n : nat), Fbounded b p -> Fbounded b (Float (Fnum p) (Fexp p + n)). intros b p n H'; repeat split; simpl in |- *; auto with float. apply Z.le_trans with (Fexp p); auto with float. pattern (Fexp p) at 1 in |- *; (replace (Fexp p) with (Fexp p + 0%nat)%Z; [ idtac | simpl in |- *; ring ]). apply Zplus_le_compat_l. apply inj_le; auto with arith. Qed. Theorem FvalScale : forall (b : Fbound) (p : float) (n : nat), Float (Fnum p) (Fexp p + n) = (powerRZ radix n * p)%R :>R. intros b p n; unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_add; auto with real zarith. ring. Qed. Theorem oppBounded : forall (b : Fbound) (x : float), Fbounded b x -> Fbounded b (Fopp x). intros b x H'; repeat split; simpl in |- *; auto with float zarith. replace (Z.abs (- Fnum x)) with (Z.abs (Fnum x)); auto with float. case (Fnum x); simpl in |- *; auto. Qed. Theorem oppBoundedInv : forall (b : Fbound) (x : float), Fbounded b (Fopp x) -> Fbounded b x. intros b x H'; rewrite <- (Fopp_Fopp x). apply oppBounded; auto. Qed. Theorem FopRepAux : forall (b : Fbound) (z : Z) (p : R), ex (fun r : float => r = (- p)%R :>R /\ Fbounded b r /\ Fexp r = z) -> ex (fun r : float => r = p :>R /\ Fbounded b r /\ Fexp r = z). intros b z p H'; elim H'; intros r E; elim E; intros H'0 H'1; elim H'1; intros H'2 H'3; clear H'1 E H'. exists (Fopp r); split; auto. rewrite <- (Ropp_involutive p). rewrite <- H'0; auto. unfold FtoRradix in |- *; apply Fopp_correct; auto. split. apply oppBounded; auto. simpl in |- *; auto. Qed. Theorem absFBounded : forall (b : Fbound) (f : float), Fbounded b f -> Fbounded b (Fabs f). intros b f H'; repeat split; simpl in |- *; auto with float. replace (Z.abs (Z.abs (Fnum f))) with (Z.abs (Fnum f)); auto with float. case (Fnum f); auto. Qed. Theorem FboundedEqExpPos : forall (b : Fbound) (p q : float), Fbounded b p -> p = q :>R -> (Fexp p <= Fexp q)%R -> (0 <= q)%R -> Fbounded b q. intros b p q H' H'0 H'1 H'2. cut (0 <= Fnum p)%Z; [ intros Z1 | apply (LeR0Fnum radix); auto with real arith; fold FtoRradix in |- *; rewrite H'0; auto ]. cut (0 <= Fnum q)%Z; [ intros Z2 | apply (LeR0Fnum radix); auto with real arith ]. split. apply Z.le_lt_trans with (Z.abs (Fnum p)); [ idtac | auto with float ]. repeat rewrite Z.abs_eq; auto. apply Z.le_trans with (Fnum (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q)); auto. unfold Fshift in |- *; simpl in |- *; auto. pattern (Fnum q) at 1 in |- *; replace (Fnum q) with (Fnum q * 1)%Z; auto with zarith. apply (Rle_Fexp_eq_Zle radix); auto with real zarith. rewrite FshiftCorrect; auto with real zarith. unfold Fshift in |- *; simpl in |- *; rewrite inj_abs; try ring. apply Zle_Zminus_ZERO; apply le_IZR; auto with real arith. apply Z.le_trans with (Fexp p). case H'; auto. apply le_IZR; auto with real arith. Qed. Theorem FboundedEqExp : forall (b : Fbound) (p q : float), Fbounded b p -> p = q :>R -> (Fexp p <= Fexp q)%R -> Fbounded b q. intros b p q H' H'0 H'1; split. apply Z.le_lt_trans with (Z.abs (Fnum p)); [ idtac | auto with float ]. apply Z.le_trans with (Z.abs (Fnum (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q))); auto. unfold Fshift in |- *; simpl in |- *; auto. rewrite Zabs_Zmult. pattern (Z.abs (Fnum q)) at 1 in |- *; replace (Z.abs (Fnum q)) with (Z.abs (Fnum q) * 1%nat)%Z; [ apply Zle_Zmult_comp_l | auto with zarith ]; auto with zarith. rewrite Z.abs_eq; simpl in |- *; auto with zarith. simpl in |- *; ring. cut (Fexp p <= Fexp q)%Z; [ intros E2 | idtac ]. apply le_IZR; auto. apply (Rle_monotony_contra_exp radix) with (z := Fexp p); auto with real arith. pattern (Fexp p) at 2 in |- *; replace (Fexp p) with (Fexp (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q)); auto. rewrite <- (fun x => Rabs_pos_eq (powerRZ radix x)); auto with real zarith. rewrite <- Faux.Rabsolu_Zabs. rewrite <- Rabs_mult. change (Rabs (FtoRradix (Fshift radix (Z.abs_nat (Fexp q - Fexp p)) q)) <= Z.abs (Fnum p) * powerRZ radix (Fexp p))%R in |- *. unfold FtoRradix in |- *; rewrite FshiftCorrect; auto. fold FtoRradix in |- *; rewrite <- H'0. rewrite <- (Fabs_correct radix); auto with real zarith. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; [ ring | auto with zarith ]. cut (Fexp p <= Fexp q)%Z; [ intros E2 | apply le_IZR ]; auto. apply Z.le_trans with (Fexp p); [ idtac | apply le_IZR ]; auto with float. Qed. Theorem eqExpLess : forall (b : Fbound) (p q : float), Fbounded b p -> p = q :>R -> exists r : float, Fbounded b r /\ r = q :>R /\ (Fexp q <= Fexp r)%R. intros b p q H' H'0. case (Rle_or_lt (Fexp q) (Fexp p)); intros H'1. exists p; repeat (split; auto). exists q; split; [ idtac | split ]; auto with real. apply FboundedEqExp with (p := p); auto. apply Rlt_le; auto. Qed. Theorem FboundedShiftLess : forall (b : Fbound) (f : float) (n m : nat), m <= n -> Fbounded b (Fshift radix n f) -> Fbounded b (Fshift radix m f). intros b f n m H' H'0; split; auto. simpl in |- *; auto. apply Z.le_lt_trans with (Z.abs (Fnum (Fshift radix n f))). simpl in |- *; replace m with (m + 0); auto with arith. replace n with (m + (n - m)); auto with arith. repeat rewrite Zpower_nat_is_exp. repeat rewrite Zabs_Zmult; auto. apply Zle_Zmult_comp_l; auto with zarith. apply Zle_Zmult_comp_l; auto with zarith. repeat rewrite Z.abs_eq; auto with zarith. case H'0; auto. apply Z.le_trans with (Fexp (Fshift radix n f)); auto with float. simpl in |- *; unfold Zminus in |- *; auto with zarith. Qed. Theorem eqExpMax : forall (b : Fbound) (p q : float), Fbounded b p -> Fbounded b q -> (Fabs p <= q)%R -> exists r : float, Fbounded b r /\ r = p :>R /\ (Fexp r <= Fexp q)%Z. intros b p q H' H'0 H'1; case (Zle_or_lt (Fexp p) (Fexp q)); intros Rl0. exists p; auto. cut ((Fexp p - Z.abs_nat (Fexp p - Fexp q))%Z = Fexp q); [ intros Eq1 | idtac ]. exists (Fshift radix (Z.abs_nat (Fexp p - Fexp q)) p); split; split; auto. apply Z.le_lt_trans with (Fnum q); auto with float. replace (Z.abs (Fnum (Fshift radix (Z.abs_nat (Fexp p - Fexp q)) p))) with (Fnum (Fabs (Fshift radix (Z.abs_nat (Fexp p - Fexp q)) p))); auto. apply (Rle_Fexp_eq_Zle radix); auto with arith. rewrite Fabs_correct; auto with arith; rewrite FshiftCorrect; auto with arith; rewrite <- (Fabs_correct radix); auto with float arith. rewrite <- (Z.abs_eq (Fnum q)); auto with float zarith. apply (LeR0Fnum radix); auto. apply Rle_trans with (2 := H'1); auto with real. rewrite (Fabs_correct radix); auto with real zarith. unfold Fshift in |- *; simpl in |- *; rewrite Eq1; auto with float. unfold FtoRradix in |- *; apply FshiftCorrect; auto. unfold Fshift in |- *; simpl in |- *. rewrite Eq1; auto with zarith. rewrite inj_abs; auto with zarith; ring. Qed. Theorem Zle_monotony_contra_abs_pow : forall x y z n : Z, (0 < z)%Z -> (Rabs (x * powerRZ z n) <= Rabs (y * powerRZ z n))%R -> (Z.abs x <= Z.abs y)%Z. intros x y z n Hz O1. apply le_IZR; auto. apply Rmult_le_reg_l with (r := powerRZ z n); auto with real zarith. repeat rewrite (Rmult_comm (powerRZ z n)); auto. repeat rewrite <- Faux.Rabsolu_Zabs. replace (powerRZ z n) with (Rabs (powerRZ z n)). repeat rewrite <- Rabs_mult; auto. apply Rabs_pos_eq; auto with real zarith. Qed. Theorem LessExpBound : forall (b : Fbound) (p q : float), Fbounded b p -> Fbounded b q -> (Fexp q <= Fexp p)%Z -> (0 <= p)%R -> (p <= q)%R -> exists m : Z, Float m (Fexp q) = p :>R /\ Fbounded b (Float m (Fexp q)). intros b p q H' H'0 H'1 H'2 H'3; exists (Fnum p * Zpower_nat radix (Z.abs_nat (Fexp p - Fexp q)))%Z. cut (Float (Fnum p * Zpower_nat radix (Z.abs_nat (Fexp p - Fexp q))) (Fexp q) = p :>R); [ intros Eq1 | idtac ]. split; auto. repeat split; simpl in |- *; auto with float. apply Z.le_lt_trans with (Z.abs (Fnum q)); auto with float. apply Zle_monotony_contra_abs_pow with (z := radix) (n := Fexp q); auto with real arith. unfold FtoRradix, FtoR in Eq1; simpl in Eq1; rewrite Eq1; auto with real. change (Rabs p <= Rabs q)%R in |- *. repeat rewrite Rabs_pos_eq; auto with real. apply Rle_trans with (1 := H'2); auto. pattern (Fexp q) at 2 in |- *; replace (Fexp q) with (Fexp p - Z.abs_nat (Fexp p - Fexp q))%Z. change (Fshift radix (Z.abs_nat (Fexp p - Fexp q)) p = p :>R) in |- *. unfold FtoRradix in |- *; apply FshiftCorrect; auto. rewrite inj_abs; auto with zarith; ring. Qed. Theorem maxFbounded : forall (b : Fbound) (z : Z), (- dExp b <= z)%Z -> Fbounded b (Float (Z.pred (Zpos (vNum b))) z). intros b z H; split; auto. change (Z.abs (Z.pred (Zpos (vNum b))) < Zpos (vNum b))%Z in |- *. rewrite Z.abs_eq; auto with zarith. Qed. Theorem maxMax : forall (b : Fbound) (p : float) (z : Z), Fbounded b p -> (Fexp p <= z)%Z -> (Fabs p < Float (Zpos (vNum b)) z)%R. intros b p z H' H'0; unfold FtoRradix in |- *; rewrite <- (FshiftCorrect _ radixMoreThanOne (Z.abs_nat (z - Fexp p)) (Float (Zpos (vNum b)) z)); unfold Fshift in |- *. change (FtoR radix (Fabs p) < FtoR radix (Float (Zpos (vNum b) * Zpower_nat radix (Z.abs_nat (z - Fexp p))) (z - Z.abs_nat (z - Fexp p))))%R in |- *. replace (z - Z.abs_nat (z - Fexp p))%Z with (Fexp p). unfold Fabs, FtoR in |- *. change (Z.abs (Fnum p) * powerRZ radix (Fexp p) < (Zpos (vNum b) * Zpower_nat radix (Z.abs_nat (z - Fexp p)))%Z * powerRZ radix (Fexp p))%R in |- *. apply Rmult_lt_compat_r; auto with real zarith. apply Rlt_le_trans with (IZR (Zpos (vNum b))); auto with real float zarith. pattern (Zpos (vNum b)) at 1 in |- *; replace (Zpos (vNum b)) with (Zpos (vNum b) * 1)%Z; auto with real float zarith; ring. rewrite inj_abs; auto with zarith; ring. Qed. End Fbounded_Def. Hint Resolve FboundedFzero oppBounded absFBounded maxFbounded FboundedNum FboundedExp: float.float-8.10.0/Fcomp.v000066400000000000000000000235341357127175600141650ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fcomp Laurent Thery ******************************************************************************) Require Export Float. Section comparisons. Variable radix : Z. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Definition Fdiff (x y : float) := (Fnum x * Zpower_nat radix (Z.abs_nat (Fexp x - Z.min (Fexp x) (Fexp y))) - Fnum y * Zpower_nat radix (Z.abs_nat (Fexp y - Z.min (Fexp x) (Fexp y))))%Z. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Theorem Fdiff_correct : forall x y : float, (Fdiff x y * powerRZ radix (Z.min (Fexp x) (Fexp y)))%R = (x - y)%R. intros x y; unfold Fdiff in |- *. rewrite <- Z_R_minus. rewrite Rmult_comm; rewrite Rmult_minus_distr_l. repeat rewrite Rmult_IZR. repeat rewrite Zpower_nat_Z_powerRZ; auto. rewrite (Rmult_comm (Fnum x)); rewrite (Rmult_comm (Fnum y)). repeat rewrite <- Rmult_assoc. repeat rewrite <- powerRZ_add; auto with real zarith. repeat rewrite inj_abs; auto with arith. repeat rewrite Zplus_minus; auto. rewrite (fun t : R => Rmult_comm t (Fnum x)); rewrite (fun t : R => Rmult_comm t (Fnum y)); auto. apply Zplus_le_reg_l with (p := Z.min (Fexp x) (Fexp y)); auto with arith. rewrite Zplus_minus; rewrite Zplus_0_r; apply Z.le_min_r; auto. apply Zplus_le_reg_l with (p := Z.min (Fexp x) (Fexp y)); auto with arith. rewrite Zplus_minus; rewrite Zplus_0_r; apply Z.le_min_l; auto. Qed. (* Definition of comparison functions*) Definition Feq (x y : float) := x = y :>R. Definition Fle (x y : float) := (x <= y)%R. Definition Flt (x y : float) := (x < y)%R. Definition Fge (x y : float) := (x >= y)%R. Definition Fgt (x y : float) := (x > y)%R. Definition Fcompare (x y : float) := (Fdiff x y ?= 0)%Z. Definition Feq_bool (x y : float) := match Fcompare x y with | Eq => true | _ => false end. Theorem Feq_bool_correct_t : forall x y : float, Feq_bool x y = true -> Feq x y. intros x y H'; red in |- *. apply Rplus_eq_reg_l with (r := (- y)%R). repeat rewrite (Rplus_comm (- y)). rewrite Rplus_opp_r. change ((x - y)%R = 0%R) in |- *. rewrite <- Fdiff_correct. apply Rmult_eq_0_compat_r; auto. cut (Fdiff x y = 0%Z); [ intros H; rewrite H | idtac ]; auto with real. apply Zcompare_EGAL. generalize H'; unfold Feq_bool, Fcompare in |- *. case (Fdiff x y ?= 0)%Z;auto; intros; discriminate. Qed. Theorem Feq_bool_correct_r : forall x y : float, Feq x y -> Feq_bool x y = true. intros x y H'; cut ((x - y)%R = 0%R). rewrite <- Fdiff_correct; intros H'1; case Rmult_integral with (1 := H'1). intros H'0; unfold Feq_bool, Fcompare in |- *. rewrite eq_IZR_R0 with (1 := H'0); auto. intros H'0; Contradict H'0. case (Z.min (Fexp x) (Fexp y)); simpl in |- *; auto with real zarith. apply Rplus_eq_reg_l with (r := FtoR radix y); auto with real. Qed. Theorem Feq_bool_correct_f : forall x y : float, Feq_bool x y = false -> ~ Feq x y. intros x y H'; Contradict H'. rewrite Feq_bool_correct_r; auto with arith. red in |- *; intros H'0; discriminate. Qed. Definition Flt_bool (x y : float) := match Fcompare x y with | Lt => true | _ => false end. Theorem Flt_bool_correct_t : forall x y : float, Flt_bool x y = true -> Flt x y. intros x y H'; red in |- *. apply Rplus_lt_reg_r with (r := (- y)%R). repeat rewrite (Rplus_comm (- y)). rewrite Rplus_opp_r. change (x - y < 0)%R in |- *. rewrite <- Fdiff_correct. replace 0%R with (powerRZ radix (Z.min (Fexp x) (Fexp y)) * 0)%R; auto with real arith. rewrite (Rmult_comm (Fdiff x y)). apply Rmult_lt_compat_l; auto with real zarith. replace 0%R with (IZR 0); auto with real arith. apply Rlt_IZR; red in |- *. generalize H'; unfold Flt_bool, Fcompare in |- *. case (Fdiff x y ?= 0)%Z; auto; intros; try discriminate. Qed. Theorem Flt_bool_correct_r : forall x y : float, Flt x y -> Flt_bool x y = true. intros x y H'. cut (0 < y - x)%R; auto with arith. 2: apply Rplus_lt_reg_l with (r := FtoRradix x); rewrite Rplus_0_r; rewrite Rplus_minus; auto with real. intros H'0. cut (Fdiff x y < 0)%R; auto with arith. intros H'1. cut (Fdiff x y < 0)%Z; auto with zarith. intros H'2; generalize (Zlt_compare _ _ H'2); unfold Flt_bool, Fcompare, Z.compare in |- *; case (Fdiff x y); auto with arith; intros; contradiction. apply lt_IZR; auto with arith. apply (Rlt_monotony_contra_exp radix) with (z := Z.min (Fexp x) (Fexp y)); auto with arith real; rewrite Rmult_0_l. rewrite Fdiff_correct; auto with real. Qed. Theorem Flt_bool_correct_f : forall x y : float, Flt_bool x y = false -> Fle y x. intros x y H'. case (Rtotal_order (FtoRradix y) (FtoRradix x)); auto with real. intros H'0; red in |- *; apply Rlt_le; auto with real. intros H'0; elim H'0; clear H'0; intros H'1. red in |- *; rewrite H'1; auto with real. Contradict H'; rewrite Flt_bool_correct_r; auto with real. red in |- *; intros H'; discriminate. Qed. Definition Fle_bool (x y : float) := match Fcompare x y with | Lt => true | Eq => true | _ => false end. Theorem Fle_bool_correct_t : forall x y : float, Fle_bool x y = true -> Fle x y. intros x y H'. cut (Feq x y \/ Flt x y). intros H; case H; intros H1; auto with real. red in |- *; apply Req_le; auto with real. red in |- *; apply Rlt_le; auto with real. generalize H' (Feq_bool_correct_t x y) (Flt_bool_correct_t x y). unfold Fle_bool, Feq_bool, Flt_bool in |- *; case (Fcompare x y); auto. Qed. Theorem Fle_bool_correct_r : forall x y : float, Fle x y -> Fle_bool x y = true. intros x y H'. cut (Feq x y \/ Flt x y). intros H; case H; intros H1; auto with real. generalize (Feq_bool_correct_r x y). unfold Fle_bool, Feq_bool, Flt_bool in |- *; case (Fcompare x y); auto. generalize (Flt_bool_correct_r x y); unfold Fle_bool, Feq_bool, Flt_bool in |- *; case (Fcompare x y); auto with arith. case H'; auto with arith. Qed. Theorem Fle_bool_correct_f : forall x y : float, Fle_bool x y = false -> Flt y x. intros x y H'. case (Rtotal_order (FtoRradix y) (FtoRradix x)); auto with real. intros H'0; elim H'0; clear H'0; intros H'1. Contradict H'. rewrite Fle_bool_correct_r; auto with real. red in |- *; intros H'; discriminate. red in |- *; rewrite H'1; auto with real. Contradict H'. rewrite Fle_bool_correct_r; auto with real. red in |- *; intros H'; discriminate. red in |- *; auto with real. Qed. Lemma Fle_Zle : forall n1 n2 d : Z, (n1 <= n2)%Z -> Fle (Float n1 d) (Float n2 d). intros; unfold Fle, FtoRradix, FtoR in |- *; simpl in |- *; auto. case Zle_lt_or_eq with (1 := H); intros H1. apply Rlt_le; auto with real. rewrite <- H1; auto with real. Qed. Lemma Flt_Zlt : forall n1 n2 d : Z, (n1 < n2)%Z -> Flt (Float n1 d) (Float n2 d). intros; unfold Flt, FtoRradix, FtoR in |- *; simpl in |- *; auto with real. Qed. Lemma Fle_Fge : forall x y : float, Fle x y -> Fge y x. unfold Fle, Fge in |- *; intros x y H'; auto with real. Qed. Lemma Fge_Zge : forall n1 n2 d : Z, (n1 >= n2)%Z -> Fge (Float n1 d) (Float n2 d). intros n1 n2 d H'; apply Fle_Fge; auto. apply Fle_Zle; auto. apply Z.ge_le; auto. Qed. Lemma Flt_Fgt : forall x y : float, Flt x y -> Fgt y x. unfold Flt, Fgt in |- *; intros x y H'; auto. Qed. Lemma Fgt_Zgt : forall n1 n2 d : Z, (n1 > n2)%Z -> Fgt (Float n1 d) (Float n2 d). intros n1 n2 d H'; apply Flt_Fgt; auto. apply Flt_Zlt; auto. apply Z.gt_lt; auto. Qed. (* Arithmetic properties on F : Fle is reflexive, transitive, antisymmetric *) Lemma Fle_refl : forall x y : float, Feq x y -> Fle x y. unfold Feq in |- *; unfold Fle in |- *; intros. rewrite H; auto with real. Qed. Lemma Fle_trans : forall x y z : float, Fle x y -> Fle y z -> Fle x z. unfold Fle in |- *; intros. apply Rle_trans with (r2 := FtoR radix y); auto. Qed. Theorem Rlt_Fexp_eq_Zlt : forall x y : float, (x < y)%R -> Fexp x = Fexp y -> (Fnum x < Fnum y)%Z. intros x y H' H'0. apply lt_IZR. apply (Rlt_monotony_contra_exp radix) with (z := Fexp x); auto with real arith. pattern (Fexp x) at 2 in |- *; rewrite H'0; auto. Qed. Theorem Rle_Fexp_eq_Zle : forall x y : float, (x <= y)%R -> Fexp x = Fexp y -> (Fnum x <= Fnum y)%Z. intros x y H' H'0. apply le_IZR. apply (Rle_monotony_contra_exp radix) with (z := Fexp x); auto with real arith. pattern (Fexp x) at 2 in |- *; rewrite H'0; auto. Qed. Theorem LtR0Fnum : forall p : float, (0 < p)%R -> (0 < Fnum p)%Z. intros p H'. apply lt_IZR. apply (Rlt_monotony_contra_exp radix) with (z := Fexp p); auto with real arith. simpl in |- *; rewrite Rmult_0_l; auto. Qed. Theorem LeR0Fnum : forall p : float, (0 <= p)%R -> (0 <= Fnum p)%Z. intros p H'. apply le_IZR. apply (Rle_monotony_contra_exp radix) with (z := Fexp p); auto with real arith. simpl in |- *; rewrite Rmult_0_l; auto. Qed. Theorem LeFnumZERO : forall x : float, (0 <= Fnum x)%Z -> (0 <= x)%R. intros x H'; unfold FtoRradix, FtoR in |- *. replace 0%R with (0%Z * 0%Z)%R; auto 6 with real zarith. Qed. Theorem R0LtFnum : forall p : float, (p < 0)%R -> (Fnum p < 0)%Z. intros p H'. apply lt_IZR. apply (Rlt_monotony_contra_exp radix) with (z := Fexp p); auto with real arith. simpl in |- *; rewrite Rmult_0_l; auto. Qed. Theorem R0LeFnum : forall p : float, (p <= 0)%R -> (Fnum p <= 0)%Z. intros p H'. apply le_IZR. apply (Rle_monotony_contra_exp radix) with (z := Fexp p); auto with real arith. simpl in |- *; rewrite Rmult_0_l; auto. Qed. Theorem LeZEROFnum : forall x : float, (Fnum x <= 0)%Z -> (x <= 0)%R. intros x H'; unfold FtoRradix, FtoR in |- *. apply Ropp_le_cancel; rewrite Ropp_0; rewrite <- Ropp_mult_distr_l_reverse. replace 0%R with (- 0%Z * 0)%R; auto 6 with real zarith. Qed. End comparisons. Hint Resolve LeFnumZERO LeZEROFnum: float.float-8.10.0/Finduct.v000066400000000000000000000223221357127175600145070ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Finduct Laurent Thery ***************************************************************************** Define an induction principle on float*) Require Export FPred. Section finduct. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Hypothesis precisionNotZero : precision <> 0. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Definition Fweight (p : float) := (Fnum p + Fexp p * Zpower_nat radix precision)%Z. Theorem FweightLt : forall p q : float, Fcanonic radix b p -> Fcanonic radix b q -> (0 <= p)%R -> (p < q)%R -> (Fweight p < Fweight q)%Z. intros p q H' H'0 H'1 H'2. cut (Fbounded b p); [ intros Fb1 | apply FcanonicBound with (1 := H') ]; auto. cut (Fbounded b q); [ intros Fb2 | apply FcanonicBound with (1 := H'0) ]; auto. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := p) (q := q); auto with arith; intros Zl1. unfold Fweight in |- *; simpl in |- *. replace (Fexp q) with (Fexp q - Fexp p + Fexp p)%Z; [ idtac | ring ]. rewrite Zmult_plus_distr_l. rewrite Zplus_assoc. repeat rewrite (fun x y z : Z => Zplus_comm x (y * z)). apply Zplus_lt_compat_l. apply Z.lt_le_trans with (Zpower_nat radix precision); auto with zarith. apply Z.le_lt_trans with (Z.pred (Zpower_nat radix precision)); auto with zarith. apply Zle_Zabs_inv2; auto with float zarith. apply Zle_Zpred; auto with float zarith. rewrite <- pGivesBound; auto with float. apply Z.le_trans with ((Fexp q - Fexp p) * Zpower_nat radix precision)%Z; auto with zarith. pattern (Zpower_nat radix precision) at 1 in |- *; replace (Zpower_nat radix precision) with (Z.succ 0 * Zpower_nat radix precision)%Z; auto. apply Zle_Zmult_comp_r; auto with zarith. unfold Z.succ in |- *; ring. cut (0 <= Fnum q)%Z; auto with zarith. apply (LeR0Fnum radix); auto. apply Rle_trans with (FtoRradix p); auto; apply Rlt_le; auto. elim Zl1; intros H'3 H'4; clear Zl1. unfold Fweight in |- *; simpl in |- *. rewrite <- H'3. repeat rewrite (fun x y z : Z => Zplus_comm x (y * z)). apply Zplus_lt_compat_l; auto. Qed. Theorem FweightEq : forall p q : float, Fcanonic radix b p -> Fcanonic radix b q -> p = q :>R -> Fweight p = Fweight q. intros p q H' H'0 H'1. rewrite (FcanonicUnique _ radixMoreThanOne b precision) with (p := p) (q := q); auto with arith. Qed. Theorem FweightZle : forall p q : float, Fcanonic radix b p -> Fcanonic radix b q -> (0 <= p)%R -> (p <= q)%R -> (Fweight p <= Fweight q)%Z. intros p q H' H'0 H'1 H'2; Casec H'2; intros H'2. apply Zlt_le_weak. apply FweightLt; auto. rewrite (FweightEq p q); auto with zarith. Qed. Theorem FinductPosAux : forall (P : float -> Prop) (p : float), (0 <= p)%R -> Fcanonic radix b p -> P p -> (forall q : float, Fcanonic radix b q -> (p <= q)%R -> P q -> P (FSucc b radix precision q)) -> forall x : Z, (0 <= x)%Z -> forall q : float, x = (Fweight q - Fweight p)%Z -> Fcanonic radix b q -> (p <= q)%R -> P q. intros P p H' H'0 H'1 H'2 x H'3; pattern x in |- *. apply Z_lt_induction; auto. intros x0 H'4 q H'5 H'6 H'7. Casec H'7; intros H'7. cut (p <= FPred b radix precision q)%R; [ intros Rl1 | idtac ]. cut (P (FPred b radix precision q)); [ intros P1 | idtac ]. rewrite <- (FSucPred b radix precision) with (x := q); auto with arith. apply H'2; auto with float arith. apply H'4 with (y := (Fweight (FPred b radix precision q) - Fweight p)%Z); auto. split. cut (Fweight p <= Fweight (FPred b radix precision q))%Z; auto with zarith. apply FweightZle; auto. apply FPredCanonic; auto with arith. rewrite H'5. cut (Fweight (FPred b radix precision q) < Fweight q)%Z; [ auto with zarith | idtac ]. apply FweightLt; auto with float. apply (R0RltRlePred b radix precision); auto. apply Rle_lt_trans with (FtoRradix p); auto. apply (FPredLt b radix precision); auto. apply (FPredCanonic b radix precision); auto with arith. apply (FPredProp b radix precision); auto with arith. rewrite <- (FcanonicUnique _ radixMoreThanOne b precision) with (p := p) (q := q); auto with arith. Qed. Theorem FinductPos : forall (P : float -> Prop) (p : float), (0 <= p)%R -> Fcanonic radix b p -> P p -> (forall q : float, Fcanonic radix b q -> (p <= q)%R -> P q -> P (FSucc b radix precision q)) -> forall q : float, Fcanonic radix b q -> (p <= q)%R -> P q. intros P p H' H'0 H'1 H'2 q H'3 H'4. apply FinductPosAux with (p := p) (x := (Fweight q - Fweight p)%Z); auto. cut (Fweight p <= Fweight q)%Z; [ auto with zarith | idtac ]. apply FweightZle; auto with float. Qed. Theorem FinductNegAux : forall (P : float -> Prop) (p : float), (0 <= p)%R -> Fcanonic radix b p -> P p -> (forall q : float, Fcanonic radix b q -> (0 < q)%R -> (q <= p)%R -> P q -> P (FPred b radix precision q)) -> forall x : Z, (0 <= x)%Z -> forall q : float, x = (Fweight p - Fweight q)%Z -> Fcanonic radix b q -> (0 <= q)%R -> (q <= p)%R -> P q. intros P p H' H'0 H'1 H'2 x H'3; pattern x in |- *. apply Z_lt_induction; auto. intros x0 H'4 q H'5 H'6 H'7 H'8. Casec H'8; intros H'8. cut (FSucc b radix precision q <= p)%R; [ intros Rle1 | idtac ]. cut (P (FSucc b radix precision q)); [ intros P1 | idtac ]. rewrite <- (FPredSuc b radix precision) with (x := q); auto with arith. apply H'2; auto with float arith. apply Rle_lt_trans with (FtoRradix q); auto. apply (FSuccLt b radix); auto with arith. apply H'4 with (y := (Fweight p - Fweight (FSucc b radix precision q))%Z); auto. split. cut (Fweight (FSucc b radix precision q) <= Fweight p)%Z; auto with zarith. apply FweightZle; auto. apply FSuccCanonic; auto with arith. apply Rle_trans with (FtoRradix q); auto; apply Rlt_le. apply (FSuccLt b radix); auto with arith. rewrite H'5. cut (Fweight q < Fweight (FSucc b radix precision q))%Z; [ auto with zarith | idtac ]. apply FweightLt; auto with float. apply (FSuccLt b radix); auto with arith. apply FSuccCanonic; auto with arith. apply Rle_trans with (FtoRradix q); auto; apply Rlt_le. apply (FSuccLt b radix); auto with arith. apply (FSuccProp b radix); auto with arith. rewrite <- (FcanonicUnique _ radixMoreThanOne b precision) with (p := p) (q := q); auto with arith. Qed. Theorem FinductNeg : forall (P : float -> Prop) (p : float), (0 <= p)%R -> Fcanonic radix b p -> P p -> (forall q : float, Fcanonic radix b q -> (0 < q)%R -> (q <= p)%R -> P q -> P (FPred b radix precision q)) -> forall q : float, Fcanonic radix b q -> (0 <= q)%R -> (q <= p)%R -> P q. intros P p H' H'0 H'1 H'2 q H'3 H'4 H'5. apply FinductNegAux with (p := p) (x := (Fweight p - Fweight q)%Z); auto. cut (Fweight q <= Fweight p)%Z; [ auto with zarith | idtac ]. apply FweightZle; auto with float. Qed. Theorem radixRangeBoundExp : forall p q : float, Fcanonic radix b p -> Fcanonic radix b q -> (0 <= p)%R -> (p < q)%R -> (q < radix * p)%R -> Fexp p = Fexp q \/ Z.succ (Fexp p) = Fexp q. intros p q H' H'0 H'1 H'2 H'3. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := p) (q := q); auto with arith. 2: intros H'4; elim H'4; intros H'5 H'6; clear H'4; auto. intros H'4; right. Casec H'; intros H'. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := q) (q := Float (Fnum p) (Z.succ (Fexp p))); auto with arith. left. case H'; intros H1 H2; red in H1. repeat split; simpl in |- *; auto with float. apply Z.le_trans with (Fexp p); auto with float zarith. apply Rle_trans with (FtoRradix p); auto; apply Rlt_le; auto. unfold FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; auto. rewrite <- Rmult_assoc; rewrite (fun (x : R) (y : Z) => Rmult_comm x y); rewrite Rmult_assoc; auto. simpl in |- *; intros; apply Zle_antisym; auto with zarith. simpl in |- *; auto. intros H'5; elim H'5; intros H'6 H'7; auto. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := q) (q := Float (nNormMin radix precision) (Z.succ (Fexp p))); auto with arith. left; repeat split; simpl in |- *. rewrite Z.abs_eq; auto with zarith. apply ZltNormMinVnum; auto with zarith. unfold nNormMin in |- *; auto with zarith. apply Z.le_trans with (Fexp p); auto with float zarith. case H'; auto with float. rewrite <- (PosNormMin radix b precision); auto with zarith. apply Rle_trans with (1 := H'1); auto with real. apply Rlt_trans with (1 := H'3). unfold FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; auto. rewrite <- Rmult_assoc; rewrite (fun (x : R) (y : Z) => Rmult_comm x y); rewrite Rmult_assoc; auto. apply Rmult_lt_compat_l; auto with real arith. case H'. intros H'5 H'6; elim H'6; intros H'7 H'8; rewrite H'7; clear H'6. change (p < firstNormalPos radix b precision)%R in |- *. apply (FsubnormalLtFirstNormalPos radix); auto with arith. simpl in |- *; intros; apply Zle_antisym; auto with zarith. intros H'5; elim H'5; intros H'6 H'7; rewrite H'6; clear H'5; auto. Qed. End finduct.float-8.10.0/Float.v000066400000000000000000000261241357127175600141640ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Float Laurent Thery ***************************************************************************** ****************************************************** Module Float.v Inspired by the Diadic of Patrick Loiseleur *******************************************************) Require Export Omega. Require Export Compare. Require Export Rpow. Section definitions. Variable radix : Z. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. (* The type float represents the set of numbers who can be written: x = n*b^p with n and p in Z. (pdic numbers) n = Fnum and p = Fexp *) Record float : Set := Float {Fnum : Z; Fexp : Z}. Theorem floatEq : forall p q : float, Fnum p = Fnum q -> Fexp p = Fexp q -> p = q. intros p q; case p; case q; simpl in |- *; intros; apply (f_equal2 (A1:=Z) (A2:=Z)); auto. Qed. Theorem floatDec : forall x y : float, {x = y} + {x <> y}. intros x y; case x; case y; intros Fnum2 Fexp2 Fnum1 Fexp1. case (Z.eq_dec Fnum1 Fnum2); intros H1. case (Z.eq_dec Fexp1 Fexp2); intros H2. left; apply floatEq; auto. right; red in |- *; intros H'; Contradict H2; inversion H'; auto. right; red in |- *; intros H'; Contradict H1; inversion H'; auto. Qed. Definition Fzero (x : Z) := Float 0 x. Definition is_Fzero (x : float) := Fnum x = 0%Z. Theorem is_FzeroP : forall x : float, is_Fzero x \/ ~ is_Fzero x. unfold is_Fzero in |- *; intro; CaseEq (Fnum x); intros; (right; discriminate) || (left; auto). Qed. Coercion IZR : Z >-> R. Coercion INR : nat >-> R. Coercion Z_of_nat : nat >-> Z. Definition FtoR (x : float) := (Fnum x * powerRZ (IZR radix) (Fexp x))%R. Local Coercion FtoR : float >-> R. Theorem FzeroisReallyZero : forall z : Z, Fzero z = 0%R :>R. intros z; unfold FtoR in |- *; simpl in |- *; auto with real. Qed. Theorem is_Fzero_rep1 : forall x : float, is_Fzero x -> x = 0%R :>R. intros x H; unfold FtoR in |- *. red in H; rewrite H; simpl in |- *; auto with real. Qed. Theorem LtFnumZERO : forall x : float, (0 < Fnum x)%Z -> (0 < x)%R. intros x; case x; unfold FtoR in |- *; simpl in |- *. intros Fnum1 Fexp1 H'; replace 0%R with (Fnum1 * 0)%R; [ apply Rmult_lt_compat_l | ring ]; auto with real zarith. Qed. Theorem is_Fzero_rep2 : forall x : float, x = 0%R :>R -> is_Fzero x. intros x H'. case (Rmult_integral _ _ H'); simpl in |- *; auto. case x; simpl in |- *. intros Fnum1 Fexp1 H'0; red in |- *; simpl in |- *; auto with real zarith. apply eq_IZR_R0; auto. intros H'0; Contradict H'0; apply powerRZ_NOR; auto with real zarith. Qed. Theorem NisFzeroComp : forall x y : float, ~ is_Fzero x -> x = y :>R -> ~ is_Fzero y. intros x y H' H'0; Contradict H'. apply is_Fzero_rep2; auto. rewrite H'0. apply is_Fzero_rep1; auto. Qed. (* Some inegalities that will be helpful *) Theorem Rlt_monotony_exp : forall (x y : R) (z : Z), (x < y)%R -> (x * powerRZ radix z < y * powerRZ radix z)%R. intros x y z H'; apply Rmult_lt_compat_r; auto with real zarith. Qed. Theorem Rle_monotone_exp : forall (x y : R) (z : Z), (x <= y)%R -> (x * powerRZ radix z <= y * powerRZ radix z)%R. intros x y z H'; apply Rmult_le_compat_r; auto with real zarith. Qed. Theorem Rlt_monotony_contra_exp : forall (x y : R) (z : Z), (x * powerRZ radix z < y * powerRZ radix z)%R -> (x < y)%R. intros x y z H'; apply Rmult_lt_reg_l with (r := powerRZ radix z); auto with real zarith. repeat rewrite (Rmult_comm (powerRZ radix z)); auto. Qed. Theorem Rle_monotony_contra_exp : forall (x y : R) (z : Z), (x * powerRZ radix z <= y * powerRZ radix z)%R -> (x <= y)%R. intros x y z H'; apply Rmult_le_reg_l with (r := powerRZ radix z); auto with real zarith. repeat rewrite (Rmult_comm (powerRZ radix z)); auto. Qed. Theorem FtoREqInv1 : forall p q : float, ~ is_Fzero p -> p = q :>R -> Fnum p = Fnum q -> p = q. intros p q H' H'0 H'1. apply floatEq; auto. unfold FtoR in H'0. apply Rpow_eq_inv with (r := IZR radix); auto 6 with real zarith. apply Rlt_dichotomy_converse; right; red in |- *. unfold Rabs in |- *; case (Rcase_abs radix). intros H'2; Contradict H'2; apply Rle_not_lt; apply Ropp_le_cancel; auto with real. intros H'2; replace 1%R with (IZR 1); auto with real zarith. apply Rmult_eq_reg_l with (r := IZR (Fnum p)); auto with real. pattern (Fnum p) at 2 in |- *; rewrite H'1; auto. Qed. Theorem FtoREqInv2 : forall p q : float, p = q :>R -> Fexp p = Fexp q -> p = q. intros p q H' H'0. apply floatEq; auto. apply eq_IZR; auto. apply Rmult_eq_reg_l with (r := powerRZ radix (Fexp p)); auto with real zarith. repeat rewrite (Rmult_comm (powerRZ radix (Fexp p))); pattern (Fexp p) at 2 in |- *; rewrite H'0; auto with real zarith. Qed. Theorem Rlt_Float_Zlt : forall p q r : Z, (Float p r < Float q r)%R -> (p < q)%Z. intros p q r H'. apply lt_IZR. apply Rlt_monotony_contra_exp with (z := r); auto with real. Qed. Theorem Rle_Float_Zle : forall p q r : Z, (Float p r <= Float q r)%R -> (p <= q)%Z. intros p q r H'. apply le_IZR. apply Rle_monotony_contra_exp with (z := r); auto with real. Qed. (* Properties for floats with 1 as mantissa *) Theorem oneExp_le : forall x y : Z, (x <= y)%Z -> (Float 1%nat x <= Float 1%nat y)%R. intros x y H'; unfold FtoR in |- *; simpl in |- *. repeat rewrite Rmult_1_l; auto with real zarith. apply Rle_powerRZ; try replace 1%R with (IZR 1); auto with real zarith zarith. Qed. Theorem oneExp_lt : forall x y : Z, (x < y)%Z -> (Float 1%nat x < Float 1%nat y)%R. intros x y H'; unfold FtoR in |- *; simpl in |- *. repeat rewrite Rmult_1_l; auto with real zarith. Qed. Theorem oneExp_Zlt : forall x y : Z, (Float 1%nat x < Float 1%nat y)%R -> (x < y)%Z. intros x y H'; case (Zle_or_lt y x); auto; intros ZH; Contradict H'. apply Rle_not_lt; apply oneExp_le; auto. Qed. Theorem oneExp_Zle : forall x y : Z, (Float 1%nat x <= Float 1%nat y)%R -> (x <= y)%Z. intros x y H'; case (Zle_or_lt x y); auto; intros ZH; Contradict H'. apply Rgt_not_le; red in |- *; apply oneExp_lt; auto. Qed. Definition Fdigit (p : float) := digit radix (Fnum p). Definition Fshift (n : nat) (x : float) := Float (Fnum x * Zpower_nat radix n) (Fexp x - n). Theorem sameExpEq : forall p q : float, p = q :>R -> Fexp p = Fexp q -> p = q. intros p q; case p; case q; unfold FtoR in |- *; simpl in |- *. intros Fnum1 Fexp1 Fnum2 Fexp2 H' H'0; rewrite H'0; rewrite H'0 in H'. cut (Fnum1 = Fnum2). intros H'1; rewrite <- H'1; auto. apply eq_IZR; auto. apply Rmult_eq_reg_l with (r := powerRZ radix Fexp1); repeat rewrite (Rmult_comm (powerRZ radix Fexp1)); auto. apply Rlt_dichotomy_converse; right; auto with real. red in |- *; auto with real. Qed. Theorem FshiftFdigit : forall (n : nat) (x : float), ~ is_Fzero x -> Fdigit (Fshift n x) = Fdigit x + n. intros n x; case x; unfold Fshift, Fdigit, is_Fzero in |- *; simpl in |- *. intros p1 p2 H; apply digitAdd; auto. Qed. Theorem FshiftCorrect : forall (n : nat) (x : float), Fshift n x = x :>R. intros n x; unfold FtoR in |- *; simpl in |- *. rewrite Rmult_IZR. rewrite Zpower_nat_Z_powerRZ; auto. repeat rewrite Rmult_assoc. rewrite <- powerRZ_add; auto with real zarith. rewrite Zplus_minus; auto. Qed. Theorem FshiftCorrectInv : forall x y : float, x = y :>R -> (Fexp x <= Fexp y)%Z -> Fshift (Z.abs_nat (Fexp y - Fexp x)) y = x. intros x y H' H'0; try apply sameExpEq; auto. apply trans_eq with (y := FtoR y); auto. apply FshiftCorrect. generalize H' H'0; case x; case y; simpl in |- *; clear H' H'0 x y. intros Fnum1 Fexp1 Fnum2 Fexp2 H' H'0; rewrite inj_abs; auto with zarith. Qed. Theorem FshiftO : forall x : float, Fshift 0 x = x. intros x; unfold Fshift in |- *; apply floatEq; simpl in |- *. replace (Zpower_nat radix 0) with 1%Z; auto with zarith. simpl in |- *; auto with zarith. Qed. Theorem FshiftCorrectSym : forall x y : float, x = y :>R -> exists n : nat, (exists m : nat, Fshift n x = Fshift m y). intros x y H'. case (Z_le_gt_dec (Fexp x) (Fexp y)); intros H'1. exists 0; exists (Z.abs_nat (Fexp y - Fexp x)). rewrite FshiftO. apply sym_equal. apply FshiftCorrectInv; auto. exists (Z.abs_nat (Fexp x - Fexp y)); exists 0. rewrite FshiftO. apply FshiftCorrectInv; auto with zarith. Qed. Theorem FshiftAdd : forall (n m : nat) (p : float), Fshift (n + m) p = Fshift n (Fshift m p). intros n m p; case p; unfold Fshift in |- *; simpl in |- *. intros Fnum1 Fexp1; apply floatEq; simpl in |- *; auto with zarith. rewrite Zpower_nat_is_exp; auto with zarith. rewrite (Zmult_comm (Zpower_nat radix n)); auto with zarith. rewrite <- (Zminus_plus_simpl_r (Fexp1 - m) n m). replace (Fexp1 - m + m)%Z with Fexp1; auto with zarith. replace (Z_of_nat (n + m)) with (n + m)%Z; auto with zarith arith. rewrite <- inj_plus; auto. Qed. Theorem ReqGivesEqwithSameExp : forall p q : float, exists r : float, (exists s : float, p = r :>R /\ q = s :>R /\ Fexp r = Fexp s). intros p q; exists (Fshift (Z.abs_nat (Fexp p - Z.min (Fexp p) (Fexp q))) p); exists (Fshift (Z.abs_nat (Fexp q - Z.min (Fexp p) (Fexp q))) q); repeat split; auto with real. rewrite FshiftCorrect; auto. rewrite FshiftCorrect; auto. simpl in |- *. replace (Z_of_nat (Z.abs_nat (Fexp p - Z.min (Fexp p) (Fexp q)))) with (Fexp p - Z.min (Fexp p) (Fexp q))%Z. replace (Z_of_nat (Z.abs_nat (Fexp q - Z.min (Fexp p) (Fexp q)))) with (Fexp q - Z.min (Fexp p) (Fexp q))%Z. case (Zmin_or (Fexp p) (Fexp q)); intros H'; rewrite H'; auto with zarith. rewrite inj_abs; auto. apply Zplus_le_reg_l with (p := Z.min (Fexp p) (Fexp q)); auto with zarith. generalize (Z.le_min_r (Fexp p) (Fexp q)); auto with zarith. rewrite inj_abs; auto. apply Zplus_le_reg_l with (p := Z.min (Fexp p) (Fexp q)); auto with zarith. Qed. Theorem FdigitEq : forall x y : float, ~ is_Fzero x -> x = y :>R -> Fdigit x = Fdigit y -> x = y. intros x y H' H'0 H'1. cut (~ is_Fzero y); [ intros NZy | idtac ]. 2: red in |- *; intros H'2; case H'. 2: apply is_Fzero_rep2; rewrite H'0; apply is_Fzero_rep1; auto. case (Zle_or_lt (Fexp x) (Fexp y)); intros Eq1. case (Zle_lt_or_eq _ _ Eq1); clear Eq1; intros Eq1. absurd (Fdigit (Fshift (Z.abs_nat (Fexp y - Fexp x)) y) = Fdigit y + Z.abs_nat (Fexp y - Fexp x)). rewrite FshiftCorrectInv; auto. rewrite <- H'1. red in |- *; intros H'2. absurd (0%Z = (Fexp y - Fexp x)%Z); auto with zarith arith. rewrite <- (inj_abs (Fexp y - Fexp x)); auto with zarith. apply Zlt_le_weak; auto. apply FshiftFdigit; auto. apply sameExpEq; auto. absurd (Fdigit (Fshift (Z.abs_nat (Fexp x - Fexp y)) x) = Fdigit x + Z.abs_nat (Fexp x - Fexp y)). rewrite FshiftCorrectInv; auto. rewrite <- H'1. red in |- *; intros H'2. absurd (0%Z = (Fexp x - Fexp y)%Z); auto with zarith arith. rewrite <- (inj_abs (Fexp x - Fexp y)); auto with zarith. apply Zlt_le_weak; auto. apply FshiftFdigit; auto. Qed. End definitions. Hint Resolve Rlt_monotony_exp Rle_monotone_exp: real. Hint Resolve Zlt_not_eq Zlt_not_eq_rev: zarith.float-8.10.0/Fmin.v000066400000000000000000000547101357127175600140120ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fmin Laurent Thery ******************************************************************************) Require Export Zenum. Require Export FPred. Section FMinMax. Variable b : Fbound. Variable radix : Z. Variable precision : 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 precisionNotZero : precision <> 0. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. (* a function that returns a boundd greater than a given nat *) Definition boundNat (n : nat) := Float 1%nat (digit radix n). Theorem boundNatCorrect : forall n : nat, (n < boundNat n)%R. intros n; unfold FtoRradix, FtoR, boundNat in |- *; simpl in |- *. rewrite Rmult_1_l. rewrite <- Zpower_nat_Z_powerRZ; auto with real zarith. rewrite INR_IZR_INZ; auto with real zarith. apply Rle_lt_trans with (Z.abs n); [rewrite (Z.abs_eq (Z_of_nat n))|idtac];auto with real zarith. Qed. Theorem boundBoundNat : forall n : nat, Fbounded b (boundNat n). intros n; repeat split; unfold boundNat in |- *; simpl in |- *; auto with zarith. apply vNumbMoreThanOne with (radix := radix) (precision := precision); auto with zarith. apply Z.le_trans with 0%Z;[case (dExp b)|idtac]; auto with zarith. Qed. (* A function that returns a bounded greater than a given r *) Definition boundR (r : R) := boundNat (Z.abs_nat (up (Rabs r))). Theorem boundRCorrect1 : forall r : R, (r < boundR r)%R. intros r; case (Rle_or_lt r 0); intros H'. apply Rle_lt_trans with (1 := H'). unfold boundR, boundNat, FtoRradix, FtoR in |- *; simpl in |- *; auto with real. rewrite Rmult_1_l; auto with real zarith. apply Rlt_trans with (2 := boundNatCorrect (Z.abs_nat (up (Rabs r)))). replace (Rabs r) with r; auto with real. apply Rlt_le_trans with (r2 := IZR (up r)); auto with real zarith. case (archimed r); auto. rewrite INR_IZR_INZ; auto with real zarith. unfold Rabs in |- *; case (Rcase_abs r); auto with real. intros H'0; Contradict H'0; auto with real. Qed. Theorem boundRrOpp : forall r : R, boundR r = boundR (- r). intros R; unfold boundR in |- *. rewrite Rabs_Ropp; auto. Qed. Theorem boundRCorrect2 : forall r : R, (Fopp (boundR r) < r)%R. intros r; case (Rle_or_lt r 0); intros H'. rewrite boundRrOpp. pattern r at 2 in |- *; rewrite <- (Ropp_involutive r). unfold FtoRradix in |- *; rewrite Fopp_correct. apply Ropp_lt_contravar; apply boundRCorrect1; auto. apply Rle_lt_trans with 0%R; auto. replace 0%R with (-0)%R; auto with real. unfold FtoRradix in |- *; rewrite Fopp_correct. apply Ropp_le_contravar. unfold boundR, boundNat, FtoRradix, FtoR in |- *; simpl in |- *; auto with real zarith. rewrite Rmult_1_l; apply Rlt_le; auto with real zarith arith. Qed. (* A function that returns a list containing all the bounded smaller than a given real *) Definition mBFloat (p : R) := map (fun p : Z * Z => Float (fst p) (snd p)) (mProd Z Z (Z * Z) (mZlist (- pPred (vNum b)) (pPred (vNum b))) (mZlist (- dExp b) (Fexp (boundR p)))). Theorem mBFadic_correct1 : forall (r : R) (q : float), ~ is_Fzero q -> (Fopp (boundR r) < q)%R -> (q < boundR r)%R -> Fbounded b q -> In q (mBFloat r). intros r q. case (Zle_or_lt (Fexp (boundR r)) (Fexp q)); intros H'. intros H'0 H'1 H'2 H'3; case H'0. apply is_Fzero_rep2 with (radix := radix); auto. rewrite <- FshiftCorrect with (n := Z.abs_nat (Fexp q - Fexp (boundR r))) (x := q); auto with arith. apply is_Fzero_rep1 with (radix := radix). unfold is_Fzero in |- *. cut (forall p : Z, (- 1%nat < p)%Z -> (p < 1%nat)%Z -> p = 0%Z); [ intros tmp; apply tmp | idtac ]. replace (- 1%nat)%Z with (Fnum (Fopp (boundR r))). apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with real zarith. rewrite FshiftCorrect; auto. unfold Fshift in |- *; simpl in |- *. rewrite (fun x y => inj_abs (x - y)); auto with zarith. simpl in |- *; auto. replace (Z_of_nat 1) with (Fnum (boundR r)). apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith. rewrite FshiftCorrect; auto. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; auto with zarith. generalize H'; simpl in |- *; auto with zarith. simpl in |- *; auto. intros p0; case p0; simpl in |- *; auto with zarith. intros H'0 H'1 H'2 H'3; unfold mBFloat in |- *. replace q with ((fun p : Z * Z => Float (fst p) (snd p)) (Fnum q, Fexp q)). apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. apply mProd_correct; auto. apply mZlist_correct; auto with float. apply Zle_Zabs_inv1; auto with float. unfold pPred in |- *; apply Zle_Zpred; auto with float. apply Zle_Zabs_inv2; auto with float. unfold pPred in |- *; apply Zle_Zpred; auto with float. apply mZlist_correct; auto with float. auto with zarith. case q; simpl in |- *; auto with zarith. Qed. Theorem mBFadic_correct2 : forall r : R, In (boundR r) (mBFloat r). intros r; unfold mBFloat in |- *. replace (boundR r) with ((fun p : Z * Z => Float (fst p) (snd p)) (Fnum (boundR r), Fexp (boundR r))). apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. apply mProd_correct; auto. apply mZlist_correct; auto. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. apply Z.le_trans with (- (0))%Z; auto with zarith. apply Zle_Zopp; unfold pPred in |- *; apply Zle_Zpred; simpl in |- *. apply Z.lt_trans with 1%Z; auto with zarith. apply vNumbMoreThanOne with (3 := pGivesBound); auto. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. unfold pPred in |- *; apply Zle_Zpred; simpl in |- *. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. apply vNumbMoreThanOne with (3 := pGivesBound); auto. apply mZlist_correct; auto. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. apply Z.le_trans with 0%Z; auto with zarith arith. case (dExp b); auto with zarith. case (boundR r); simpl in |- *; auto with zarith. case (boundR r); simpl in |- *; auto with zarith. Qed. Theorem mBFadic_correct3 : forall r : R, In (Fopp (boundR r)) (mBFloat r). intros r; unfold mBFloat in |- *. replace (Fopp (boundR r)) with ((fun p : Z * Z => Float (fst p) (snd p)) (Fnum (Fopp (boundR r)), Fexp (Fopp (boundR r)))). apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. apply mProd_correct; auto. apply mZlist_correct; auto. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. replace (-1)%Z with (- Z_of_nat 1)%Z; auto with zarith. apply Zle_Zopp. unfold pPred in |- *; apply Zle_Zpred; simpl in |- *. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. unfold pPred in |- *; apply Zle_Zpred; simpl in |- *. red in |- *; simpl in |- *; auto. apply mZlist_correct; auto. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. apply Z.le_trans with 0%Z; auto with zarith. case (dExp b); auto with zarith. case (boundR r); simpl in |- *; auto with zarith. case (boundR r); simpl in |- *; auto with zarith. Qed. Theorem mBFadic_correct4 : forall r : R, In (Float 0%nat (- dExp b)) (mBFloat r). intros p; unfold mBFloat in |- *. replace (Float 0%nat (- dExp b)) with ((fun p : Z * Z => Float (fst p) (snd p)) (Fnum (Float 0%nat (- dExp b)), Fexp (Float 0%nat (- dExp b)))). apply in_map with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. apply mProd_correct; auto. apply mZlist_correct; auto. simpl in |- *; auto with zarith. replace 0%Z with (- (0))%Z; [ idtac | simpl in |- *; auto ]. apply Zle_Zopp; unfold pPred in |- *; apply Zle_Zpred. red in |- *; simpl in |- *; auto with zarith. simpl in |- *; auto with zarith. unfold pPred in |- *; apply Zle_Zpred. red in |- *; simpl in |- *; auto with zarith. apply mZlist_correct; auto. simpl in |- *; auto with zarith. unfold boundR, boundNat in |- *; simpl in |- *; auto with zarith. apply Z.le_trans with 0%Z; auto with zarith. case (dExp b); auto with zarith. simpl in |- *; auto with zarith. Qed. Theorem mBPadic_Fbounded : forall (p : float) (r : R), In p (mBFloat r) -> Fbounded b p. intros p r H'; red in |- *; repeat (split; auto). apply Zpred_Zle_Zabs_intro. apply mZlist_correct_rev1 with (q := Z.pred (Zpos (vNum b))); auto with real. apply mProd_correct_rev1 with (l2 := mZlist (- dExp b) (Fexp (boundR r))) (C := (Z * Z)%type) (b := Fexp p); auto. apply in_map_inv with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. intros a1 b1; case a1; case b1; simpl in |- *. intros z z0 z1 z2 H'0; inversion H'0; auto. generalize H'; case p; auto. apply mZlist_correct_rev2 with (p := (- Z.pred (Zpos (vNum b)))%Z); auto. apply mProd_correct_rev1 with (l2 := mZlist (- dExp b) (Fexp (boundR r))) (C := (Z * Z)%type) (b := Fexp p); auto. apply in_map_inv with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. intros a1 b1; case a1; case b1; simpl in |- *. intros z z0 z1 z2 H'0; inversion H'0; auto. generalize H'; case p; auto. apply mZlist_correct_rev1 with (q := Fexp (boundR r)); auto. apply mProd_correct_rev2 with (l1 := mZlist (- pPred (vNum b)) (pPred (vNum b))) (C := (Z * Z)%type) (a := Fnum p); auto. apply in_map_inv with (f := fun p : Z * Z => Float (fst p) (snd p)); auto. intros a1 b1; case a1; case b1; simpl in |- *. intros z z0 z1 z2 H'0; inversion H'0; auto. generalize H'; case p; auto. Qed. (* Some general properties of rounded predicate : -Projector A bounded is rounded to something equal to itself - Monotone : the rounded predicate is monotone *) Definition ProjectorP (P : R -> float -> Prop) := forall p q : float, Fbounded b p -> P p q -> p = q :>R. Definition MonotoneP (P : R -> float -> Prop) := forall (p q : R) (p' q' : float), (p < q)%R -> P p p' -> P q q' -> (p' <= q')%R. (* What it is to be a minimum*) Definition isMin (r : R) (min : float) := Fbounded b min /\ (min <= r)%R /\ (forall f : float, Fbounded b f -> (f <= r)%R -> (f <= min)%R). (* Min is a projector *) Theorem isMin_inv1 : forall (p : float) (r : R), isMin r p -> (p <= r)%R. intros p r H; case H; intros H1 H2; case H2; auto. Qed. Theorem ProjectMin : ProjectorP isMin. red in |- *. intros p q H' H'0; apply Rle_antisym. elim H'0; intros H'1 H'2; elim H'2; intros H'3 H'4; apply H'4; clear H'2; auto with real. apply isMin_inv1 with (1 := H'0); auto. Qed. (* It is monotone *) Theorem MonotoneMin : MonotoneP isMin. red in |- *. intros p q p' q' H' H'0 H'1. elim H'1; intros H'2 H'3; elim H'3; intros H'4 H'5; apply H'5; clear H'3 H'1; auto. case H'0; auto. apply Rle_trans with p; auto. apply isMin_inv1 with (1 := H'0); auto. apply Rlt_le; auto. Qed. (* What it is to be a maximum *) Definition isMax (r : R) (max : float) := Fbounded b max /\ (r <= max)%R /\ (forall f : float, Fbounded b f -> (r <= f)%R -> (max <= f)%R). (* It is a projector *) Theorem isMax_inv1 : forall (p : float) (r : R), isMax r p -> (r <= p)%R. intros p r H; case H; intros H1 H2; case H2; auto. Qed. Theorem ProjectMax : ProjectorP isMax. red in |- *. intros p q H' H'0; apply Rle_antisym. apply isMax_inv1 with (1 := H'0); auto. elim H'0; intros H'1 H'2; elim H'2; intros H'3 H'4; apply H'4; clear H'2; auto with real. Qed. (* It is monotone *) Theorem MonotoneMax : MonotoneP isMax. red in |- *. intros p q p' q' H' H'0 H'1. elim H'0; intros H'2 H'3; elim H'3; intros H'4 H'5; apply H'5; clear H'3 H'0. case H'1; auto. apply Rle_trans with q; auto. apply Rlt_le; auto. apply isMax_inv1 with (1 := H'1); auto. Qed. (* Minimun is defined upto equality *) Theorem MinEq : forall (p q : float) (r : R), isMin r p -> isMin r q -> p = q :>R. intros p q r H' H'0; apply Rle_antisym. elim H'0; intros H'1 H'2; elim H'2; intros H'3 H'4; apply H'4; clear H'2 H'0; auto. case H'; auto. apply isMin_inv1 with (1 := H'); auto. elim H'; intros H'1 H'2; elim H'2; intros H'3 H'4; apply H'4; clear H'2 H'; auto. case H'0; auto. apply isMin_inv1 with (1 := H'0); auto. Qed. (* Maximum is defined upto equality *) Theorem MaxEq : forall (p q : float) (r : R), isMax r p -> isMax r q -> p = q :>R. intros p q r H' H'0; apply Rle_antisym. elim H'; intros H'1 H'2; elim H'2; intros H'3 H'4; apply H'4; clear H'2 H'; auto. case H'0; auto. apply isMax_inv1 with (1 := H'0); auto. elim H'0; intros H'1 H'2; elim H'2; intros H'3 H'4; apply H'4; clear H'2 H'0; auto. case H'; auto. apply isMax_inv1 with (1 := H'); auto. Qed. (* Min and Max are related *) Theorem MinOppMax : forall (p : float) (r : R), isMin r p -> isMax (- r) (Fopp p). intros p r H'; split. apply oppBounded; case H'; auto. split. unfold FtoRradix in |- *; rewrite Fopp_correct. apply Ropp_le_contravar; apply isMin_inv1 with (1 := H'); auto. intros f H'0 H'1. rewrite <- (Fopp_Fopp f). unfold FtoRradix in |- *; rewrite Fopp_correct; rewrite Fopp_correct. apply Ropp_le_contravar. elim H'. intros H'2 H'3; elim H'3; intros H'4 H'5; apply H'5; clear H'3. apply oppBounded; case H'; auto. rewrite <- (Ropp_involutive r). unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. Qed. (* Max and Min are related *) Theorem MaxOppMin : forall (p : float) (r : R), isMax r p -> isMin (- r) (Fopp p). intros p r H'; split. apply oppBounded; case H'; auto. split. unfold FtoRradix in |- *; rewrite Fopp_correct. apply Ropp_le_contravar; apply isMax_inv1 with (1 := H'); auto. intros f H'0 H'1. rewrite <- (Fopp_Fopp f). unfold FtoRradix in |- *; repeat rewrite Fopp_correct. apply Ropp_le_contravar. rewrite <- (Fopp_correct radix f). elim H'. intros H'2 H'3; elim H'3; intros H'4 H'5; apply H'5; clear H'3. apply oppBounded; auto. rewrite <- (Ropp_involutive r). unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. Qed. (* If I have a strict min I can get a max using FNSucc *) Theorem MinMax : forall (p : float) (r : R), isMin r p -> r <> p :>R -> isMax r (FNSucc b radix precision p). intros p r H' H'0. split. apply FcanonicBound with (radix := radix); auto with float. apply FNSuccCanonic; auto. inversion H'; auto. split. case (Rle_or_lt (FNSucc b radix precision p) r); intros H'2; auto. absurd (FNSucc b radix precision p <= p)%R. apply Rlt_not_le. unfold FtoRradix in |- *; apply FNSuccLt; auto. inversion H'; auto. elim H0; intros H'1 H'3; apply H'3; auto. apply FcanonicBound with (radix := radix); auto with float. apply Rlt_le; auto. intros f H'2 H'3. replace (FtoRradix f) with (FtoRradix (Fnormalize radix b precision f)). unfold FtoRradix in |- *; apply FNSuccProp; auto. inversion H'; auto. apply FcanonicBound with (radix := radix); auto with float. apply Rlt_le_trans with r; auto. case (Rle_or_lt r p); auto. intros H'4; Contradict H'0. apply Rle_antisym; auto; apply isMin_inv1 with (1 := H'); auto. rewrite FnormalizeCorrect; auto. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. Qed. (* Find a minimun in a given list if it exists *) Theorem MinExList : forall (r : R) (L : list float), (forall f : float, In f L -> (r < f)%R) \/ (exists min : float, In min L /\ (min <= r)%R /\ (forall f : float, In f L -> (f <= r)%R -> (f <= min)%R)). intros r L; elim L; simpl in |- *; auto. left; intros f H'; elim H'. intros a l H'. elim H'; [ intros H'0; clear H' | intros H'0; elim H'0; intros min E; elim E; intros H'1 H'2; elim H'2; intros H'3 H'4; try exact H'4; clear H'2 E H'0 H' ]. case (Rle_or_lt a r); intros H'1. right; exists a; repeat split; auto. intros f H'; elim H'; [ intros H'2; rewrite <- H'2; clear H' | intros H'2; clear H' ]; auto with real. intros H'; Contradict H'; auto with real. apply Rlt_not_le; auto with real. left; intros f H'; elim H'; [ intros H'2; rewrite <- H'2; clear H' | intros H'2; clear H' ]; auto. case (Rle_or_lt a min); intros H'5. right; exists min; repeat split; auto. intros f H'; elim H'; [ intros H'0; rewrite <- H'0; clear H' | intros H'0; clear H' ]; auto. case (Rle_or_lt a r); intros H'6. right; exists a; repeat split; auto. intros f H'; elim H'; [ intros H'0; rewrite <- H'0; clear H' | intros H'0; clear H' ]; auto with real. intros H'; apply Rle_trans with (FtoRradix min); auto with real. right; exists min; split; auto; split; auto. intros f H'; elim H'; [ intros H'0; elim H'0; clear H' | intros H'0; clear H' ]; auto. intros H'; Contradict H'6; auto with real. apply Rle_not_lt; auto. Qed. Theorem MinEx : forall r : R, exists min : float, isMin r min. intros r. case (MinExList r (mBFloat r)). intros H'0; absurd (Fopp (boundR r) <= r)%R; auto. apply Rlt_not_le. apply H'0. apply mBFadic_correct3; auto. (* A minimum always exists *) apply Rlt_le. apply boundRCorrect2; auto. intros H'0; elim H'0; intros min E; elim E; intros H'1 H'2; elim H'2; intros H'3 H'4; clear H'2 E H'0. exists min; split; auto. apply mBPadic_Fbounded with (r := r); auto. split; auto. intros f H'0 H'2. case (Req_dec f 0); intros H'6. replace (FtoRradix f) with (FtoRradix (Float 0%nat (- dExp b))). apply H'4; auto. apply mBFadic_correct4; auto. replace (FtoRradix (Float 0%nat (- dExp b))) with (FtoRradix f); auto. rewrite H'6. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real. rewrite H'6. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real. case (Rle_or_lt f (Fopp (boundR r))); intros H'5. apply Rle_trans with (FtoRradix (Fopp (boundR r))); auto. apply H'4; auto. apply mBFadic_correct3; auto. apply Rlt_le. apply boundRCorrect2; auto. case (Rle_or_lt (boundR r) f); intros H'7. Contradict H'2; apply Rlt_not_le. apply Rlt_le_trans with (FtoRradix (boundR r)); auto. apply boundRCorrect1; auto. apply H'4; auto. apply mBFadic_correct1; auto. Contradict H'6; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto. Qed. Theorem MaxEx : forall r : R, exists max : float, isMax r max. intros r; case (MinEx r). intros x H'. case (Req_dec x r); intros H'1. exists x. rewrite <- H'1. red in |- *; split; [ case H' | split ]; auto with real. (* A maximum always exists *) exists (FNSucc b radix precision x). apply MinMax; auto. Qed. Theorem MinBinade : forall (r : R) (p : float), Fbounded b p -> (p <= r)%R -> (r < FNSucc b radix precision p)%R -> isMin r p. intros r p H' H'0 H'1. split; auto. split; auto. intros f H'2 H'3. case (Rle_or_lt f p); auto; intros H'5. Contradict H'3. (* If we are between a bound and its successor, it is our minimum *) apply Rlt_not_le. apply Rlt_le_trans with (1 := H'1); auto with real. replace (FtoRradix f) with (FtoRradix (Fnormalize radix b precision f)). unfold FtoRradix in |- *; apply FNSuccProp; auto; try apply FnormalizeCanonic; auto. unfold FtoRradix in |- *; repeat rewrite FnormalizeCorrect; auto with real. apply FcanonicBound with (radix := radix); auto. apply FnormalizeCanonic; auto. unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto with real. unfold FtoRradix in |- *; rewrite FnormalizeCorrect; auto with real. Qed. Theorem FminRep : forall p q : float, isMin p q -> exists m : Z, q = Float m (Fexp p) :>R. intros p q H'. replace (FtoRradix q) with (FtoRradix (Fnormalize radix b precision q)). 2: unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. case (Zle_or_lt (Fexp (Fnormalize radix b precision q)) (Fexp p)); intros H'1. exists (Fnum p). unfold FtoRradix in |- *; apply FSuccZleEq with (3 := pGivesBound); auto. (* A min of a float is always represnetable with the same exposant *) replace (Float (Fnum p) (Fexp p)) with p; [ idtac | case p ]; auto. replace (FtoR radix (Fnormalize radix b precision q)) with (FtoR radix q); [ idtac | rewrite FnormalizeCorrect ]; auto. apply isMin_inv1 with (1 := H'); auto. replace (FSucc b radix precision (Fnormalize radix b precision q)) with (FNSucc b radix precision q); [ idtac | case p ]; auto. replace (Float (Fnum p) (Fexp p)) with p; [ idtac | case p ]; auto. case (Req_dec p q); intros Eq0. unfold FtoRradix in Eq0; rewrite Eq0. apply FNSuccLt; auto. case (MinMax q p); auto. intros H'2 H'3; elim H'3; intros H'4 H'5; clear H'3. case H'4; auto. intros H'0; absurd (p <= q)%R; rewrite H'0; auto. apply Rlt_not_le; auto. unfold FtoRradix in |- *; apply FNSuccLt; auto. inversion H'. elim H0; intros H'3 H'6; apply H'6; clear H0; auto. rewrite <- H'0; auto with real. exists (Fnum (Fshift radix (Z.abs_nat (Fexp (Fnormalize radix b precision q) - Fexp p)) (Fnormalize radix b precision q))). pattern (Fexp p) at 2 in |- *; replace (Fexp p) with (Fexp (Fshift radix (Z.abs_nat (Fexp (Fnormalize radix b precision q) - Fexp p)) (Fnormalize radix b precision q))). unfold FtoRradix in |- *; rewrite <- FshiftCorrect with (n := Z.abs_nat (Fexp (Fnormalize radix b precision q) - Fexp p)) (x := Fnormalize radix b precision q). case (Fshift radix (Z.abs_nat (Fexp (Fnormalize radix b precision q) - Fexp p)) (Fnormalize radix b precision q)); auto. auto with arith. simpl in |- *; rewrite inj_abs; auto with zarith. Qed. Theorem MaxBinade : forall (r : R) (p : float), Fbounded b p -> (r <= p)%R -> (FNPred b radix precision p < r)%R -> isMax r p. intros r p H' H'0 H'1. rewrite <- (Ropp_involutive r). rewrite <- (Fopp_Fopp p). apply MinOppMax. apply MinBinade; auto with real float. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. (* Same for max *) rewrite <- (Fopp_Fopp (FNSucc b radix precision (Fopp p))). rewrite <- FNPredFopFNSucc; auto. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real arith. Qed. Theorem MaxMin : forall (p : float) (r : R), isMax r p -> r <> p :>R -> isMin r (FNPred b radix precision p). intros p r H' H'0. rewrite <- (Fopp_Fopp (FNPred b radix precision p)). rewrite <- (Ropp_involutive r). apply MaxOppMin. rewrite FNPredFopFNSucc; auto. rewrite Fopp_Fopp; auto. (* Taking the pred of a max we get a min *) apply MinMax; auto. apply MaxOppMin; auto. Contradict H'0. rewrite <- (Ropp_involutive r); rewrite H'0; auto; unfold FtoRradix in |- *; rewrite Fopp_correct; auto; apply Ropp_involutive. Qed. Theorem FmaxRep : forall p q : float, isMax p q -> exists m : Z, q = Float m (Fexp p) :>R. intros p q H'; case (FminRep (Fopp p) (Fopp q)). unfold FtoRradix in |- *; rewrite Fopp_correct. apply MaxOppMin; auto. intros x H'0. exists (- x)%Z. rewrite <- (Ropp_involutive (FtoRradix q)). (* The max of a float can be represented with the same exposant *) unfold FtoRradix in |- *; rewrite <- Fopp_correct. unfold FtoRradix in H'0; rewrite H'0. unfold FtoR in |- *; simpl in |- *; auto with real. rewrite Ropp_Ropp_IZR; rewrite Ropp_mult_distr_l_reverse; auto. Qed. End FMinMax. Hint Resolve ProjectMax MonotoneMax MinOppMax MaxOppMin MinMax MinBinade MaxBinade MaxMin: float. float-8.10.0/Fnorm.v000066400000000000000000001064701357127175600142030ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fnorm Laurent Thery & Sylvie Boldo ******************************************************************************) Require Export Fbound. Section Fnormalized_Def. Variable radix : Z. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Let FtoRradix := FtoR radix. Coercion FtoRradix : float >-> R. Variable b : Fbound. Definition Fnormal (p : float) := Fbounded b p /\ (Zpos (vNum b) <= Z.abs (radix * Fnum p))%Z. Theorem FnormalBounded : forall p : float, Fnormal p -> Fbounded b p. intros p H; case H; auto. Qed. Theorem FnormalBound : forall p : float, Fnormal p -> (Zpos (vNum b) <= Z.abs (radix * Fnum p))%Z. intros p H; case H; auto. Qed. Hint Resolve FnormalBounded FnormalBound: float. Theorem FnormalNotZero : forall p : float, Fnormal p -> ~ is_Fzero p. unfold is_Fzero in |- *; intros p H; red in |- *; intros H1. case H; rewrite H1. replace (Z.abs (radix * 0)) with 0%Z; auto with zarith. rewrite Zmult_comm; simpl in |- *; auto. Qed. Theorem FnormalFop : forall p : float, Fnormal p -> Fnormal (Fopp p). intros p H; split; auto with float. replace (Z.abs (radix * Fnum (Fopp p))) with (Z.abs (radix * Fnum p)); auto with float. case p; simpl in |- *; auto with zarith. intros Fnum1 Fexp1; rewrite <- Zopp_mult_distr_r; apply sym_equal; apply Zabs_Zopp. Qed. Theorem FnormalFabs : forall p : float, Fnormal p -> Fnormal (Fabs p). intros p; case p; intros a e H; split; auto with float. simpl in |- *; case H; intros H1 H2; simpl in |- *; auto. rewrite <- (Z.abs_eq radix); auto with zarith. rewrite <- Zabs_Zmult. rewrite (fun x => Z.abs_eq (Z.abs x)); auto with float zarith. Qed. Definition pPred x := Z.pred (Zpos x). Theorem maxMax1 : forall (p : float) (z : Z), Fbounded b p -> (Fexp p <= z)%Z -> (Fabs p <= Float (pPred (vNum b)) z)%R. intros p z H H0; unfold FtoRradix in |- *. rewrite <- (FshiftCorrect _ radixMoreThanOne (Z.abs_nat (z - Fexp p)) (Float (pPred (vNum b)) z)). unfold FtoR, Fabs in |- *; simpl in |- *; auto with zarith. rewrite Rmult_IZR; rewrite Zpower_nat_Z_powerRZ; auto with zarith. repeat rewrite inj_abs; auto with zarith. replace (z - (z - Fexp p))%Z with (Fexp p); [ idtac | ring ]. rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith. replace (z - Fexp p + Fexp p)%Z with z; [ idtac | ring ]. apply Rle_trans with (pPred (vNum b) * powerRZ radix (Fexp p))%R. apply Rle_monotone_exp; auto with zarith; repeat rewrite Rmult_IZR; apply Rle_IZR; unfold pPred in |- *; apply Zle_Zpred; auto with float real zarith. apply Rmult_le_compat_l; auto with real zarith. replace 0%R with (IZR 0); auto with real; apply Rle_IZR; unfold pPred in |- *; apply Zle_Zpred; auto with float zarith. apply Rle_powerRZ; auto with float real zarith. Qed. Theorem FnormalBoundAbs : forall p : float, Fnormal p -> (Float (pPred (vNum b)) (Z.pred (Fexp p)) < Fabs p)%R. intros p H'; unfold FtoRradix, FtoR in |- *; simpl in |- *. pattern (Fexp p) at 2 in |- *; replace (Fexp p) with (Z.succ (Z.pred (Fexp p))); [ rewrite powerRZ_Zs; auto with real zarith | unfold Z.succ, Z.pred in |- *; ring ]. repeat rewrite <- Rmult_assoc. apply Rmult_lt_compat_r; auto with real arith. rewrite <- Rmult_IZR; apply Rlt_IZR. unfold pPred in |- *; cut (Zpos (vNum b) <= Z.abs (Fnum p) * radix)%Z; auto with zarith. rewrite <- (Z.abs_eq radix); auto with float zarith; rewrite <- Zabs_Zmult; rewrite Zmult_comm; auto with float real zarith. Qed. Definition Fsubnormal (p : float) := Fbounded b p /\ Fexp p = (- dExp b)%Z /\ (Z.abs (radix * Fnum p) < Zpos (vNum b))%Z. Theorem FsubnormalFbounded : forall p : float, Fsubnormal p -> Fbounded b p. intros p H; case H; auto. Qed. Theorem FsubnormalFexp : forall p : float, Fsubnormal p -> Fexp p = (- dExp b)%Z. intros p H; case H; auto. intros H1 H2; case H2; auto. Qed. Theorem FsubnormalBound : forall p : float, Fsubnormal p -> (Z.abs (radix * Fnum p) < Zpos (vNum b))%Z. intros p H; case H; auto. intros H1 H2; case H2; auto. Qed. Hint Resolve FsubnormalFbounded FsubnormalBound FsubnormalFexp: float. Theorem FsubnormFopp : forall p : float, Fsubnormal p -> Fsubnormal (Fopp p). intros p H'; repeat split; simpl in |- *; auto with zarith float. rewrite Zabs_Zopp; auto with float. rewrite <- Zopp_mult_distr_r; rewrite Zabs_Zopp; auto with float. Qed. Theorem FsubnormFabs : forall p : float, Fsubnormal p -> Fsubnormal (Fabs p). intros p; case p; intros a e H; split; auto with float. simpl in |- *; split; auto with float. case H; intros H1 (H2, H3); auto. rewrite <- (Z.abs_eq radix); auto with zarith. rewrite <- Zabs_Zmult. rewrite (fun x => Z.abs_eq (Z.abs x)); auto with float zarith. case H; intros H1 (H2, H3); auto. Qed. Theorem FsubnormalUnique : forall p q : float, Fsubnormal p -> Fsubnormal q -> p = q :>R -> p = q. intros p q H' H'0 H'1. apply FtoREqInv2 with (radix := radix); auto. generalize H' H'0; unfold Fsubnormal in |- *; auto with zarith. Qed. Theorem FsubnormalLt : forall p q : float, Fsubnormal p -> Fsubnormal q -> (p < q)%R -> (Fnum p < Fnum q)%Z. intros p q H' H'0 H'1. apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith. apply trans_equal with (- dExp b)%Z. case H'; auto. intros H1 H2; case H2; auto. apply sym_equal; case H'0; auto. intros H1 H2; case H2; auto. Qed. Theorem LtFsubnormal : forall p q : float, Fsubnormal p -> Fsubnormal q -> (Fnum p < Fnum q)%Z -> (p < q)%R. intros p q H' H'0 H'1. case (Rtotal_order p q); auto; intros Test; case Test; clear Test; intros Test; Contradict H'1. unfold FtoRradix in Test; rewrite sameExpEq with (2 := Test); auto. auto with zarith. apply trans_equal with (- dExp b)%Z. case H'; auto. intros H1 H2; case H2; auto. apply sym_equal; case H'0. intros H1 H2; case H2; auto. apply Zle_not_lt. apply Zlt_le_weak. apply FsubnormalLt; auto. Qed. Definition Fcanonic (a : float) := Fnormal a \/ Fsubnormal a. Theorem FcanonicBound : forall p : float, Fcanonic p -> Fbounded b p. intros p H; case H; auto with float. Qed. Hint Resolve FcanonicBound: float. Theorem pUCanonic_absolu : forall p : float, Fcanonic p -> (Z.abs (Fnum p) < Zpos (vNum b))%Z. auto with float. Qed. Theorem FcanonicFopp : forall p : float, Fcanonic p -> Fcanonic (Fopp p). intros p H'; case H'; intros H'1. left; apply FnormalFop; auto. right; apply FsubnormFopp; auto. Qed. Theorem FcanonicFabs : forall p : float, Fcanonic p -> Fcanonic (Fabs p). intros p H'; case H'; clear H'; auto with float. intros H; left; auto with float. apply FnormalFabs; auto. intros H; right; auto with float. apply FsubnormFabs; auto. Qed. Theorem NormalNotSubNormal : forall p : float, ~ (Fnormal p /\ Fsubnormal p). intros p; red in |- *; intros H; elim H; intros H0 H1; clear H. absurd (Z.abs (radix * Fnum p) < Zpos (vNum b))%Z; auto with float zarith. Qed. Theorem MaxFloat : forall x : float, Fbounded b x -> (Rabs x < Float (Zpos (vNum b)) (Fexp x))%R. intros. replace (Rabs x) with (FtoR radix (Fabs x)). unfold FtoRradix in |- *. apply maxMax with (b := b); auto with *. unfold FtoRradix in |- *. apply Fabs_correct; auto with *. Qed. (* What depends of the precision *) Variable precision : nat. Hypothesis precisionNotZero : precision <> 0. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem FboundNext : forall p : float, Fbounded b p -> exists q : float, Fbounded b q /\ q = Float (Z.succ (Fnum p)) (Fexp p) :>R. intros p H'. case (Zle_lt_or_eq (Z.succ (Fnum p)) (Zpos (vNum b))); auto with float. case (Zle_or_lt 0 (Fnum p)); intros H1. rewrite <- (Z.abs_eq (Fnum p)); auto with float zarith. apply Z.le_trans with 0%Z; auto with zarith. intros H'0; exists (Float (Z.succ (Fnum p)) (Fexp p)); split; auto with float. repeat split; simpl in |- *; auto with float. case (Zle_or_lt 0 (Fnum p)); intros H1; auto with zarith. rewrite Z.abs_eq; auto with zarith. apply Z.lt_trans with (Z.abs (Fnum p)); auto with float zarith. repeat rewrite Zabs_eq_opp; auto with zarith. intros H'0; exists (Float (Zpower_nat radix (pred precision)) (Z.succ (Fexp p))); split; auto. repeat split; simpl in |- *; auto with zarith arith float. rewrite pGivesBound. rewrite Z.abs_eq; auto with zarith. rewrite H'0; rewrite pGivesBound. pattern precision at 2 in |- *; replace precision with (1 + pred precision). rewrite Zpower_nat_is_exp. rewrite Zpower_nat_1. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith. rewrite Rmult_IZR; ring. generalize precisionNotZero; case precision; simpl in |- *; auto with arith. intros H'1; case H'1; auto. Qed. Theorem digitPredVNumiSPrecision : digit radix (Z.pred (Zpos (vNum b))) = precision. apply digitInv; auto. rewrite pGivesBound. rewrite Z.abs_eq; auto with zarith. rewrite Z.abs_eq; auto with zarith. Qed. Theorem digitVNumiSPrecision : digit radix (Zpos (vNum b)) = S precision. apply digitInv; auto. rewrite pGivesBound. rewrite Z.abs_eq; auto with zarith. rewrite Z.abs_eq; auto with zarith. rewrite pGivesBound; auto with zarith. Qed. Theorem vNumPrecision : forall n : Z, digit radix n <= precision -> (Z.abs n < Zpos (vNum b))%Z. intros n H'. rewrite <- (Z.abs_eq (Zpos (vNum b))); auto with zarith. apply digit_anti_monotone_lt with (n := radix); auto. rewrite digitVNumiSPrecision; auto with arith. Qed. Theorem pGivesDigit : forall p : float, Fbounded b p -> Fdigit radix p <= precision. intros p H; unfold Fdigit in |- *. rewrite <- digitPredVNumiSPrecision. apply digit_monotone; auto with zarith. rewrite (fun x => Z.abs_eq (Z.pred x)); auto with float zarith. Qed. Theorem digitGivesBoundedNum : forall p : float, Fdigit radix p <= precision -> (Z.abs (Fnum p) < Zpos (vNum b))%Z. intros p H; apply vNumPrecision; auto. Qed. Theorem FboundedOne : forall z : Z, (- dExp b <= z)%Z -> Fbounded b (Float 1%nat z). intros z H'; repeat (split; simpl in |- *; auto with zarith). rewrite pGivesBound; auto. apply Z.lt_le_trans with (Zpower_nat radix 1); auto with zarith. rewrite Zpower_nat_1; auto with zarith. Qed. Theorem FboundedMboundPos : forall z m : Z, (0 <= m)%Z -> (m <= Zpower_nat radix precision)%Z -> (- dExp b <= z)%Z -> exists c : float, Fbounded b c /\ c = (m * powerRZ radix z)%R :>R. intros z m H' H'0 H'1; case (Zle_lt_or_eq _ _ H'0); intros H'2. exists (Float m z); split; auto with zarith. repeat split; simpl in |- *; auto with zarith. rewrite Z.abs_eq; auto; rewrite pGivesBound; auto. case (FboundNext (Float (Z.pred (Zpos (vNum b))) z)); auto with float. intros f' (H1, H2); exists f'; split; auto. rewrite H2; rewrite pGivesBound. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto. rewrite <- Zsucc_pred; rewrite <- H'2; auto; ring. Qed. Theorem FboundedMbound : forall z m : Z, (Z.abs m <= Zpower_nat radix precision)%Z -> (- dExp b <= z)%Z -> exists c : float, Fbounded b c /\ c = (m * powerRZ radix z)%R :>R. intros z m H H0. case (Zle_or_lt 0 m); intros H1. case (FboundedMboundPos z (Z.abs m)); auto; try rewrite Z.abs_eq; auto. intros f (H2, H3); exists f; split; auto. case (FboundedMboundPos z (Z.abs m)); auto; try rewrite Zabs_eq_opp; auto with zarith. intros f (H2, H3); exists (Fopp f); split; auto with float. rewrite (Fopp_correct radix); auto with arith; fold FtoRradix in |- *; rewrite H3. rewrite Ropp_Ropp_IZR; ring. Qed. Theorem FnormalPrecision : forall p : float, Fnormal p -> Fdigit radix p = precision. intros p H; apply le_antisym; auto with float. apply pGivesDigit; auto with float. apply le_S_n. rewrite <- digitVNumiSPrecision. unfold Fdigit in |- *. replace (S (digit radix (Fnum p))) with (digit radix (Fnum p) + 1). rewrite <- digitAdd; auto with zarith. apply digit_monotone; auto with float. rewrite (fun x => Z.abs_eq (Zpos x)); auto with float zarith. rewrite Zmult_comm; rewrite Zpower_nat_1; auto with float zarith. red in |- *; intros H1; case H. intros H0 H2; Contradict H2; rewrite H1. replace (Z.abs (radix * 0)) with 0%Z; auto with zarith. rewrite Zmult_comm; simpl in |- *; auto. rewrite plus_comm; simpl in |- *; auto. Qed. Hint Resolve FnormalPrecision: float. Theorem FnormalUnique : forall p q : float, Fnormal p -> Fnormal q -> p = q :>R -> p = q. intros p q H' H'0 H'1. apply (FdigitEq radix); auto. apply FnormalNotZero; auto. apply trans_equal with (y := precision); auto with float. apply sym_equal; auto with float. Qed. Theorem FnormalLtPos : forall p q : float, Fnormal p -> Fnormal q -> (0 <= p)%R -> (p < q)%R -> (Fexp p < Fexp q)%Z \/ Fexp p = Fexp q /\ (Fnum p < Fnum q)%Z. intros p q H' H'0 H'1 H'2. case (Zle_or_lt (Fexp q) (Fexp p)); auto. intros H'3; right. case (Zle_lt_or_eq _ _ H'3); intros H'4. 2: split; auto. 2: apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith. absurd (Fnum (Fshift radix (Z.abs_nat (Fexp p - Fexp q)) p) < Fnum q)%Z; auto. 2: apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith. 2: unfold FtoRradix in |- *; rewrite FshiftCorrect; auto. 2: unfold Fshift in |- *; simpl in |- *; auto with zarith. 2: replace (Z_of_nat (Z.abs_nat (Fexp p - Fexp q))) with (Fexp p - Fexp q)%Z; auto with zarith. 2: cut (0 < Fexp p - Fexp q)%Z; auto with zarith. 2: case (Fexp p - Fexp q)%Z; simpl in |- *; auto with zarith. 2: intros p0; rewrite (inject_nat_convert (Zpos p0)); auto with arith. 2: intros p0 H'5; discriminate. red in |- *; intros H'5. absurd (Fdigit radix (Fshift radix (Z.abs_nat (Fexp p - Fexp q)) p) <= Fdigit radix q); auto with arith. rewrite FshiftFdigit; auto with arith. replace (Fdigit radix p) with precision. replace (Fdigit radix q) with precision; auto with zarith. cut (0 < Fexp p - Fexp q)%Z; auto with zarith. case (Fexp p - Fexp q)%Z; simpl in |- *; auto with zarith. intros p0 H'6; generalize (convert_not_O p0); auto with zarith. intros p0 H'6; discriminate. apply sym_equal; auto with float. apply sym_equal; auto with float. apply FnormalNotZero; auto with arith. unfold Fdigit in |- *; apply digit_monotone; auto with arith. repeat rewrite Z.abs_eq; auto with zarith. apply LeR0Fnum with (radix := radix); auto with zarith. apply Rle_trans with (r2 := FtoRradix p); auto with real. apply LeR0Fnum with (radix := radix); auto with zarith. unfold FtoRradix in |- *; rewrite FshiftCorrect; auto. Qed. Theorem FnormalLtNeg : forall p q : float, Fnormal p -> Fnormal q -> (q <= 0)%R -> (p < q)%R -> (Fexp q < Fexp p)%Z \/ Fexp p = Fexp q /\ (Fnum p < Fnum q)%Z. intros p q H' H'0 H'1 H'2. cut ((Fexp (Fopp q) < Fexp (Fopp p))%Z \/ Fexp (Fopp q) = Fexp (Fopp p) /\ (Fnum (Fopp q) < Fnum (Fopp p))%Z). simpl in |- *. intros H'3; elim H'3; clear H'3; intros H'3; [ idtac | elim H'3; clear H'3; intros H'3 H'4 ]; auto; right; split; auto with zarith. apply FnormalLtPos; try apply FnormalFop; auto; unfold FtoRradix in |- *; repeat rewrite Fopp_correct; replace 0%R with (-0)%R; auto with real. Qed. Definition nNormMin := Zpower_nat radix (pred precision). Theorem nNormPos : (0 < nNormMin)%Z. unfold nNormMin in |- *; auto with zarith. Qed. Theorem digitnNormMin : digit radix nNormMin = precision. unfold nNormMin, Fdigit in |- *; simpl in |- *; apply digitInv; auto with zarith arith. rewrite Z.abs_eq; auto with zarith. Qed. Theorem nNrMMimLevNum : (nNormMin <= Zpos (vNum b))%Z. rewrite pGivesBound. unfold nNormMin in |- *; simpl in |- *; auto with zarith arith. Qed. Hint Resolve nNrMMimLevNum: arith. Definition firstNormalPos := Float nNormMin (- dExp b). Theorem firstNormalPosNormal : Fnormal firstNormalPos. repeat split; unfold firstNormalPos in |- *; simpl in |- *; auto with zarith. rewrite pGivesBound. rewrite Z.abs_eq; auto with zarith. unfold nNormMin in |- *; simpl in |- *; auto with zarith arith. apply Zlt_le_weak; auto with zarith. apply nNormPos. rewrite pGivesBound. replace precision with (pred precision + 1). rewrite Zpower_nat_is_exp; auto with zarith. rewrite Zpower_nat_1; auto with zarith. rewrite (fun x => Zmult_comm x radix); unfold nNormMin in |- *; auto with zarith. unfold nNormMin in |- *; auto with zarith. Qed. Theorem pNormal_absolu_min : forall p : float, Fnormal p -> (nNormMin <= Z.abs (Fnum p))%Z. intros p H; apply Zmult_le_reg_r with (p := radix); auto with zarith. unfold nNormMin in |- *. pattern radix at 2 in |- *; rewrite <- (Zpower_nat_1 radix). rewrite <- Zpower_nat_is_exp; auto with zarith. replace (pred precision + 1) with precision. rewrite <- pGivesBound; auto with float. rewrite <- (Z.abs_eq radix); auto with zarith. rewrite <- Zabs_Zmult; rewrite Zmult_comm; auto with float. generalize precisionNotZero; case precision; simpl in |- *; try (intros tmp; Contradict tmp; auto; fail); intros; rewrite plus_comm; simpl in |- *; auto. Qed. Theorem maxMaxBis : forall (p : float) (z : Z), Fbounded b p -> (Fexp p < z)%Z -> (Fabs p < Float nNormMin z)%R. intros p z H' H'0; apply Rlt_le_trans with (FtoR radix (Float (Zpos (vNum b)) (Z.pred z))). unfold FtoRradix in |- *; apply maxMax; auto with zarith; unfold Z.pred in |- *; auto with zarith. unfold FtoRradix, FtoR, nNormMin in |- *; simpl in |- *. pattern z at 2 in |- *; replace z with (Z.succ (Z.pred z)); [ rewrite powerRZ_Zs; auto with real zarith | unfold Z.succ, Z.pred in |- *; ring ]. rewrite <- Rmult_assoc. apply Rmult_le_compat_r; auto with real arith. pattern radix at 2 in |- *; rewrite <- (Zpower_nat_1 radix). rewrite <- Rmult_IZR. rewrite <- Zpower_nat_is_exp. replace (pred precision + 1) with precision. replace (INR (nat_of_P (vNum b))) with (IZR (Zpos (vNum b))). rewrite pGivesBound; auto with real. simpl; unfold IZR; rewrite <- INR_IPR; auto. generalize precisionNotZero; case precision; simpl in |- *; auto with arith. intros H'1; Contradict H'1; auto. intros; rewrite plus_comm; simpl in |- *; auto. Qed. Theorem FnormalLtFirstNormalPos : forall p : float, Fnormal p -> (0 <= p)%R -> (firstNormalPos <= p)%R. intros p H' H'0. case (Rle_or_lt firstNormalPos p); intros Lt0; auto with real. case (FnormalLtPos p firstNormalPos); auto. apply firstNormalPosNormal. intros H'1; Contradict H'1; unfold firstNormalPos in |- *; simpl in |- *. apply Zle_not_lt; auto with float. intros H'1; elim H'1; intros H'2 H'3; Contradict H'3. unfold firstNormalPos in |- *; simpl in |- *. apply Zle_not_lt. rewrite <- (Z.abs_eq (Fnum p)); auto with float zarith. apply pNormal_absolu_min; auto. apply LeR0Fnum with (radix := radix); auto with arith. Qed. Theorem FnormalLtFirstNormalNeg : forall p : float, Fnormal p -> (p <= 0)%R -> (p <= Fopp firstNormalPos)%R. intros p H' H'0. rewrite <- (Ropp_involutive p); unfold FtoRradix in |- *; repeat rewrite Fopp_correct. apply Ropp_le_contravar; rewrite <- Fopp_correct. apply FnormalLtFirstNormalPos. apply FnormalFop; auto. replace 0%R with (-0)%R; unfold FtoRradix in |- *; try rewrite Fopp_correct; auto with real. Qed. Theorem FsubnormalDigit : forall p : float, Fsubnormal p -> Fdigit radix p < precision. intros p H; unfold Fdigit in |- *. case (Z.eq_dec (Fnum p) 0); intros Z1. rewrite Z1; simpl in |- *; auto with arith. apply lt_S_n; apply le_lt_n_Sm. rewrite <- digitPredVNumiSPrecision. replace (S (digit radix (Fnum p))) with (digit radix (Fnum p) + 1). rewrite <- digitAdd; auto with zarith. apply digit_monotone; auto with float. rewrite (fun x => Z.abs_eq (Z.pred x)); auto with float zarith. rewrite Zmult_comm; rewrite Zpower_nat_1; auto with float zarith. rewrite plus_comm; simpl in |- *; auto. Qed. Hint Resolve FsubnormalDigit: float. Theorem pSubnormal_absolu_min : forall p : float, Fsubnormal p -> (Z.abs (Fnum p) < nNormMin)%Z. intros p H'; apply Zlt_mult_simpl_l with (c := radix); auto with zarith. replace (radix * Z.abs (Fnum p))%Z with (Z.abs (radix * Fnum p)). replace (radix * nNormMin)%Z with (Zpos (vNum b)); auto with float. rewrite pGivesBound. replace precision with (1 + pred precision). rewrite Zpower_nat_is_exp; auto with zarith; rewrite Zpower_nat_1; auto. generalize precisionNotZero; case precision; simpl in |- *; auto. intros H; Contradict H; auto. rewrite Zabs_Zmult; rewrite (Z.abs_eq radix); auto with zarith. Qed. Theorem FsubnormalLtFirstNormalPos : forall p : float, Fsubnormal p -> (0 <= p)%R -> (p < firstNormalPos)%R. intros p H' H'0; unfold FtoRradix, FtoR, firstNormalPos in |- *; simpl in |- *. replace (Fexp p) with (- dExp b)%Z. 2: apply sym_equal; case H'; intros H1 H2; case H2; auto. apply Rmult_lt_compat_r; auto with real arith. apply Rlt_IZR. rewrite <- (Z.abs_eq (Fnum p)). 2: apply LeR0Fnum with (radix := radix); auto with zarith. apply pSubnormal_absolu_min; auto. Qed. Theorem FsubnormalnormalLtPos : forall p q : float, Fsubnormal p -> Fnormal q -> (0 <= p)%R -> (0 <= q)%R -> (p < q)%R. intros p q H' H'0 H'1 H'2. apply Rlt_le_trans with (r2 := FtoRradix firstNormalPos). apply FsubnormalLtFirstNormalPos; auto. apply FnormalLtFirstNormalPos; auto. Qed. Theorem FsubnormalnormalLtNeg : forall p q : float, Fsubnormal p -> Fnormal q -> (p <= 0)%R -> (q <= 0)%R -> (q < p)%R. intros p q H' H'0 H'1 H'2. rewrite <- (Ropp_involutive p); rewrite <- (Ropp_involutive q). apply Ropp_gt_lt_contravar; red in |- *. unfold FtoRradix in |- *; repeat rewrite <- Fopp_correct. apply FsubnormalnormalLtPos; auto. apply FsubnormFopp; auto. apply FnormalFop; auto. unfold FtoRradix in |- *; rewrite Fopp_correct; replace 0%R with (-0)%R; auto with real. unfold FtoRradix in |- *; rewrite Fopp_correct; replace 0%R with (-0)%R; auto with real. Qed. Definition Fnormalize (p : float) := match Z_zerop (Fnum p) with | left _ => Float 0 (- dExp b) | right _ => Fshift radix (min (precision - Fdigit radix p) (Z.abs_nat (dExp b + Fexp p))) p end. Theorem FnormalizeCorrect : forall p : float, Fnormalize p = p :>R. intros p; unfold Fnormalize in |- *. case (Z_zerop (Fnum p)). case p; intros Fnum1 Fexp1 H'; unfold FtoRradix, FtoR in |- *; rewrite H'; simpl in |- *; auto with real. apply trans_eq with 0%R; auto with real. intros H'; unfold FtoRradix in |- *; apply FshiftCorrect; auto. Qed. Theorem Fnormalize_Fopp : forall p : float, Fnormalize (Fopp p) = Fopp (Fnormalize p). intros p; case p; unfold Fnormalize in |- *; simpl in |- *. intros Fnum1 Fexp1; case (Z_zerop Fnum1); intros H'. rewrite H'; simpl in |- *; auto. case (Z_zerop (- Fnum1)); intros H'0; simpl in |- *; auto. case H'; replace Fnum1 with (- - Fnum1)%Z; auto with zarith. unfold Fopp, Fshift, Fdigit in |- *; simpl in |- *. replace (digit radix (- Fnum1)) with (digit radix Fnum1). apply floatEq; simpl in |- *; auto with zarith. ring. case Fnum1; simpl in |- *; auto. Qed. Theorem FnormalizeBounded : forall p : float, Fbounded b p -> Fbounded b (Fnormalize p). intros p H'; red in |- *; split. unfold Fnormalize in |- *; case (Z_zerop (Fnum p)); auto. intros H'0; simpl in |- *; auto with zarith. intros H'0. apply digitGivesBoundedNum; auto. rewrite FshiftFdigit; auto. apply le_trans with (m := Fdigit radix p + (precision - Fdigit radix p)); auto with arith. rewrite <- le_plus_minus; auto. apply pGivesDigit; auto. unfold Fnormalize in |- *; case (Z_zerop (Fnum p)); auto. simpl in |- *; auto with zarith. generalize H'; case p; unfold Fbounded, Fnormal, Fdigit in |- *; simpl in |- *. intros Fnum1 Fexp1 H'0 H'1. apply Z.le_trans with (m := (Fexp1 - Z.abs_nat (dExp b + Fexp1))%Z). rewrite inj_abs; auto with zarith. unfold Zminus in |- *; apply Zplus_le_compat_l; auto. apply Zle_Zopp; auto. apply inj_le; auto with arith. Qed. Theorem FnormalizeCanonic : forall p : float, Fbounded b p -> Fcanonic (Fnormalize p). intros p H'. generalize (FnormalizeBounded p H'). unfold Fnormalize in |- *; case (Z_zerop (Fnum p)); auto. intros H'0; right; repeat split; simpl in |- *; auto with zarith. rewrite Zmult_comm; simpl in |- *; red in |- *; simpl in |- *; auto. intros H'1. case (min_or (precision - Fdigit radix p) (Z.abs_nat (dExp b + Fexp p))); intros Min; case Min; clear Min; intros MinR MinL. intros H'2; left; split; auto. rewrite MinR; unfold Fshift in |- *; simpl in |- *. apply Z.le_trans with (Z.abs (radix * (Zpower_nat radix (pred (Fdigit radix p)) * Zpower_nat radix (precision - Fdigit radix p)))). pattern radix at 1 in |- *; rewrite <- (Zpower_nat_1 radix). repeat rewrite <- Zpower_nat_is_exp; auto with zarith. replace (1 + (pred (Fdigit radix p) + (precision - Fdigit radix p))) with precision; auto. rewrite pGivesBound; auto with real. rewrite Z.abs_eq; auto with zarith. cut (Fdigit radix p <= precision); auto with float. unfold Fdigit in |- *. generalize (digitNotZero _ radixMoreThanOne _ H'1); case (digit radix (Fnum p)); simpl in |- *; auto. intros tmp; Contradict tmp; auto with arith. intros n H H0; change (precision = S n + (precision - S n)) in |- *. apply le_plus_minus; auto. apply pGivesDigit; auto. repeat rewrite Zabs_Zmult. apply Zle_Zmult_comp_l. apply Zle_ZERO_Zabs. apply Zle_Zmult_comp_r. apply Zle_ZERO_Zabs. rewrite (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith. unfold Fdigit in |- *; apply digitLess; auto. intros H'0; right; split; auto; split. rewrite MinR; clear MinR; auto. cut (- dExp b <= Fexp p)%Z; [ idtac | auto with float ]. case p; simpl in |- *. intros Fnum1 Fexp1 H'2; rewrite inj_abs; auto with zarith. rewrite MinR. rewrite <- (fun x => Z.abs_eq (Zpos x)). unfold Fshift in |- *; simpl in |- *. apply Z.lt_le_trans with (Z.abs (radix * (Zpower_nat radix (Fdigit radix p) * Zpower_nat radix (Z.abs_nat (dExp b + Fexp p))))). repeat rewrite Zabs_Zmult. apply Zmult_gt_0_lt_compat_l. apply Z.lt_gt; rewrite Z.abs_eq; auto with zarith. apply Zmult_gt_0_lt_compat_r. apply Z.lt_gt; rewrite Z.abs_eq; auto with zarith. rewrite (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith. unfold Fdigit in |- *; apply digitMore; auto. pattern radix at 1 in |- *; rewrite <- (Zpower_nat_1 radix). repeat rewrite <- Zpower_nat_is_exp; auto with zarith. apply Z.le_trans with (Z.abs (Zpower_nat radix precision)). repeat rewrite Z.abs_eq; auto with zarith. rewrite pGivesBound. rewrite (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith. red in |- *; simpl in |- *; red in |- *; intros; discriminate. Qed. Theorem NormalAndSubNormalNotEq : forall p q : float, Fnormal p -> Fsubnormal q -> p <> q :>R. intros p q H' H'0; red in |- *; intros H'1. case (Rtotal_order 0 p); intros H'2. absurd (q < p)%R. rewrite <- H'1; auto with real. apply FsubnormalnormalLtPos; auto with real. rewrite <- H'1; auto with real. absurd (p < q)%R. rewrite <- H'1; auto with real. apply FsubnormalnormalLtNeg; auto with real. rewrite <- H'1; auto with real. elim H'2; intros H'3; try rewrite <- H'3; auto with real. elim H'2; intros H'3; try rewrite <- H'3; auto with real. Qed. Theorem FcanonicUnique : forall p q : float, Fcanonic p -> Fcanonic q -> p = q :>R -> p = q. intros p q H' H'0 H'1; case H'; case H'0; intros H'2 H'3. apply FnormalUnique; auto. Contradict H'1; apply NormalAndSubNormalNotEq; auto. absurd (q = p :>R); auto; apply NormalAndSubNormalNotEq; auto. apply FsubnormalUnique; auto. Qed. Theorem FcanonicLeastExp : forall x y : float, x = y :>R -> Fbounded b x -> Fcanonic y -> (Fexp y <= Fexp x)%Z. intros x y H H0 H1. cut (Fcanonic (Fnormalize x)); [ intros | apply FnormalizeCanonic; auto ]. replace y with (Fnormalize x); [ simpl in |- * | apply FcanonicUnique; auto with real ]. unfold Fnormalize in |- *. case (Z_zerop (Fnum x)); simpl in |- *; intros Z1; auto with float. apply Zplus_le_reg_l with (- Fexp x)%Z. replace (- Fexp x + Fexp x)%Z with (- (0))%Z; try ring. replace (- Fexp x + (Fexp x - min (precision - Fdigit radix x) (Z.abs_nat (dExp b + Fexp x))))%Z with (- min (precision - Fdigit radix x) (Z.abs_nat (dExp b + Fexp x)))%Z; try ring. apply Zle_Zopp; auto with arith zarith. rewrite <- H. apply FnormalizeCorrect. Qed. Theorem FcanonicLtPos : forall p q : float, Fcanonic p -> Fcanonic q -> (0 <= p)%R -> (p < q)%R -> (Fexp p < Fexp q)%Z \/ Fexp p = Fexp q /\ (Fnum p < Fnum q)%Z. intros p q H' H'0 H'1 H'2; case H'; case H'0. intros H'3 H'4; apply FnormalLtPos; auto. intros H'3 H'4; absurd (p < q)%R; auto. apply Rlt_asym. apply FsubnormalnormalLtPos; auto. apply Rle_trans with (r2 := FtoRradix p); auto with real. intros H'3 H'4; case (Z.eq_dec (Fexp q) (- dExp b)); intros H'5. right; split. rewrite H'5; case H'4; intros H1 H2; case H2; auto. apply Rlt_Fexp_eq_Zlt with (radix := radix); auto with zarith. rewrite H'5; case H'4; intros H1 H2; case H2; auto. left. replace (Fexp p) with (- dExp b)%Z; [ idtac | apply sym_equal; auto with float ]. case (Zle_lt_or_eq (- dExp b) (Fexp q)); auto with float zarith. intros H'3 H'4; right; split. apply trans_equal with (- dExp b)%Z; auto with float. apply sym_equal; auto with float. apply FsubnormalLt; auto. Qed. Theorem FcanonicLePos : forall p q : float, Fcanonic p -> Fcanonic q -> (0 <= p)%R -> (p <= q)%R -> (Fexp p < Fexp q)%Z \/ Fexp p = Fexp q /\ (Fnum p <= Fnum q)%Z. intros p q H' H'0 H'1 H'2. case H'2; intros H'3. case FcanonicLtPos with (p := p) (q := q); auto with zarith arith. rewrite FcanonicUnique with (p := p) (q := q); auto with zarith arith. Qed. Theorem Fcanonic_Rle_Zle : forall x y : float, Fcanonic x -> Fcanonic y -> (Rabs x <= Rabs y)%R -> (Fexp x <= Fexp y)%Z. intros x y H H0 H1. cut (forall z : float, Fexp z = Fexp (Fabs z) :>Z); [ intros E | intros; unfold Fabs in |- *; simpl in |- *; auto with zarith ]. rewrite (E x); rewrite (E y). cut (Fcanonic (Fabs x)); [ intros D | apply FcanonicFabs; auto ]. cut (Fcanonic (Fabs y)); [ intros G | apply FcanonicFabs; auto ]. case H1; intros Z2. case (FcanonicLtPos (Fabs x) (Fabs y)); auto with zarith. rewrite (Fabs_correct radix); auto with real zarith. repeat rewrite (Fabs_correct radix); auto with real zarith. rewrite (FcanonicUnique (Fabs x) (Fabs y)); auto with float zarith. repeat rewrite (Fabs_correct radix); auto with real zarith. Qed. Theorem FcanonicLtNeg : forall p q : float, Fcanonic p -> Fcanonic q -> (q <= 0)%R -> (p < q)%R -> (Fexp q < Fexp p)%Z \/ Fexp p = Fexp q /\ (Fnum p < Fnum q)%Z. intros p q H' H'0 H'1 H'2. cut ((Fexp (Fopp q) < Fexp (Fopp p))%Z \/ Fexp (Fopp q) = Fexp (Fopp p) /\ (Fnum (Fopp q) < Fnum (Fopp p))%Z). simpl in |- *. intros H'3; elim H'3; clear H'3; intros H'3; [ idtac | elim H'3; clear H'3; intros H'3 H'4 ]; auto; right; split; auto with zarith. apply FcanonicLtPos; try apply FcanonicFopp; auto; unfold FtoRradix in |- *; repeat rewrite Fopp_correct; replace 0%R with (-0)%R; auto with real. Qed. Theorem FcanonicFnormalizeEq : forall p : float, Fcanonic p -> Fnormalize p = p. intros p H'. apply FcanonicUnique; auto. apply FnormalizeCanonic; auto. apply FcanonicBound with (1 := H'); auto. apply FnormalizeCorrect; auto. Qed. Theorem FcanonicPosFexpRlt : forall x y : float, (0 <= x)%R -> (0 <= y)%R -> Fcanonic x -> Fcanonic y -> (Fexp x < Fexp y)%Z -> (x < y)%R. intros x y H' H'0 H'1 H'2 H'3. case (Rle_or_lt y x); auto. intros H'4; case H'4; clear H'4; intros H'4. case FcanonicLtPos with (p := y) (q := x); auto. intros H'5; Contradict H'3; auto with zarith. intros H'5; elim H'5; intros H'6 H'7; clear H'5; Contradict H'3; rewrite H'6; auto with zarith. Contradict H'3. rewrite FcanonicUnique with (p := x) (q := y); auto with zarith. Qed. Theorem FcanonicNegFexpRlt : forall x y : float, (x <= 0)%R -> (y <= 0)%R -> Fcanonic x -> Fcanonic y -> (Fexp x < Fexp y)%Z -> (y < x)%R. intros x y H' H'0 H'1 H'2 H'3. case (Rle_or_lt x y); auto. intros H'4; case H'4; clear H'4; intros H'4. case FcanonicLtNeg with (p := x) (q := y); auto. intros H'5; Contradict H'3; auto with zarith. intros H'5; elim H'5; intros H'6 H'7; clear H'5; Contradict H'3; rewrite H'6; auto with zarith. Contradict H'3. rewrite FcanonicUnique with (p := x) (q := y); auto with zarith. Qed. Theorem FnormalBoundAbs2 : forall p : float, Fnormal p -> (Zpos (vNum b) * Float 1%nat (Z.pred (Fexp p)) <= Fabs p)%R. intros p H'; unfold FtoRradix, FtoR in |- *; simpl in |- *. replace (1 * powerRZ radix (Z.pred (Fexp p)))%R with (powerRZ radix (Z.pred (Fexp p))); [ idtac | ring ]. pattern (Fexp p) at 2 in |- *; replace (Fexp p) with (Z.succ (Z.pred (Fexp p))); [ rewrite powerRZ_Zs; auto with real zarith | unfold Z.succ, Z.pred in |- *; ring ]. repeat rewrite <- Rmult_assoc. apply Rmult_le_compat_r; auto with real arith. rewrite <- Rmult_IZR; apply Rle_IZR. rewrite <- (Z.abs_eq radix); auto with zarith. rewrite <- Zabs_Zmult; rewrite Zmult_comm; auto with float. Qed. Theorem vNumbMoreThanOne : (1 < Zpos (vNum b))%Z. replace 1%Z with (Z_of_nat 1); [ idtac | simpl in |- *; auto ]. rewrite <- (Zpower_nat_O radix); rewrite pGivesBound; auto with zarith. Qed. Theorem PosNormMin : Zpos (vNum b) = (radix * nNormMin)%Z. pattern radix at 1 in |- *; rewrite <- (Zpower_nat_1 radix); unfold nNormMin in |- *. rewrite pGivesBound; rewrite <- Zpower_nat_is_exp. generalize precisionNotZero; case precision; auto with zarith. Qed. Theorem FnormalPpred : forall x : Z, (- dExp b <= x)%Z -> Fnormal (Float (pPred (vNum b)) x). intros x H; (cut (0 <= pPred (vNum b))%Z; [ intros Z1 | unfold pPred in |- *; auto with zarith ]). repeat split; simpl in |- *; auto with zarith. rewrite (Z.abs_eq (pPred (vNum b))). unfold pPred in |- *; auto with zarith. unfold pPred in |- *; rewrite pGivesBound; auto with zarith. rewrite Zabs_Zmult; repeat rewrite Z.abs_eq; auto with zarith. apply Z.le_trans with ((1 + 1) * pPred (vNum b))%Z; auto with zarith. replace ((1 + 1) * pPred (vNum b))%Z with (pPred (vNum b) + pPred (vNum b))%Z; auto with zarith. replace (Zpos (vNum b)) with (1 + Z.pred (Zpos (vNum b)))%Z; unfold pPred in |- *; auto with zarith. apply Zplus_le_compat_r; apply Zle_Zpred. apply vNumbMoreThanOne. Qed. Theorem FcanonicPpred : forall x : Z, (- dExp b <= x)%Z -> Fcanonic (Float (pPred (vNum b)) x). intros x H; left; apply FnormalPpred; auto. Qed. Theorem FnormalNnormMin : forall x : Z, (- dExp b <= x)%Z -> Fnormal (Float nNormMin x). intros x H; (cut (0 < nNormMin)%Z; [ intros Z1 | apply nNormPos ]). repeat split; simpl in |- *; auto with zarith. rewrite Z.abs_eq; auto with zarith. rewrite PosNormMin. pattern nNormMin at 1 in |- *; replace nNormMin with (1 * nNormMin)%Z; auto with zarith. apply Zmult_gt_0_lt_compat_r; auto with zarith. rewrite PosNormMin; auto with zarith. Qed. Theorem FcanonicNnormMin : forall x : Z, (- dExp b <= x)%Z -> Fcanonic (Float nNormMin x). intros x H; left; apply FnormalNnormMin; auto. Qed. Theorem boundedNorMinGivesExp : forall (x : Z) (p : float), Fbounded b p -> (- dExp b <= x)%Z -> (Float nNormMin x <= p)%R -> (p <= Float (pPred (vNum b)) x)%R -> Fexp (Fnormalize p) = x. intros x p H' H'0 H'1 H'2. cut (0 <= p)%R; [ intros Rle1 | idtac ]. case (FcanonicLePos (Float nNormMin x) (Fnormalize p)); try rewrite FnormalizeCorrect; simpl in |- *; auto with float zarith. apply FcanonicNnormMin; auto. apply FnormalizeCanonic; auto. apply (LeFnumZERO radix); simpl in |- *; auto. apply Zlt_le_weak; apply nNormPos. intros H'3. case (FcanonicLePos (Fnormalize p) (Float (pPred (vNum b)) x)); try rewrite FnormalizeCorrect; simpl in |- *; auto. apply FnormalizeCanonic; auto. apply FcanonicPpred; auto. intros H'4; Contradict H'4; auto with zarith. intros (H'4, H'5); auto. apply Rle_trans with (2 := H'1). apply (LeFnumZERO radix); simpl in |- *; auto with zarith. apply Zlt_le_weak; apply nNormPos. Qed. End Fnormalized_Def. Hint Resolve FnormalBounded FnormalPrecision: float. Hint Resolve FnormalNotZero nNrMMimLevNum firstNormalPosNormal FsubnormFopp FsubnormalLtFirstNormalPos FnormalizeBounded FcanonicFopp FcanonicFabs FnormalizeCanonic: float. Hint Resolve nNrMMimLevNum: arith. Hint Resolve FsubnormalFbounded FsubnormalFexp FsubnormalDigit: float. Hint Resolve FcanonicBound: float. float-8.10.0/Fodd.v000066400000000000000000000334061357127175600137740ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fodd Laurent Thery ******************************************************************************) Require Export Fmin. Section FOdd. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local 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 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. (* We define the parity predicates*) Definition Even (z : Z) : Prop := exists z1 : _, z = (2 * z1)%Z. Definition Odd (z : Z) : Prop := exists z1 : _, z = (2 * z1 + 1)%Z. Theorem OddSEven : forall n : Z, Odd n -> Even (Z.succ n). intros n H'; case H'; intros m H'1; exists (Z.succ m). rewrite H'1; unfold Z.succ in |- *; ring. Qed. Theorem EvenSOdd : forall n : Z, Even n -> Odd (Z.succ n). intros n H'; case H'; intros m H'1; exists m. rewrite H'1; unfold Z.succ in |- *; ring. Qed. Hint Resolve OddSEven EvenSOdd: zarith. Theorem OddSEvenInv : forall n : Z, Odd (Z.succ n) -> Even n. intros n H'; case H'; intros m H'1; exists m. apply Z.succ_inj; rewrite H'1; (unfold Z.succ in |- *; ring). Qed. Theorem EvenSOddInv : forall n : Z, Even (Z.succ n) -> Odd n. intros n H'; case H'; intros m H'1; exists (Z.pred m). apply Z.succ_inj; rewrite H'1; (unfold Z.succ, Z.pred in |- *; ring). Qed. Theorem EvenO : Even 0. exists 0%Z; simpl in |- *; auto. Qed. Hint Resolve EvenO: zarith. Theorem Odd1 : Odd 1. exists 0%Z; simpl in |- *; auto. Qed. Hint Resolve Odd1: zarith. Theorem OddOpp : forall z : Z, Odd z -> Odd (- z). intros z H; case H; intros z1 H1; exists (- Z.succ z1)%Z; rewrite H1. unfold Z.succ in |- *; ring. Qed. Theorem EvenOpp : forall z : Z, Even z -> Even (- z). intros z H; case H; intros z1 H1; exists (- z1)%Z; rewrite H1; ring. Qed. Hint Resolve OddOpp EvenOpp: zarith. Theorem OddEvenDec : forall n : Z, {Odd n} + {Even n}. intros z; case z; simpl in |- *; auto with zarith. intros p; case p; simpl in |- *; auto with zarith. intros p1; left; exists (Zpos p1); rewrite Zplus_comm; simpl in |- *; auto. intros p1; right; exists (Zpos p1); simpl in |- *; auto. change (forall p : positive, {Odd (- Zpos p)} + {Even (- Zpos p)}) in |- *. intros p; case p; auto with zarith. intros p1; left; apply OddOpp; exists (Zpos p1); rewrite Zplus_comm; simpl in |- *; auto. intros p1; right; apply EvenOpp; exists (Zpos p1); simpl in |- *; auto. Qed. Theorem OddNEven : forall n : Z, Odd n -> ~ Even n. intros n H1; red in |- *; intros H2; case H1; case H2; intros z1 Hz1 z2 Hz2. absurd (n = n); auto. pattern n at 1 in |- *; rewrite Hz1; rewrite Hz2; repeat rewrite (fun x => Zplus_comm x 1). case z1; case z2; simpl in |- *; try (intros; red in |- *; intros; discriminate). intros p p0; case p; simpl in |- *; try (intros; red in |- *; intros; discriminate). Qed. Theorem EvenNOdd : forall n : Z, Even n -> ~ Odd n. intros n H1; red in |- *; intros H2; case H1; case H2; intros z1 Hz1 z2 Hz2. absurd (n = n); auto. pattern n at 1 in |- *; rewrite Hz1; rewrite Hz2; repeat rewrite (fun x => Zplus_comm x 1). case z1; case z2; simpl in |- *; try (intros; red in |- *; intros; discriminate). intros p p0; case p0; simpl in |- *; try (intros; red in |- *; intros; discriminate). Qed. Hint Resolve OddNEven EvenNOdd: zarith. Theorem EvenPlus1 : forall n m : Z, Even n -> Even m -> Even (n + m). intros n m H H0; case H; case H0; intros z1 Hz1 z2 Hz2. exists (z2 + z1)%Z; try rewrite Hz1; try rewrite Hz2; ring. Qed. Theorem EvenPlus2 : forall n m : Z, Odd n -> Odd m -> Even (n + m). intros n m H H0; case H; case H0; intros z1 Hz1 z2 Hz2. exists (z2 + z1 + 1)%Z; try rewrite Hz1; try rewrite Hz2; ring. Qed. Theorem OddPlus1 : forall n m : Z, Odd n -> Even m -> Odd (n + m). intros n m H H0; case H; case H0; intros z1 Hz1 z2 Hz2. exists (z2 + z1)%Z; try rewrite Hz1; try rewrite Hz2; ring. Qed. Theorem OddPlus2 : forall n m : Z, Even n -> Odd m -> Odd (n + m). intros n m H H0; case H; case H0; intros z1 Hz1 z2 Hz2. exists (z2 + z1)%Z; try rewrite Hz1; try rewrite Hz2; ring. Qed. Hint Resolve EvenPlus1 EvenPlus2 OddPlus1 OddPlus2: zarith. Theorem EvenPlusInv1 : forall n m : Z, Even (n + m) -> Even n -> Even m. intros n m H H0; replace m with (n + m + - n)%Z; auto with zarith. Qed. Theorem EvenPlusInv2 : forall n m : Z, Even (n + m) -> Odd n -> Odd m. intros n m H H0; replace m with (n + m + - n)%Z; auto with zarith. Qed. Theorem OddPlusInv1 : forall n m : Z, Odd (n + m) -> Odd m -> Even n. intros n m H H0; replace n with (n + m + - m)%Z; auto with zarith. Qed. Theorem OddPlusInv2 : forall n m : Z, Odd (n + m) -> Even m -> Odd n. intros n m H H0; replace n with (n + m + - m)%Z; auto with zarith. Qed. Theorem EvenMult1 : forall n m : Z, Even n -> Even (n * m). intros n m H; case H; intros z1 Hz1; exists (z1 * m)%Z; rewrite Hz1; ring. Qed. Theorem EvenMult2 : forall n m : Z, Even m -> Even (n * m). intros n m H; case H; intros z1 Hz1; exists (z1 * n)%Z; rewrite Hz1; ring. Qed. Hint Resolve EvenMult1 EvenMult2: zarith. Theorem OddMult : forall n m : Z, Odd n -> Odd m -> Odd (n * m). intros n m H1 H2; case H1; case H2; intros z1 Hz1 z2 Hz2; exists (2 * z1 * z2 + z1 + z2)%Z; rewrite Hz1; rewrite Hz2; ring. Qed. Hint Resolve OddMult: zarith. Theorem EvenMultInv : forall n m : Z, Even (n * m) -> Odd n -> Even m. intros n m H H0; case (OddEvenDec m); auto; intros Z1. Contradict H; auto with zarith. Qed. Theorem OddMultInv : forall n m : Z, Odd (n * m) -> Odd n. intros n m H; case (OddEvenDec n); auto; intros Z1. Contradict H; auto with zarith. Qed. Theorem EvenExp : forall (n : Z) (m : nat), Even n -> Even (Zpower_nat n (S m)). intros n m; elim m. rewrite Zpower_nat_1; simpl in |- *; auto with zarith. intros n0 H H0; replace (S (S n0)) with (1 + S n0); auto with arith. rewrite Zpower_nat_is_exp; rewrite Zpower_nat_1; simpl in |- *; auto with zarith. Qed. Theorem OddExp : forall (n : Z) (m : nat), Odd n -> Odd (Zpower_nat n m). intros n m; elim m; simpl in |- *. auto with zarith. intros n0 H H0; replace (S n0) with (1 + n0); auto with arith. auto with zarith. Qed. Hint Resolve OddExp EvenExp: zarith. Definition Feven (p : float) := Even (Fnum p). Definition Fodd (p : float) := Odd (Fnum p). Theorem FevenO : forall p : float, is_Fzero p -> Feven p. intros p H'; red in |- *; rewrite H'; simpl in |- *; auto with zarith. Qed. Theorem FevenOrFodd : forall p : float, Feven p \/ Fodd p. intros p; case (OddEvenDec (Fnum p)); auto. Qed. Theorem FevenSucProp : forall p : float, (Fodd p -> Feven (FSucc b radix precision p)) /\ (Feven p -> Fodd (FSucc b radix precision p)). intros p; unfold FSucc, Fodd, Feven in |- *. generalize (Z_eq_bool_correct (Fnum p) (pPred (vNum b))); case (Z_eq_bool (Fnum p) (pPred (vNum b))); intros H'1. rewrite H'1; simpl in |- *; auto. unfold pPred in |- *; rewrite pGivesBound; unfold nNormMin in |- *. case (OddEvenDec radix); auto with zarith. intros H'; split; intros H'0; auto with zarith. apply EvenMultInv with (n := radix); auto. pattern radix at 1 in |- *; rewrite <- Zpower_nat_1; rewrite <- Zpower_nat_is_exp. replace (1 + pred precision) with precision; [ idtac | inversion precisionGreaterThanOne; auto ]. rewrite (Zsucc_pred (Zpower_nat radix precision)); auto with zarith. intros H'; split; intros H'0; auto with zarith. replace (pred precision) with (S (pred (pred precision))); auto with zarith. Contradict H'0; apply OddNEven. replace (Z.pred (Zpower_nat radix precision)) with (Zpower_nat radix precision + - (1))%Z; [ idtac | unfold Z.pred in |- *; simpl in |- *; auto ]. replace precision with (S (pred precision)); [ auto with zarith | inversion precisionGreaterThanOne; auto ]. generalize (Z_eq_bool_correct (Fnum p) (- nNormMin radix precision)); case (Z_eq_bool (Fnum p) (- nNormMin radix precision)); intros H'2. generalize (Z_eq_bool_correct (Fexp p) (- dExp b)); case (Z_eq_bool (Fexp p) (- dExp b)); intros H'3. simpl in |- *; auto with zarith. simpl in |- *; auto with zarith. rewrite H'2; unfold pPred, nNormMin in |- *; rewrite pGivesBound. case (OddEvenDec radix); auto with zarith. intros H'; split; intros H'0; auto with zarith. apply EvenOpp; apply OddSEvenInv; rewrite <- Zsucc_pred; auto with zarith. Contradict H'0; replace precision with (S (pred precision)); [ auto with zarith | inversion precisionGreaterThanOne; auto ]. intros H'; split; intros H'0; auto with zarith. Contradict H'0; replace (pred precision) with (S (pred (pred precision))); [ auto with zarith | auto with zarith ]. replace precision with (S (pred precision)); [ auto with zarith | inversion precisionGreaterThanOne; auto ]. apply OddOpp; apply EvenSOddInv; rewrite <- Zsucc_pred; auto with zarith. simpl in |- *; auto with zarith. Qed. Theorem FoddSuc : forall p : float, Fodd p -> Feven (FSucc b radix precision p). intros p H'; case (FevenSucProp p); auto. Qed. Theorem FevenSuc : forall p : float, Feven p -> Fodd (FSucc b radix precision p). intros p H'; case (FevenSucProp p); auto. Qed. Theorem FevenFop : forall p : float, Feven p -> Feven (Fopp p). intros p; unfold Feven, Fopp in |- *; simpl in |- *; auto with zarith. Qed. Theorem FoddFop : forall p : float, Fodd p -> Fodd (Fopp p). intros p; unfold Fodd, Fopp in |- *; simpl in |- *; auto with zarith. Qed. Theorem FevenPred : forall p : float, Fodd p -> Feven (FPred b radix precision p). intros p H'; rewrite FPredFopFSucc; auto with arith. apply FevenFop; auto. apply FoddSuc; auto. apply FoddFop; auto with arith. Qed. Theorem FoddPred : forall p : float, Feven p -> Fodd (FPred b radix precision p). intros p H'; rewrite FPredFopFSucc; auto with arith. apply FoddFop; auto. apply FevenSuc; auto. apply FevenFop; auto. Qed. Definition FNodd (p : float) := Fodd (Fnormalize radix b precision p). Definition FNeven (p : float) := Feven (Fnormalize radix b precision p). Theorem FNoddEq : forall f1 f2 : float, Fbounded b f1 -> Fbounded b f2 -> f1 = f2 :>R -> FNodd f1 -> FNodd f2. intros f1 f2 H' H'0 H'1 H'2; red in |- *. rewrite FcanonicUnique with (3 := pGivesBound) (p := Fnormalize radix b precision f2) (q := Fnormalize radix b precision f1); auto with float arith. repeat rewrite FnormalizeCorrect; auto. Qed. Theorem FNevenEq : forall f1 f2 : float, Fbounded b f1 -> Fbounded b f2 -> f1 = f2 :>R -> FNeven f1 -> FNeven f2. intros f1 f2 H' H'0 H'1 H'2; red in |- *. rewrite FcanonicUnique with (3 := pGivesBound) (p := Fnormalize radix b precision f2) (q := Fnormalize radix b precision f1); auto with float arith. repeat rewrite FnormalizeCorrect; auto. Qed. Theorem FNevenFop : forall p : float, FNeven p -> FNeven (Fopp p). intros p; unfold FNeven in |- *. rewrite Fnormalize_Fopp; auto with arith. intros; apply FevenFop; auto. Qed. Theorem FNoddFop : forall p : float, FNodd p -> FNodd (Fopp p). intros p; unfold FNodd in |- *. rewrite Fnormalize_Fopp; auto with arith. intros; apply FoddFop; auto. Qed. Theorem FNoddSuc : forall p : float, Fbounded b p -> FNodd p -> FNeven (FNSucc b radix precision p). unfold FNodd, FNeven, FNSucc in |- *. intros p H' H'0. rewrite FcanonicFnormalizeEq; auto with float arith. apply FoddSuc; auto with float arith. Qed. Theorem FNevenSuc : forall p : float, Fbounded b p -> FNeven p -> FNodd (FNSucc b radix precision p). unfold FNodd, FNeven, FNSucc in |- *. intros p H' H'0. rewrite FcanonicFnormalizeEq; auto with float arith. apply FevenSuc; auto. Qed. Theorem FNevenPred : forall p : float, Fbounded b p -> FNodd p -> FNeven (FNPred b radix precision p). unfold FNodd, FNeven, FNPred in |- *. intros p H' H'0. rewrite FcanonicFnormalizeEq; auto with float arith. apply FevenPred; auto. Qed. Theorem FNoddPred : forall p : float, Fbounded b p -> FNeven p -> FNodd (FNPred b radix precision p). unfold FNodd, FNeven, FNPred in |- *. intros p H' H'0. rewrite FcanonicFnormalizeEq; auto with float arith. apply FoddPred; auto. Qed. Theorem FNevenOrFNodd : forall p : float, FNeven p \/ FNodd p. intros p; unfold FNeven, FNodd in |- *; apply FevenOrFodd. Qed. Theorem FnOddNEven : forall n : float, FNodd n -> ~ FNeven n. intros n H'; unfold FNeven, Feven in |- *; apply OddNEven; auto. Qed. Theorem FEvenD : forall p : float, Fbounded b p -> Feven p -> exists q : float, Fbounded b q /\ p = (2%nat * q)%R :>R. intros p H H0; case H0. intros z Hz; exists (Float z (Fexp p)); split; auto. repeat split; simpl in |- *; auto with float. apply Z.le_lt_trans with (Z.abs (Fnum p)); auto with float zarith. rewrite Hz; rewrite Zabs_Zmult; replace (Z.abs 2 * Z.abs z)%Z with (Z.abs z + Z.abs z)%Z; auto with zarith arith. pattern (Z.abs z) at 1 in |- *; replace (Z.abs z) with (0 + Z.abs z)%Z; auto with zarith. rewrite (Z.abs_eq 2); auto with zarith. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite Hz; rewrite Rmult_IZR; simpl in |- *; ring. Qed. Theorem FNEvenD : forall p : float, Fbounded b p -> FNeven p -> exists q : float, Fbounded b q /\ p = (2%nat * q)%R :>R. intros p H' H'0; case (FEvenD (Fnormalize radix b precision p)); auto with float zarith arith. intros x H'1; elim H'1; intros H'2 H'3; clear H'1; exists x; split; auto. apply sym_eq. rewrite <- H'3; auto. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. Qed. End FOdd. Hint Resolve FevenO FoddSuc FevenSuc FevenFop FoddFop FevenPred FoddPred FNevenFop FNoddFop FNoddSuc FNevenSuc FNevenPred FNoddPred: float. float-8.10.0/Fop.v000066400000000000000000000156571357127175600136540ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fop Laurent Thery ******************************************************************************) Require Export Fcomp. Section operations. Variable radix : Z. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixNotZero : (0 < radix)%Z. Definition Fplus (x y : float) := Float (Fnum x * Zpower_nat radix (Z.abs_nat (Fexp x - Z.min (Fexp x) (Fexp y))) + Fnum y * Zpower_nat radix (Z.abs_nat (Fexp y - Z.min (Fexp x) (Fexp y)))) (Z.min (Fexp x) (Fexp y)). Theorem Fplus_correct : forall x y : float, Fplus x y = (x + y)%R :>R. intros x y; unfold Fplus, Fshift, FtoRradix, FtoR in |- *; simpl in |- *. rewrite plus_IZR. rewrite Rmult_comm; rewrite Rmult_plus_distr_l; auto. repeat rewrite Rmult_IZR. repeat rewrite (Rmult_comm (Fnum x)); repeat rewrite (Rmult_comm (Fnum y)). repeat rewrite Zpower_nat_Z_powerRZ; auto. repeat rewrite <- Rmult_assoc. repeat rewrite <- powerRZ_add; auto with real zarith arith. repeat rewrite inj_abs; auto with real zarith. repeat rewrite Zplus_minus; auto. Qed. Definition Fopp (x : float) := Float (- Fnum x) (Fexp x). Theorem Fopp_correct : forall x : float, Fopp x = (- x)%R :>R. unfold FtoRradix, FtoR, Fopp in |- *; simpl in |- *. intros x. rewrite Ropp_Ropp_IZR; auto with real. Qed. Theorem Fopp_Fopp : forall p : float, Fopp (Fopp p) = p. intros p; case p; unfold Fopp in |- *; simpl in |- *; auto. intros; rewrite Z.opp_involutive; auto. Qed. Theorem Fzero_opp : forall f : float, ~ is_Fzero f -> ~ is_Fzero (Fopp f). intros f; case f; intros n e; case n; unfold is_Fzero in |- *; simpl in |- *; auto with zarith; intros; red in |- *; intros; discriminate. Qed. Theorem Fdigit_opp : forall x : float, Fdigit radix (Fopp x) = Fdigit radix x. intros x; unfold Fopp, Fdigit in |- *; simpl in |- *. rewrite <- (digit_abs radix (- Fnum x)). rewrite <- (digit_abs radix (Fnum x)). case (Fnum x); simpl in |- *; auto. Qed. Definition Fabs (x : float) := Float (Z.abs (Fnum x)) (Fexp x). Theorem Fabs_correct1 : forall x : float, (0 <= FtoR radix x)%R -> Fabs x = x :>R. intros x; case x; unfold FtoRradix, FtoR in |- *; simpl in |- *. intros Fnum1 Fexp1 H'. repeat rewrite <- (Rmult_comm (powerRZ radix Fexp1)); apply Rmult_eq_compat_l; auto. cut (0 <= Fnum1)%Z. unfold Z.abs, Z.le in |- *. case Fnum1; simpl in |- *; auto. intros p H'0; case H'0; auto. apply Znot_gt_le; auto. Contradict H'. apply Rgt_not_le; auto. rewrite Rmult_comm. replace 0%R with (powerRZ radix Fexp1 * 0)%R; auto with real. red in |- *; apply Rmult_lt_compat_l; auto with real zarith. Qed. Theorem Fabs_correct2 : forall x : float, (FtoR radix x <= 0)%R -> Fabs x = (- x)%R :>R. intros x; case x; unfold FtoRradix, FtoR in |- *; simpl in |- *. intros Fnum1 Fexp1 H'. rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite <- (Rmult_comm (powerRZ radix Fexp1)); apply Rmult_eq_compat_l; auto. cut (Fnum1 <= 0)%Z. unfold Z.abs, Z.le in |- *. case Fnum1; unfold IZR; auto with real. intros p H'0; case H'0; auto. apply Znot_gt_le. Contradict H'. apply Rgt_not_le; auto. rewrite Rmult_comm. replace 0%R with (powerRZ radix Fexp1 * 0)%R; auto with real. red in |- *; apply Rmult_lt_compat_l; auto with real arith. replace 0%R with (IZR 0); auto with real zarith arith. Qed. Theorem Fabs_correct : forall x : float, Fabs x = Rabs x :>R. intros x; unfold Rabs in |- *. case (Rcase_abs x); intros H1. unfold FtoRradix in |- *; apply Fabs_correct2; auto with arith. apply Rlt_le; auto. unfold FtoRradix in |- *; apply Fabs_correct1; auto with arith. apply Rge_le; auto. Qed. Theorem RleFexpFabs : forall p : float, p <> 0%R :>R -> (Float 1%nat (Fexp p) <= Fabs p)%R. intros p H'. unfold FtoRradix, FtoR, Fabs in |- *; simpl in |- *. apply Rmult_le_compat_r; auto with real arith. rewrite Zabs_absolu. replace 1%R with (INR 1); auto with real. repeat rewrite <- INR_IZR_INZ; apply Rle_INR; auto. cut (Z.abs_nat (Fnum p) <> 0); auto with zarith. Contradict H'. unfold FtoRradix, FtoR in |- *; simpl in |- *. replace (Fnum p) with 0%Z; try (simpl;ring). generalize H'; case (Fnum p); simpl in |- *; auto with zarith arith; intros p0 H'3; Contradict H'3; auto with zarith arith. Qed. Theorem Fabs_Fzero : forall x : float, ~ is_Fzero x -> ~ is_Fzero (Fabs x). intros x; case x; unfold is_Fzero in |- *; simpl in |- *. intros n m; case n; simpl in |- *; auto with zarith; intros; red in |- *; discriminate. Qed. Hint Resolve Fabs_Fzero: float. Theorem Fdigit_abs : forall x : float, Fdigit radix (Fabs x) = Fdigit radix x. intros x; unfold Fabs, Fdigit in |- *; simpl in |- *. case (Fnum x); auto. Qed. Definition Fminus (x y : float) := Fplus x (Fopp y). Theorem Fminus_correct : forall x y : float, Fminus x y = (x - y)%R :>R. intros x y; unfold Fminus in |- *. rewrite Fplus_correct. rewrite Fopp_correct; auto. Qed. Theorem Fopp_Fminus : forall p q : float, Fopp (Fminus p q) = Fminus q p. intros p q; case p; case q; unfold Fopp, Fminus, Fplus in |- *; simpl in |- *; auto. intros; apply floatEq; simpl in |- *; repeat rewrite (Zmin_sym Fexp0 Fexp); repeat rewrite Zopp_mult_distr_l_reverse; auto with zarith. Qed. Theorem Fopp_Fminus_dist : forall p q : float, Fopp (Fminus p q) = Fminus (Fopp p) (Fopp q). intros p q; case p; case q; unfold Fopp, Fminus, Fplus in |- *; simpl in |- *; auto. intros; apply floatEq; simpl in |- *; repeat rewrite (Zmin_sym Fexp0 Fexp); repeat rewrite Zopp_mult_distr_l_reverse; auto with zarith. Qed. Theorem minusSameExp : forall x y : float, Fexp x = Fexp y -> Fminus x y = Float (Fnum x - Fnum y) (Fexp x). intros x y; case x; case y; unfold Fminus, Fplus, Fopp in |- *; simpl in |- *. intros Fnum1 Fexp1 Fnum2 Fexp2 H'; rewrite <- H'. repeat rewrite Zmin_n_n. apply floatEq; simpl in |- *; auto. replace (Z.abs_nat (Fexp2 - Fexp2)) with 0; auto with zarith arith. replace (Zpower_nat radix 0) with (Z_of_nat 1); simpl in |- *; auto with zarith arith. replace (Fexp2 - Fexp2)%Z with 0%Z; simpl in |- *; auto with zarith arith. Qed. Definition Fmult (x y : float) := Float (Fnum x * Fnum y) (Fexp x + Fexp y). Definition Fmult_correct : forall x y : float, Fmult x y = (x * y)%R :>R. intros x y; unfold FtoRradix, FtoR, Fmult in |- *; simpl in |- *; auto. rewrite powerRZ_add; auto with real zarith. repeat rewrite Rmult_IZR. repeat rewrite Rmult_assoc. repeat rewrite (Rmult_comm (Fnum y)). repeat rewrite <- Rmult_assoc. repeat rewrite Zmult_assoc_reverse; auto. Qed. Theorem oneZplus : forall x y : Z, Float 1%nat (x + y) = Fmult (Float 1%nat x) (Float 1%nat y). intros x y; unfold Fmult in |- *; auto. Qed. End operations. Hint Resolve Fabs_Fzero: float. Hint Resolve Fzero_opp: float.float-8.10.0/Fprop.v000066400000000000000000000124371357127175600142070ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fprop Laurent Thery ******************************************************************************) Require Export Fbound. Section Fprop. Variable radix : Z. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Variable b : Fbound. Theorem SterbenzAux : forall x y : float, Fbounded b x -> Fbounded b y -> (y <= x)%R -> (x <= 2%nat * y)%R -> Fbounded b (Fminus radix x y). intros x y H' H'0 H'1 H'2. cut (0 <= Fminus radix x y)%R; [ intros Rle1 | idtac ]. cut (Fminus radix x y <= y)%R; [ intros Rle2 | idtac ]. case (Zle_or_lt (Fexp x) (Fexp y)); intros Zle1. repeat split. apply Z.le_lt_trans with (Z.abs (Fnum x)); auto with float. change (Fnum (Fabs (Fminus radix x y)) <= Fnum (Fabs x))%Z in |- *. apply Rle_Fexp_eq_Zle with (radix := radix); auto with arith. repeat rewrite Fabs_correct. repeat rewrite Rabs_pos_eq; auto. apply Rle_trans with (2 := H'1); auto. apply Rle_trans with (2 := H'1); auto. apply Rle_trans with (2 := Rle2); auto. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. unfold Fminus in |- *; simpl in |- *; apply Zmin_le1; auto. unfold Fminus in |- *; simpl in |- *; rewrite Zmin_le1; auto with float. repeat split. apply Z.le_lt_trans with (Z.abs (Fnum y)); auto with float. change (Fnum (Fabs (Fminus radix x y)) <= Fnum (Fabs y))%Z in |- *. apply Rle_Fexp_eq_Zle with (radix := radix); auto with arith. repeat rewrite Fabs_correct. repeat rewrite Rabs_pos_eq; auto. apply Rle_trans with (2 := Rle2); auto. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. unfold Fminus in |- *; simpl in |- *; apply Zmin_le2; auto with zarith. unfold Fminus in |- *; simpl in |- *; rewrite Zmin_le2; auto with float zarith. rewrite (Fminus_correct radix); auto with arith; fold FtoRradix in |- *. apply Rplus_le_reg_l with (r := FtoRradix y); auto. replace (y + (x - y))%R with (FtoRradix x); [ idtac | ring ]. replace (y + y)%R with (2%nat * y)%R; [ auto | simpl in |- *; ring ]. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. rewrite (Fminus_correct radix); auto with arith; fold FtoRradix in |- *. apply Rplus_le_reg_l with (r := FtoRradix y); auto. replace (y + (x - y))%R with (FtoRradix x); [ idtac | ring ]. replace (y + 0)%R with (FtoRradix y); [ auto | simpl in |- *; ring ]. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. Qed. Theorem Sterbenz : forall x y : float, Fbounded b x -> Fbounded b y -> (/ 2%nat * y <= x)%R -> (x <= 2%nat * y)%R -> Fbounded b (Fminus radix x y). intros x y H' H'0 H'1 H'2. cut (y <= 2%nat * x)%R; [ intros Le1 | idtac ]. case (Rle_or_lt x y); intros Le2; auto. apply oppBoundedInv; auto. rewrite Fopp_Fminus. apply SterbenzAux; auto with real. apply SterbenzAux; auto with real. apply Rmult_le_reg_l with (r := (/ 2%nat)%R). apply Rinv_0_lt_compat; auto with real. rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. rewrite Rmult_1_l; auto. Qed. Theorem BminusSameExpAux : forall x y : float, Fbounded b x -> Fbounded b y -> (0 <= y)%R -> (y <= x)%R -> Fexp x = Fexp y -> Fbounded b (Fminus radix x y). intros x y H' H'0 H'1 H'2 H'3. cut (0 < radix)%Z; [ intros Z1 | idtac ]. rewrite minusSameExp; auto. repeat split; simpl in |- *; auto with float. apply Z.le_lt_trans with (Z.abs (Fnum x)); auto with float zarith. change (Fnum (Fabs (Float (Fnum x - Fnum y) (Fexp x))) <= Fnum (Fabs x))%Z in |- *. apply Rle_Fexp_eq_Zle with (radix := radix); auto with zarith. rewrite <- (minusSameExp radix); auto. repeat rewrite (Fabs_correct radix); try rewrite Fminus_correct; auto with zarith. repeat rewrite Rabs_pos_eq; auto with real. apply Rle_trans with (x - 0)%R; auto with real. unfold Rminus in |- *; auto with real. apply Rle_trans with (FtoRradix y); auto with real. replace 0%R with (x - x)%R; auto with real. unfold Rminus in |- *; auto with real. apply Z.lt_trans with (2 := radixMoreThanOne); auto with zarith. Qed. Theorem BminusSameExp : forall x y : float, Fbounded b x -> Fbounded b y -> (0 <= x)%R -> (0 <= y)%R -> Fexp x = Fexp y -> Fbounded b (Fminus radix x y). intros x y H' H'0 H'1 H'2 H'3. case (Rle_or_lt x y); intros Le2; auto. apply oppBoundedInv; auto. rewrite Fopp_Fminus. apply BminusSameExpAux; auto. apply BminusSameExpAux; auto with real. Qed. Theorem BminusSameExpNeg : forall x y : float, Fbounded b x -> Fbounded b y -> (x <= 0)%R -> (y <= 0)%R -> Fexp x = Fexp y -> Fbounded b (Fminus radix x y). intros x y H' H'0 H'1 H'2 H'3. apply oppBoundedInv; auto. rewrite Fopp_Fminus_dist. apply BminusSameExp; auto with float. unfold FtoRradix in |- *; rewrite Fopp_correct. replace 0%R with (-0)%R; auto with real. unfold FtoRradix in |- *; rewrite Fopp_correct. replace 0%R with (-0)%R; auto with real. Qed. End Fprop. Hint Resolve Sterbenz BminusSameExp BminusSameExpNeg: float.float-8.10.0/Fround.v000066400000000000000000000333151357127175600143540ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Fround Laurent Thery ******************************************************************************) Require Export Fprop. Require Export Fodd. Section FRound. Variable b : Fbound. Variable radix : Z. Variable precision : nat. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Hypothesis precisionGreaterThanOne : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Definition TotalP (P : R -> float -> Prop) := forall r : R, exists p : float, P r p. Definition UniqueP (P : R -> float -> Prop) := forall (r : R) (p q : float), P r p -> P r q -> p = q :>R. Definition CompatibleP (P : R -> float -> Prop) := forall (r1 r2 : R) (p q : float), P r1 p -> r1 = r2 -> p = q :>R -> Fbounded b q -> P r2 q. Definition MinOrMaxP (P : R -> float -> Prop) := forall (r : R) (p : float), P r p -> isMin b radix r p \/ isMax b radix r p. Definition RoundedModeP (P : R -> float -> Prop) := TotalP P /\ CompatibleP P /\ MinOrMaxP P /\ MonotoneP radix P. Theorem RoundedModeP_inv1 : forall P, RoundedModeP P -> TotalP P. intros P H; case H; auto. Qed. Theorem RoundedModeP_inv2 : forall P, RoundedModeP P -> CompatibleP P. intros P H; Casec H; intros H H1; Casec H1; auto. Qed. Theorem RoundedModeP_inv3 : forall P, RoundedModeP P -> MinOrMaxP P. intros P H; Casec H; intros H H1; Casec H1; intros H1 H2; Casec H2; auto. Qed. Theorem RoundedModeP_inv4 : forall P, RoundedModeP P -> MonotoneP radix P. intros P H; Casec H; intros H H1; Casec H1; intros H1 H2; Casec H2; auto. Qed. Hint Resolve RoundedModeP_inv1 RoundedModeP_inv2 RoundedModeP_inv3 RoundedModeP_inv4: inv. Theorem RoundedProjector : forall P, RoundedModeP P -> ProjectorP b radix P. intros P H'; red in |- *; simpl in |- *. intros p q H'0 H'1. red in H'. elim H'; intros H'2 H'3; elim H'3; intros H'4 H'5; elim H'5; intros H'6 H'7; case (H'6 p q); clear H'5 H'3 H'; auto. intros H'; apply (ProjectMin b radix p); auto. intros H'; apply (ProjectMax b radix p); auto. Qed. Theorem MinCompatible : CompatibleP (isMin b radix). red in |- *. intros r1 r2 p q H' H'0 H'1 H'2; split; auto. rewrite <- H'0; unfold FtoRradix in H'1; rewrite <- H'1; case H'; auto. Qed. Theorem MinRoundedModeP : RoundedModeP (isMin b radix). split; try red in |- *. intros r; apply MinEx with (precision := precision); auto with arith. split; try exact MinCompatible. split; try apply MonotoneMin; red in |- *; auto. Qed. Theorem MaxCompatible : CompatibleP (isMax b radix). red in |- *. intros r1 r2 p q H' H'0 H'1 H'2; split; auto. rewrite <- H'0; unfold FtoRradix in H'1; rewrite <- H'1; case H'; auto. Qed. Theorem MaxRoundedModeP : RoundedModeP (isMax b radix). split; try red in |- *. intros r; apply MaxEx with (precision := precision); auto with arith. split; try exact MaxCompatible. split; try apply MonotoneMax; red in |- *; auto. Qed. Definition ToZeroP (r : R) (p : float) := (0 <= r)%R /\ isMin b radix r p \/ (r <= 0)%R /\ isMax b radix r p. Theorem ToZeroTotal : TotalP ToZeroP. red in |- *; intros r; case (Rle_or_lt r 0); intros H1. case MaxEx with (r := r) (3 := pGivesBound); auto with arith. intros x H'; exists x; red in |- *; auto. case MinEx with (r := r) (3 := pGivesBound); auto with arith. intros x H'; exists x; red in |- *; left; split; auto. apply Rlt_le; auto. Qed. Theorem ToZeroCompatible : CompatibleP ToZeroP. red in |- *. intros r1 r2 p q H'; case H'. intros H'0 H'1 H'2; left; split; try apply MinCompatible with (p := p) (r1 := r1); try rewrite <- H'1; auto; case H'0; auto. intros H'0 H'1 H'2; right; split; try apply MaxCompatible with (p := p) (r1 := r1); try rewrite <- H'1; auto; case H'0; auto. Qed. Theorem ToZeroMinOrMax : MinOrMaxP ToZeroP. red in |- *. intros r p H'; case H'; clear H'; intros H'; case H'; auto. Qed. Theorem ToZeroMonotone : MonotoneP radix ToZeroP. red in |- *. cut (FtoR radix (Fzero (- dExp b)) = 0%R); [ intros Eq0 | unfold FtoR in |- *; simpl in |- * ]; auto with real. simpl in |- *; intros p q p' q' H' H'0; case H'0; clear H'0. intros H'0; elim H'0; intros H'1 H'2; clear H'0; intros H'0. case H'0; intros H'3; elim H'3; clear H'3; auto. intros H'3 H'4. apply (MonotoneMin b radix) with (p := p) (q := q); auto. intros H'3 H'4. apply Rle_trans with p; [ apply isMin_inv1 with (1 := H'2); auto | idtac ]. apply Rle_trans with q; [ idtac | apply isMax_inv1 with (1 := H'4) ]; auto. apply Rlt_le; auto. intros H'0; elim H'0; intros H'1 H'2; clear H'0. intros H'0; case H'0; clear H'0; intros H'0; case H'0; intros H'3 H'4; clear H'0. apply Rle_trans with (FtoRradix (Fzero (- dExp b))); auto. elim H'2. intros H'0 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. repeat split; simpl in |- *; auto with zarith. rewrite Eq0; auto. elim H'4. intros H'0 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. repeat split; simpl in |- *; auto with zarith. rewrite Eq0; auto. apply (MonotoneMax b radix) with (p := p) (q := q); auto. Qed. Theorem ToZeroRoundedModeP : RoundedModeP ToZeroP. repeat split. try exact ToZeroTotal. try exact ToZeroCompatible. try exact ToZeroMinOrMax. try exact ToZeroMonotone. Qed. Definition ToInfinityP (r : R) (p : float) := (r <= 0)%R /\ isMin b radix r p \/ (0 <= r)%R /\ isMax b radix r p. Theorem ToInfinityTotal : TotalP ToInfinityP. red in |- *; intros r; case (Rle_or_lt r 0); intros H1. case MinEx with (r := r) (3 := pGivesBound); auto with arith. intros x H'; exists x; red in |- *; auto. case MaxEx with (r := r) (3 := pGivesBound); auto with arith. intros x H'; exists x; red in |- *; right; split; auto. apply Rlt_le; auto. Qed. Theorem ToInfinityCompatible : CompatibleP ToInfinityP. red in |- *. intros r1 r2 p q H'; case H'. intros H'0 H'1 H'2; left; split; try apply MinCompatible with (p := p) (r1 := r1); try rewrite <- H'1; case H'0; auto. intros H'0 H'1 H'2; right; split; try apply MaxCompatible with (p := p) (r1 := r1); try rewrite <- H'1; case H'0; auto. Qed. Theorem ToInfinityMinOrMax : MinOrMaxP ToInfinityP. red in |- *. intros r p H'; case H'; clear H'; intros H'; case H'; auto. Qed. Theorem ToInfinityMonotone : MonotoneP radix ToInfinityP. red in |- *; simpl in |- *. cut (FtoR radix (Fzero (- dExp b)) = 0%R); [ intros Eq0 | unfold FtoR in |- *; simpl in |- * ]; auto with real. intros p q p' q' H' H'0; case H'0; clear H'0. intros H'0; elim H'0; intros H'1 H'2; clear H'0; intros H'0. case H'0; intros H'3; elim H'3; clear H'3; auto. intros H'3 H'4. apply (MonotoneMin b radix) with (p := p) (q := q); auto. intros H'3 H'4. apply Rle_trans with p; [ apply isMin_inv1 with (1 := H'2); auto | idtac ]. apply Rle_trans with q; [ auto | apply isMax_inv1 with (1 := H'4) ]; auto. apply Rlt_le; auto. intros H'0; elim H'0; intros H'1 H'2; clear H'0. intros H'0; case H'0; clear H'0; intros H'0; case H'0; intros H'3 H'4; clear H'0. 2: apply (MonotoneMax b radix) with (p := p) (q := q); auto. apply Rle_trans with (FtoRradix (Fzero (- dExp b))); auto. elim H'2. intros H'0 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. repeat split; simpl in |- *; auto with zarith. apply Rle_trans with q; auto. apply Rlt_le; auto. rewrite Eq0; auto. elim H'4. intros H'0 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. repeat split; simpl in |- *; auto with zarith. apply Rle_trans with p; auto. rewrite Eq0; auto. apply Rlt_le; auto. Qed. Theorem ToInfinityRoundedModeP : RoundedModeP ToInfinityP. repeat split. try exact ToInfinityTotal. try exact ToInfinityCompatible. try exact ToInfinityMinOrMax. try exact ToInfinityMonotone. Qed. Theorem MinUniqueP : UniqueP (isMin b radix). red in |- *. intros r p q H' H'0. unfold FtoRradix in |- *; apply MinEq with (1 := H'); auto. Qed. Theorem MaxUniqueP : UniqueP (isMax b radix). red in |- *. intros r p q H' H'0. unfold FtoRradix in |- *; apply MaxEq with (1 := H'); auto. Qed. Theorem ToZeroUniqueP : UniqueP ToZeroP. red in |- *. intros r p q H' H'0. inversion H'; inversion H'0; elim H0; elim H; clear H0 H; intros H'1 H'2 H'3 H'4. apply (MinUniqueP r); auto. cut (r = Fzero (- dExp b) :>R); [ intros Eq0 | apply Rle_antisym; unfold FtoRradix, Fzero, FtoR in |- *; simpl in |- * ]; try rewrite Rmult_0_l; auto with real. apply trans_eq with (FtoRradix (Fzero (- dExp b))). apply sym_eq; unfold FtoRradix in |- *; apply (RoundedProjector _ ToZeroRoundedModeP); auto with float. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. unfold FtoRradix in |- *; apply (RoundedProjector _ ToZeroRoundedModeP); auto with float. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. cut (r = Fzero (- dExp b) :>R); [ intros Eq0 | apply Rle_antisym; unfold FtoRradix, Fzero, FtoR in |- *; simpl in |- * ]; try rewrite Rmult_0_l; auto with real. apply trans_eq with (FtoRradix (Fzero (- dExp b))). apply sym_eq; unfold FtoRradix in |- *; apply (RoundedProjector _ ToZeroRoundedModeP); auto with float. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. unfold FtoRradix in |- *; apply (RoundedProjector _ ToZeroRoundedModeP); auto with float. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. apply (MaxUniqueP r); auto. Qed. Theorem ToInfinityUniqueP : UniqueP ToInfinityP. red in |- *. intros r p q H' H'0. inversion H'; inversion H'0; elim H0; elim H; clear H0 H; intros H'1 H'2 H'3 H'4. apply (MinUniqueP r); auto. cut (r = Fzero (- dExp b) :>R); [ intros Eq0 | apply Rle_antisym; unfold FtoRradix, Fzero, FtoR in |- *; simpl in |- * ]; try rewrite Rmult_0_l; auto with real. apply trans_eq with (FtoRradix (Fzero (- dExp b))). apply sym_eq; unfold FtoRradix in |- *; apply (RoundedProjector _ ToInfinityRoundedModeP); auto. apply FboundedFzero; auto. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. unfold FtoRradix in |- *; apply (RoundedProjector _ ToInfinityRoundedModeP); auto. apply FboundedFzero; auto. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. cut (r = Fzero (- dExp b) :>R); [ intros Eq0 | apply Rle_antisym; unfold FtoRradix, Fzero, FtoR in |- *; simpl in |- * ]; try rewrite Rmult_0_l; auto with float. apply trans_eq with (FtoRradix (Fzero (- dExp b))). apply sym_eq; unfold FtoRradix in |- *; apply (RoundedProjector _ ToInfinityRoundedModeP); auto. apply FboundedFzero; auto. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. unfold FtoRradix in |- *; apply (RoundedProjector _ ToInfinityRoundedModeP); auto. apply FboundedFzero; auto. unfold FtoRradix in Eq0; rewrite <- Eq0; auto. apply (MaxUniqueP r); auto. Qed. Theorem MinOrMaxRep : forall P, MinOrMaxP P -> forall p q : float, P p q -> exists m : Z, q = Float m (Fexp p) :>R. intros P H' p q H'0; case (H' p q); auto; intros H'1. apply FminRep with (3 := pGivesBound); auto with arith. apply FmaxRep with (3 := pGivesBound); auto with arith. Qed. Theorem RoundedModeRep : forall P, RoundedModeP P -> forall p q : float, P p q -> exists m : Z, q = Float m (Fexp p) :>R. intros P H' p q H'0. apply MinOrMaxRep with (P := P); auto with inv. Qed. Definition SymmetricP (P : R -> float -> Prop) := forall (r : R) (p : float), P r p -> P (- r)%R (Fopp p). Theorem ToZeroSymmetric : SymmetricP ToZeroP. red in |- *; intros r p H'; case H'; clear H'; intros H'; case H'; intros H'1 H'2. right; split; auto. replace 0%R with (-0)%R; auto with real. apply MinOppMax; auto. left; split; auto. replace 0%R with (-0)%R; auto with real. apply MaxOppMin; auto. Qed. Theorem ToInfinitySymmetric : SymmetricP ToInfinityP. red in |- *; intros r p H'; case H'; clear H'; intros H'; case H'; intros H'1 H'2. right; split; auto. replace 0%R with (-0)%R; auto with real. apply MinOppMax; auto. left; split; auto. replace 0%R with (-0)%R; auto with real. apply MaxOppMin; auto. Qed. Theorem ScalableRoundedModeP : forall P (f s t : float), RoundedModeP P -> Fbounded b f -> P (radix * f)%R s -> P (s / radix)%R t -> f = t :>R. intros P f s t HP Ff H1 H2. cut (ProjectorP b radix P); [ unfold ProjectorP in |- *; intros HP2 | apply RoundedProjector; auto ]. cut (FtoR radix (Float (Fnum f) (Z.succ (Fexp f))) = (radix * FtoR radix f)%R); [ intros V | idtac]. 2: unfold FtoR, Z.succ in |- *; simpl in |- *; ring_simplify. 2: rewrite powerRZ_add; [ simpl in |- *; ring | auto with zarith real ]. unfold FtoRradix in |- *; apply HP2; auto. replace (FtoR radix f) with (FtoR radix s / radix)%R; auto. replace (FtoR radix s) with (radix * FtoR radix f)%R; [ unfold Rdiv in |- * | rewrite <- V ]. rewrite Rmult_comm; rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real zarith. apply HP2; auto with float. repeat (split; simpl in |- *; auto with zarith float). rewrite V; auto. Qed. Theorem RoundLessThanIsMax : forall P, RoundedModeP P -> forall (p m : float) (x : R), P x p -> isMax b radix x m -> (p <= m)%R. intros. elim H; intros. elim H3; intros H' H'0; clear H3. elim H'0; intros; clear H'0. case (H3 x p); auto. intros; apply Rle_trans with x; auto. elim H5; intros; elim H7; intros; auto with real. elim H1; intros; elim H7; intros; auto with real. intros; replace (FtoRradix p) with (FtoRradix m); auto with real. unfold FtoRradix in |- *; apply MaxEq with b x; auto. Qed. End FRound. Hint Resolve RoundedProjector MinCompatible MinRoundedModeP MaxCompatible MaxRoundedModeP ToZeroTotal ToZeroCompatible ToZeroMinOrMax ToZeroMonotone ToZeroRoundedModeP ToInfinityTotal ToInfinityCompatible ToInfinityMinOrMax ToInfinityMonotone ToInfinityRoundedModeP MinUniqueP MaxUniqueP ToZeroUniqueP ToInfinityUniqueP FnOddNEven ToZeroSymmetric ToInfinitySymmetric: float. Hint Resolve RoundedModeP_inv1 RoundedModeP_inv2 RoundedModeP_inv3 RoundedModeP_inv4: inv.float-8.10.0/FroundMult.v000066400000000000000000001007101357127175600152100ustar00rootroot00000000000000(**************************************************************************** IEEE754 : FroundMult Laurent Thery, Sylvie Boldo ******************************************************************************) Require Export FroundProp. Section FRoundP. Variable b : Fbound. Variable radix : Z. Variable precision : 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 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem errorBoundedMultMin : forall p q fmin : float, Fbounded b p -> Fbounded b q -> (0 <= p)%R -> (0 <= q)%R -> (- dExp b <= Fexp p + Fexp q)%Z -> isMin b radix (p * q) fmin -> exists r : float, r = (p * q - fmin)%R :>R /\ Fbounded b r /\ Fexp r = (Fexp p + Fexp q)%Z. intros p q fmin Fp Fq H' H'0 H'1 H'2. cut (0 <= Fnum p * Fnum q)%Z; [ intros multPos | apply Zle_mult_gen; apply (LeR0Fnum radix); auto with arith ]. cut (ex (fun m : Z => FtoRradix fmin = Float m (Fexp (Fmult p q)))). 2: unfold FtoRradix in |- *; apply RoundedModeRep with (b := b) (precision := precision) (P := isMin b radix); auto. 2: apply MinRoundedModeP with (precision := precision); auto. 2: rewrite (Fmult_correct radix); auto with zarith. intros H'3; elim H'3; intros m E; clear H'3. exists (Fminus radix (Fmult p q) (Float m (Fexp (Fmult p q)))). split. rewrite E; unfold FtoRradix in |- *; repeat rewrite Fminus_correct; repeat rewrite Fmult_correct; auto with zarith. split. cut (fmin <= Fmult p q)%R; [ idtac | unfold FtoRradix in |- *; rewrite Fmult_correct; auto; case H'2; auto with real zarith; (intros H1 H2; case H2; auto with zarith) ]. rewrite E; unfold Fmult, Fminus, Fopp, Fplus in |- *; simpl in |- *; auto. repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; auto. simpl in |- *; repeat rewrite Zpower_nat_O; repeat rewrite Zmult_1_r. unfold FtoRradix, FtoR in |- *; simpl in |- *. intros H'3; (cut (m <= Fnum p * Fnum q)%Z; [ idtac | apply le_IZR; apply Rmult_le_reg_l with (r := powerRZ radix (Fexp p + Fexp q)); auto with real zarith; repeat rewrite (Rmult_comm (powerRZ radix (Fexp p + Fexp q))); auto with zarith ]); intros H'4. repeat split; simpl in |- *; auto. case (ZquotientProp (Fnum p * Fnum q) (Zpower_nat radix precision)); auto with zarith. intros x (H'5, (H'6, H'7)). cut (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * powerRZ radix (precision + (Fexp p + Fexp q)) <= fmin)%R; [ rewrite E; intros H'8 | idtac ]. cut (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * powerRZ radix precision <= m)%R; [ intros H'9 | idtac ]. rewrite Z.abs_eq; auto with zarith. apply Z.le_lt_trans with x; auto. replace x with (Fnum p * Fnum q + - (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * Zpower_nat radix precision))%Z. apply Zplus_le_compat_l; auto. apply Zle_Zopp. apply le_IZR; auto. rewrite Rmult_IZR. rewrite Zpower_nat_Z_powerRZ; auto with zarith. pattern (Fnum p * Fnum q)%Z at 1 in |- *; rewrite H'5; ring. rewrite pGivesBound. rewrite <- (Z.abs_eq (Zpower_nat radix precision)); auto with zarith. apply Zlt_Zabs_inv2; auto. apply Rmult_le_reg_l with (r := powerRZ radix (Fexp p + Fexp q)); auto with real zarith. repeat rewrite (Rmult_comm (powerRZ radix (Fexp p + Fexp q))); auto. rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith. case (FboundedMbound _ radixMoreThanOne b precision) with (z := (precision + (Fexp p + Fexp q))%Z) (m := Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)); auto with zarith. apply Zmult_le_reg_r with (p := Zpower_nat radix precision); auto with zarith. apply Z.lt_gt; auto with zarith. pattern (Zpower_nat radix precision) at 2 in |- *; rewrite <- (fun x => Z.abs_eq (Zpower_nat radix x)). rewrite <- Zabs_Zmult. apply Z.le_trans with (1 := H'6); auto with zarith. rewrite Zabs_Zmult. apply Z.le_trans with (Zpower_nat radix precision * Z.abs (Fnum q))%Z. apply Zle_Zmult_comp_r; auto with zarith. apply Zlt_le_weak; rewrite <- pGivesBound; case Fp; auto with float. apply Zle_Zmult_comp_l; auto with zarith. apply Zlt_le_weak; rewrite <- pGivesBound; case Fq; auto with float. auto with zarith. intros x0 (H'8, H'9); rewrite <- H'9. case H'2. intros H'10 (H'11, H'12); apply H'12; auto. rewrite H'9; auto. rewrite powerRZ_add; auto with real zarith. rewrite <- Rmult_assoc. unfold FtoRradix in |- *; rewrite <- Fmult_correct; auto with zarith. unfold Fmult, FtoR in |- *; simpl in |- *. repeat rewrite (fun x => Rmult_comm x (powerRZ radix (Fexp p + Fexp q))). apply Rmult_le_compat_l; auto with real zarith. rewrite <- Zpower_nat_Z_powerRZ; auto with zarith. pattern (Fnum p * Fnum q)%Z at 2 in |- *; rewrite <- (Z.abs_eq (Fnum p * Fnum q)); auto. rewrite <- Rmult_IZR; apply Rle_IZR; apply Zle_Zabs_inv2; auto. simpl in |- *; auto. apply Zmin_n_n; auto. Qed. Theorem errorBoundedMultMax : forall p q fmax : float, Fbounded b p -> Fbounded b q -> (0 <= p)%R -> (0 <= q)%R -> (- dExp b <= Fexp p + Fexp q)%Z -> isMax b radix (p * q) fmax -> exists r : float, FtoRradix r = (p * q - fmax)%R /\ Fbounded b r /\ Fexp r = (Fexp p + Fexp q)%Z. intros p q fmax Fp Fq H' H'0 H'1 H'2. cut (0 <= Fnum p * Fnum q)%Z; [ intros multPos | apply Zle_mult_gen; apply (LeR0Fnum radix); auto with arith ]. case (ZquotientProp (Fnum p * Fnum q) (Zpower_nat radix precision)); auto with zarith. intros r; intros (H'3, (H'4, H'5)). cut (0 <= Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision))%Z; [ intros Z2 | apply ZquotientPos; auto with zarith ]. cut (0 <= r)%Z; [ intros Z3 | replace r with (Fnum p * Fnum q - Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * Zpower_nat radix precision)%Z; [ idtac | pattern (Fnum p * Fnum q)%Z at 1 in |- *; rewrite H'3; ring ]; auto ]. 2: apply Zle_Zminus_ZERO; rewrite Z.abs_eq in H'4; auto with zarith; rewrite Z.abs_eq in H'4; auto with zarith. case (Z.eq_dec r 0); intros Z4. exists (Fzero (Fexp p + Fexp q)); repeat (split; auto with float). replace (FtoRradix (Fzero (Fexp p + Fexp q))) with 0%R; [ idtac | unfold Fzero, FtoRradix, FtoR in |- *; simpl in |- *; ring ]. apply Rplus_eq_reg_l with (r := FtoRradix fmax). replace (fmax + 0)%R with (FtoRradix fmax); [ idtac | ring ]. replace (fmax + (p * q - fmax))%R with (p * q)%R; [ idtac | ring ]. unfold FtoRradix in |- *; rewrite <- (Fmult_correct radix); auto with zarith. case (FboundedMbound _ radixMoreThanOne b precision) with (z := (precision + (Fexp p + Fexp q))%Z) (m := Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)); auto with zarith. apply Zmult_le_reg_r with (p := Zpower_nat radix precision); auto with zarith. apply Z.lt_gt; auto with zarith. pattern (Zpower_nat radix precision) at 2 in |- *; rewrite <- (fun x => Z.abs_eq (Zpower_nat radix x)). rewrite <- Zabs_Zmult. apply Z.le_trans with (1 := H'4); auto with zarith. rewrite Zabs_Zmult. apply Z.le_trans with (Zpower_nat radix precision * Z.abs (Fnum q))%Z. apply Zle_Zmult_comp_r; auto with zarith. apply Zlt_le_weak; rewrite <- pGivesBound; case Fp; auto with float. apply Zle_Zmult_comp_l; auto with zarith. apply Zlt_le_weak; rewrite <- pGivesBound; case Fq; auto with float. auto with zarith. intros x (H'6, H'7). cut (FtoR radix (Fmult p q) = FtoR radix x). intros H'8; rewrite H'8. apply sym_eq; apply (ProjectMax b radix); auto. rewrite <- H'8; auto. rewrite Fmult_correct; auto with zarith. rewrite H'7. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_add with (n := Z_of_nat precision); auto with real zarith. pattern (Fnum p * Fnum q)%Z at 1 in |- *; rewrite H'3. rewrite plus_IZR; rewrite Rmult_IZR. repeat rewrite Zpower_nat_Z_powerRZ; auto with real zarith. rewrite Z4; simpl;ring. cut (ex (fun m : Z => FtoRradix fmax = Float m (Fexp (Fmult p q)))); [ intros Z5 | idtac ]. 2: unfold FtoRradix in |- *; apply RoundedModeRep with (b := b) (precision := precision) (P := isMax b radix); auto. 2: apply MaxRoundedModeP with (precision := precision); auto. 2: rewrite (Fmult_correct radix); auto with zarith. elim Z5; intros m E; clear Z5. exists (Fopp (Fminus radix (Float m (Fexp (Fmult p q))) (Fmult p q))). split. rewrite E; unfold FtoRradix in |- *; repeat rewrite Fopp_correct; repeat rewrite Fminus_correct; repeat rewrite Fmult_correct; auto with zarith; ring. cut (Fexp (Fopp (Fminus radix (Float m (Fexp (Fmult p q))) (Fmult p q))) = (Fexp p + Fexp q)%Z); [ intros Z5 | idtac ]. split; auto. split; [ idtac | rewrite Z5; auto ]. cut (Fmult p q <= fmax)%R; [ idtac | unfold FtoRradix in |- *; rewrite Fmult_correct; auto; case H'2; auto with real zarith; (intros H1 H2; case H2; auto) ]. cut (fmax <= Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)) * powerRZ radix (precision + (Fexp p + Fexp q)))%R. rewrite E; repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; repeat rewrite Zpower_nat_O; repeat rewrite Zmult_1_r; auto. unfold Fmult, Fminus, Fplus, Fopp in |- *; simpl in |- *. repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; repeat rewrite Zpower_nat_O; repeat rewrite Zmult_1_r; auto. intros H1 H2; rewrite Zabs_Zopp; apply Zlt_Zabs_intro. apply Z.lt_le_trans with 0%Z; auto with zarith. cut (Fnum p * Fnum q <= m)%Z; auto with zarith. apply le_IZR; apply (Rle_monotony_contra_exp radix) with (z := (Fexp p + Fexp q)%Z); auto with zarith. cut (m <= Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)) * Zpower_nat radix precision)%Z; [ intros H'9 | idtac ]. apply Z.le_lt_trans with (Zpower_nat radix precision - r)%Z; [ idtac | rewrite pGivesBound; auto with zarith ]. replace r with (Fnum p * Fnum q - Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * Zpower_nat radix precision)%Z. replace (Zpower_nat radix precision - (Fnum p * Fnum q - Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * Zpower_nat radix precision))%Z with (Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)) * Zpower_nat radix precision - Fnum p * Fnum q)%Z; auto with zarith. unfold Z.succ in |- *; simpl in |- *; ring. pattern (Fnum p * Fnum q)%Z at 1 in |- *; rewrite H'3; ring. apply le_IZR; apply (Rle_monotony_contra_exp radix) with (z := (Fexp p + Fexp q)%Z); auto with zarith. replace (IZR (Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)) * Zpower_nat radix precision) * powerRZ radix (Fexp p + Fexp q))%R with (Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)) * powerRZ radix (precision + (Fexp p + Fexp q)))%R; [ auto | idtac ]. rewrite powerRZ_add; auto with real zarith. repeat rewrite Rmult_IZR; repeat rewrite Zpower_nat_Z_powerRZ; auto with zarith. ring. case (FboundedMbound _ radixMoreThanOne b precision) with (z := (precision + (Fexp p + Fexp q))%Z) (m := Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision))); auto with arith. rewrite Z.abs_eq; auto with zarith. apply Zlt_le_succ. case (Zle_lt_or_eq _ _ multPos); intros Eq1. cut (0 < Z.abs (Fnum p))%Z; [ intros Eq2 | idtac ]. cut (0 < Z.abs (Fnum q))%Z; [ intros Eq3 | idtac ]. apply Zlt_mult_simpl_l with (c := Zpower_nat radix precision); auto with zarith. rewrite (fun x y z => Zmult_comm x (Zquotient y z)). apply Z.le_lt_trans with (Fnum p * Fnum q)%Z. rewrite Z.abs_eq in H'4; auto with zarith; rewrite Z.abs_eq in H'4; auto with zarith. rewrite <- (Z.abs_eq (Fnum p * Fnum q)); auto with zarith; rewrite Zabs_Zmult. apply Z.lt_trans with (Z.abs (Fnum p) * Zpower_nat radix precision)%Z. cut (Z.abs (Fnum q) < Zpower_nat radix precision)%Z; [ intros Eq4; apply Zmult_gt_0_lt_compat_l | rewrite <- pGivesBound; case Fq ]; auto with zarith. cut (Z.abs (Fnum p) < Zpower_nat radix precision)%Z; [ intros Eq4; apply Zmult_gt_0_lt_compat_r | rewrite <- pGivesBound; case Fp ]; auto with zarith. case (Zle_lt_or_eq _ _ (Zle_ZERO_Zabs (Fnum q))); auto. intros Eq3; Contradict Eq1; replace (Fnum q) with 0%Z; auto with zarith. generalize Eq3; case (Fnum q); simpl in |- *; auto; intros; discriminate. case (Zle_lt_or_eq _ _ (Zle_ZERO_Zabs (Fnum p))); auto. intros Eq3; Contradict Eq1; replace (Fnum p) with 0%Z; auto with zarith. generalize Eq3; case (Fnum p); simpl in |- *; auto; intros; discriminate. rewrite <- Eq1; replace (Zquotient 0 (Zpower_nat radix precision)) with 0%Z; auto with zarith. apply Z.le_trans with (1 := H'1); auto with zarith. intros f1 (Hf1, Hf2); rewrite <- Hf2. case H'2; intros L1 (L2, L3); apply L3; auto. rewrite Hf2; unfold Fmult, FtoRradix, FtoR in |- *. replace (Fnum p * powerRZ radix (Fexp p) * (Fnum q * powerRZ radix (Fexp q)))%R with (Fnum p * Fnum q * powerRZ radix (Fexp p + Fexp q))%R. replace (Z.succ (Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision)) * powerRZ radix (precision + (Fexp p + Fexp q)))%R with ((Zquotient (Fnum p * Fnum q) (Zpower_nat radix precision) * Zpower_nat radix precision + Zpower_nat radix precision)%Z * powerRZ radix (Fexp p + Fexp q))%R. apply Rle_monotone_exp; auto with real zarith. rewrite <- Rmult_IZR; apply Rle_IZR. pattern (Fnum p * Fnum q)%Z at 1 in |- *; rewrite H'3; cut (r < Zpower_nat radix precision)%Z; auto with zarith. rewrite Z.abs_eq in H'5; auto with zarith; rewrite Z.abs_eq in H'5; auto with zarith. unfold Z.succ in |- *; repeat rewrite Rmult_IZR || rewrite plus_IZR; simpl in |- *. rewrite (powerRZ_add radix precision); auto with real zarith; rewrite <- (Zpower_nat_Z_powerRZ radix precision); auto with real zarith; ring. rewrite powerRZ_add; auto with real zarith; ring. unfold Fopp, Fminus, Fmult in |- *; simpl in |- *; auto. apply Zmin_n_n. Qed. Theorem multExpMin : forall P, RoundedModeP b radix P -> forall p q pq : float, P (p * q)%R pq -> exists s : float, Fbounded b s /\ s = pq :>R /\ (Fexp p + Fexp q <= Fexp s)%Z. intros P H' p q pq H'0. case (RoundedModeRep b radix precision) with (p := Fmult p q) (q := pq) (P := P); auto with zarith. rewrite Fmult_correct; auto with zarith. simpl in |- *; intros x H'1. case (eqExpLess _ radixMoreThanOne b) with (p := pq) (q := Float x (Fexp (Fmult p q))); auto. apply RoundedModeBounded with (radix := radix) (P := P) (r := (p * q)%R); auto. simpl in |- *; intros x0 H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6; clear H'4 H'2. exists x0; split; [ idtac | split ]; auto. unfold FtoRradix in |- *; rewrite H'5; auto. apply le_IZR; auto. Qed. Theorem multExpUpperBound : forall P, RoundedModeP b radix P -> forall p q pq : float, P (p * q)%R pq -> Fbounded b p -> Fbounded b q -> (- dExp b <= Fexp p + Fexp q)%Z -> exists r : float, Fbounded b r /\ r = pq :>R /\ (Fexp r <= precision + (Fexp p + Fexp q))%Z. intros P H' p q pq H'0 H'1 H'2 H'3. replace (precision + (Fexp p + Fexp q))%Z with (Fexp (Float (pPred (vNum b)) (precision + (Fexp p + Fexp q)))); [ idtac | simpl in |- *; auto ]. unfold FtoRradix in |- *; apply eqExpMax; auto. apply RoundedModeBounded with (radix := radix) (P := P) (r := (p * q)%R); auto; auto. unfold pPred in |- *; apply maxFbounded; auto. apply Z.le_trans with (1 := H'3); auto with zarith. replace (FtoR radix (Float (pPred (vNum b)) (precision + (Fexp p + Fexp q)))) with (radix * Float (pPred (vNum b)) (pred precision + (Fexp p + Fexp q)))%R. rewrite Fabs_correct; auto with zarith. unfold FtoRradix in |- *; apply RoundedModeMultAbs with (b := b) (precision := precision) (P := P) (r := (p * q)%R); auto. unfold pPred in |- *; apply maxFbounded; auto with zarith. rewrite Rabs_mult; auto. apply Rle_trans with (FtoR radix (Fmult (Float (pPred (vNum b)) (Fexp p)) (Float (pPred (vNum b)) (Fexp q)))). rewrite Fmult_correct; auto with arith. apply Rmult_le_compat; auto with real. rewrite <- (Fabs_correct radix); try apply maxMax1; auto with zarith. rewrite <- (Fabs_correct radix); try apply maxMax1; auto with zarith. unfold Fmult, FtoR in |- *; simpl in |- *; auto. rewrite powerRZ_add with (n := Z_of_nat (pred precision)); auto with real arith. repeat rewrite <- Rmult_assoc. repeat rewrite (fun (z : Z) (x : R) => Rmult_comm x (powerRZ radix z)); auto. apply Rmult_le_compat_l; auto with real arith. rewrite <- Rmult_assoc. rewrite (fun x : R => Rmult_comm x radix). rewrite <- powerRZ_Zs; auto with real arith. replace (Z.succ (pred precision)) with (Z_of_nat precision). rewrite Rmult_IZR; auto. apply Rmult_le_compat; auto with real arith. replace 0%R with (IZR 0); unfold pPred in |- *; try apply Rle_IZR; auto with real zarith. replace 0%R with (IZR 0); unfold pPred in |- *; try apply Rle_IZR; auto with real zarith. unfold pPred in |- *; rewrite pGivesBound; rewrite <- Zpower_nat_Z_powerRZ; auto with real zarith. rewrite inj_pred; auto with arith zarith. auto with real zarith. auto with real zarith. unfold FtoRradix, FtoR in |- *; simpl in |- *. repeat rewrite (Rmult_comm (pPred (vNum b))). rewrite <- Rmult_assoc. rewrite <- powerRZ_Zs; auto with real zarith. rewrite inj_pred; auto with arith zarith. replace (Z.succ (Z.pred precision + (Fexp p + Fexp q))) with (precision + (Fexp p + Fexp q))%Z; auto; unfold Z.succ, Z.pred in |- *; ring. Qed. Theorem errorBoundedMultPos : forall P, RoundedModeP b radix P -> forall p q f : float, Fbounded b p -> Fbounded b q -> (0 <= p)%R -> (0 <= q)%R -> (- dExp b <= Fexp p + Fexp q)%Z -> P (p * q)%R f -> exists r : float, r = (p * q - f)%R :>R /\ Fbounded b r /\ Fexp r = (Fexp p + Fexp q)%Z. intros P H p q f H0 H1 H2 H3 H4 H5. generalize errorBoundedMultMin errorBoundedMultMax; intros H6 H7. cut (MinOrMaxP b radix P); [ intros | case H; intros H'1 (H'2, (H'3, H'4)); auto ]. case (H8 (p * q)%R f); auto. Qed. Theorem errorBoundedMultNeg : forall P, RoundedModeP b radix P -> forall p q f : float, Fbounded b p -> Fbounded b q -> (p <= 0)%R -> (0 <= q)%R -> (- dExp b <= Fexp p + Fexp q)%Z -> P (p * q)%R f -> exists r : float, r = (p * q - f)%R :>R /\ Fbounded b r /\ Fexp r = (Fexp p + Fexp q)%Z. intros P H p q f H0 H1 H2 H3 H4 H5. generalize errorBoundedMultMin errorBoundedMultMax; intros H6 H7. cut (MinOrMaxP b radix P); [ intros | case H; intros H'1 (H'2, (H'3, H'4)); auto ]. case (H8 (p * q)%R f); auto; intros H9. generalize (H7 (Fopp p) q (Fopp f)); intros H12. lapply H12; auto with float; intros H10; clear H12. lapply H10; auto; intros H12; clear H10. lapply H12; [ intros H10 | unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real ]; clear H12. lapply H10; auto; intros H12; clear H10. lapply H12; [ intros H10 | simpl in |- *; auto ]; clear H12. lapply H10; [ intros H12 | idtac ]; clear H10. 2: replace (Fopp p * q)%R with (- (p * q))%R; [ apply MinOppMax; auto | idtac ]. 2: unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. elim H12; intros r H10; clear H12; elim H10; intros H11 H12; clear H10. elim H12; clear H12; intros H10 H12. exists (Fopp r); split; [ generalize H11 | split; auto with float ]. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; intros H13; rewrite H13; ring. generalize (H6 (Fopp p) q (Fopp f)); intros H12. lapply H12; auto with float; intros H10; clear H12. lapply H10; auto; intros H12; clear H10. lapply H12; [ intros H10 | unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real ]; clear H12. lapply H10; auto; intros H12; clear H10. lapply H12; [ intros H10 | simpl in |- *; auto ]; clear H12. lapply H10; [ intros H12 | idtac ]; clear H10. 2: replace (Fopp p * q)%R with (- (p * q))%R; [ apply MaxOppMin; auto | idtac ]. 2: unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. elim H12; intros r H10; clear H12; elim H10; intros H11 H12; clear H10. elim H12; clear H12; intros H10 H12. exists (Fopp r); split; [ generalize H11 | split; auto with float ]. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; intros H13; rewrite H13; ring. Qed. Theorem errorBoundedMult : forall P, RoundedModeP b radix P -> forall p q f : float, Fbounded b p -> Fbounded b q -> (- dExp b <= Fexp p + Fexp q)%Z -> P (p * q)%R f -> exists r : float, r = (p * q - f)%R :>R /\ Fbounded b r /\ Fexp r = (Fexp p + Fexp q)%Z. intros P H p q f H0 H1 H2 H3. case (Rle_or_lt 0 p); intros H4; case (Rle_or_lt 0 q); intros H5. apply errorBoundedMultPos with P; auto. replace (Fexp p) with (Fexp (Fopp p)); auto with float. replace (Fexp q) with (Fexp (Fopp q)); auto with float. cut ((p * q)%R = (Fopp p * Fopp q)%R); [ intros H6; rewrite H6 | idtac ]. apply errorBoundedMultNeg with P; auto with float real. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. rewrite <- H6; auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; ring. apply errorBoundedMultNeg with P; auto with float real. replace (Fexp p) with (Fexp (Fopp p)); auto with float. replace (Fexp q) with (Fexp (Fopp q)); auto with float. cut ((p * q)%R = (Fopp p * Fopp q)%R); [ intros H6; rewrite H6 | idtac ]. apply errorBoundedMultPos with P; auto with float real. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. rewrite <- H6; auto. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; ring. Qed. Theorem errorBoundedMultExp_aux : forall n1 n2 : Z, (Z.abs n1 < Zpos (vNum b))%Z -> (Z.abs n2 < Zpos (vNum b))%Z -> (exists ny : Z, (exists ey : Z, (n1 * n2)%R = (ny * powerRZ radix ey)%R :>R /\ (Z.abs ny < Zpos (vNum b))%Z)) -> exists nx : Z, (exists ex : Z, (n1 * n2)%R = (nx * powerRZ radix ex)%R :>R /\ (Z.abs nx < Zpos (vNum b))%Z /\ (0 <= ex)%Z /\ (ex <= precision)%Z). intros n1 n2 H H0 H1. case H1; intros ny (ey, (H2, H3)). case (Zle_or_lt 0 ey); intros Zl1. case (Zle_or_lt ey precision); intros Zl2. exists ny; exists ey; repeat (split; auto). exists (ny * Zpower_nat radix (Z.abs_nat (ey - precision)))%Z; exists (Z_of_nat precision); repeat (split; auto with zarith). replace (IZR (ny * Zpower_nat radix (Z.abs_nat (ey - precision)))) with (ny * powerRZ radix (ey - precision))%R. rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with zarith real. replace (ey - precision + precision)%Z with ey; [ auto | ring ]. rewrite Rmult_IZR. rewrite Zpower_nat_powerRZ_absolu; auto with real zarith. rewrite Zabs_Zmult. apply lt_IZR; apply Rmult_lt_reg_l with (r := powerRZ radix precision); auto with real zarith. repeat rewrite (fun x y => Rmult_comm (powerRZ x y)). rewrite Rmult_IZR. rewrite Rmult_assoc. rewrite (Z.abs_eq (Zpower_nat radix (Z.abs_nat (ey - precision)))); auto with zarith. rewrite Zpower_nat_powerRZ_absolu; auto with real zarith. rewrite <- powerRZ_add; auto with real zarith. replace (ey - precision + precision)%Z with ey; [ idtac | ring ]. replace (powerRZ radix precision) with (IZR (Zpos (vNum b))); [ idtac | rewrite pGivesBound; rewrite <- Zpower_nat_powerRZ_absolu; try rewrite absolu_INR; auto with zarith ]. rewrite <- (fun x y => Rabs_pos_eq (powerRZ x y)); auto with real zarith. rewrite <- Faux.Rabsolu_Zabs; rewrite <- Rabs_mult; rewrite <- H2. rewrite Rabs_mult; repeat rewrite Faux.Rabsolu_Zabs; auto with real zarith. case (Zle_lt_or_eq 0 (Z.abs n2)); auto with zarith; intros Z1. apply Rlt_trans with (Zpos (vNum b) * Z.abs n2)%R; auto with real zarith. rewrite <- Z1; auto with real zarith. replace (Z.abs n1 * 0%Z)%R with (0 * Zpos (vNum b))%R; [ auto with real zarith | simpl; ring ]. exists (n1 * n2)%Z; exists 0%Z; repeat (split; auto with zarith). rewrite Rmult_IZR; rewrite powerRZ_O; ring. apply lt_IZR. rewrite <- Faux.Rabsolu_Zabs; rewrite Rmult_IZR; rewrite H2. rewrite Rabs_mult. apply Rle_lt_trans with (Rabs ny). pattern (Rabs ny) at 2 in |- *; replace (Rabs ny) with (Rabs ny * 1)%R; [ apply Rmult_le_compat_l | ring ]; auto with arith real. rewrite (Rabs_pos_eq (powerRZ radix ey)); [ idtac | apply powerRZ_le; auto with arith real ]. replace 1%R with (powerRZ radix 0); [ apply Rle_powerRZ | simpl in |- * ]; auto with real arith zarith. rewrite Faux.Rabsolu_Zabs; auto with real zarith. Qed. Theorem errorBoundedMultExpPos : forall P, RoundedModeP b radix P -> forall p q pq : float, Fbounded b p -> Fbounded b q -> (0 <= p)%R -> (0 <= q)%R -> P (p * q)%R pq -> (- dExp b <= Fexp p + Fexp q)%Z -> ex (fun r : float => ex (fun s : float => Fbounded b r /\ Fbounded b s /\ r = pq :>R /\ s = (p * q - r)%R :>R /\ Fexp s = (Fexp p + Fexp q)%Z :>Z /\ (Fexp s <= Fexp r)%Z /\ (Fexp r <= precision + (Fexp p + Fexp q))%Z)). intros P H p q pq H0 H1 H2 H3 H4 H5. case (multExpUpperBound P H p q pq); auto; intros r (H'1, (H'2, H'3)). case (Req_dec (p * q - pq) 0); intros H6. case (Req_dec pq 0); intros H7. cut (Fbounded b (Fzero (Fexp p + Fexp q))); [ intros Fb1 | idtac ]. exists (Fzero (Fexp p + Fexp q)); exists (Fzero (Fexp p + Fexp q)); repeat (split; simpl in |- *; auto with zarith). rewrite H7; unfold FtoRradix in |- *; apply FzeroisReallyZero. unfold FtoRradix in |- *; rewrite FzeroisReallyZero; rewrite <- H7. pattern (FtoRradix pq) at 1 in |- *; rewrite H7; auto with real. repeat (split; auto); simpl in |- *; auto with arith zarith. case (errorBoundedMultExp_aux (Fnum p) (Fnum q)); auto with float real zarith. exists (Fnum pq); exists (Fexp pq - (Fexp p + Fexp q))%Z; split. apply Rmult_eq_reg_l with (powerRZ radix (Fexp p + Fexp q)); auto with real zarith. repeat rewrite (fun x y => Rmult_comm (powerRZ x y)). apply trans_eq with (p * q)%R; auto. rewrite <- (Fmult_correct radix); auto with real zarith; unfold FtoRradix, FtoR, Fmult in |- *; simpl in |- *; rewrite Rmult_IZR; auto. apply trans_eq with (FtoRradix pq); auto with real. rewrite Rmult_assoc; rewrite <- powerRZ_add; auto with real zarith. replace (Fexp pq - (Fexp p + Fexp q) + (Fexp p + Fexp q))%Z with (Fexp pq); auto; ring. cut (Fbounded b pq); [ intros Z1; case Z1 | idtac ]; auto with real zarith. apply (RoundedModeBounded b radix P (p * q)); auto. intros nx (ex, (H'4, (H'5, (H'6, H'7)))). cut (FtoRradix pq = FtoRradix (Float nx (ex + (Fexp p + Fexp q))) :>R); [ intros Eq1 | idtac ]. exists (Float nx (ex + (Fexp p + Fexp q))); exists (Fzero (Fexp p + Fexp q)); repeat (split; simpl in |- *; auto with real zarith). rewrite <- Eq1; rewrite H6; apply (FzeroisReallyZero radix). replace (FtoRradix pq) with (p * q)%R. unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *. rewrite powerRZ_add; auto with zarith real. repeat rewrite <- Rmult_assoc; rewrite <- H'4; rewrite powerRZ_add; [ ring | auto with zarith real ]. replace (FtoRradix p * FtoRradix q)%R with (pq + (FtoRradix p * FtoRradix q - FtoRradix pq))%R; [ rewrite H6 | idtac ]; ring. case (errorBoundedMultPos P H p q pq); auto. intros s (H'4, (H'5, H'6)). exists r; exists s; repeat (split; auto with zarith). rewrite H'2; auto. apply Zlt_le_weak; apply RoundedModeErrorExpStrict with b radix precision P (p * q)%R; auto. cut (CompatibleP b radix P); [ intros H'7 | case H; try intros H'7 (H'8, (H'9, H'10)); auto ]. apply H'7 with (p * q)%R pq; auto with real. fold FtoRradix in |- *; rewrite H'2; auto with real. fold FtoRradix in |- *; rewrite H'4; auto with real. Qed. Theorem errorBoundedMultExp : forall P, (RoundedModeP b radix P) -> forall p q pq : float, (Fbounded b p) -> (Fbounded b q) -> (P (p * q)%R pq) -> (-(dExp b) <= Fexp p + Fexp q)%Z -> exists r : float, exists s : float, (Fbounded b r) /\ (Fbounded b s) /\ r = pq :>R /\ s = (p * q - r)%R :>R /\ (Fexp s = Fexp p + Fexp q)%Z /\ (Fexp s <= Fexp r)%Z /\ (Fexp r <= precision + (Fexp p + Fexp q))%Z. intros P H p q pq H1 H2 H3 H4. cut (MinOrMaxP b radix P); [ intros | case H; intros H'1 (H'2, (H'3, H'4)); auto ]. case H0 with (p*q)%R pq; auto; intros H0'; clear H0. case (Rle_or_lt 0 p); intros Rl1. case (Rle_or_lt 0 q); intros Rl2. apply (errorBoundedMultExpPos P); auto. case errorBoundedMultExpPos with (isMax b radix) p (Fopp q) (Fopp pq); auto with float real. apply MaxRoundedModeP with precision; auto. rewrite (Fopp_correct radix); auto with real. replace (FtoRradix p * FtoRradix (Fopp q))%R with (- (FtoRradix p * FtoRradix q))%R; [apply MinOppMax;auto|idtac]. rewrite (Fopp_correct radix); fold FtoRradix in |- *; auto with zarith; ring. intros r (s, (H5, (H6, (H7, (H8, H9))))); exists (Fopp r); exists (Fopp s); repeat (split; simpl in |- *; auto with float real zarith). repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H7; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H8; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. case (Rle_or_lt 0 q); intros Rl2. case errorBoundedMultExpPos with (isMax b radix) (Fopp p) q (Fopp pq); auto with float real. apply MaxRoundedModeP with precision; auto. rewrite (Fopp_correct radix); auto with real. replace (FtoRradix (Fopp p) * FtoRradix q)%R with (- (FtoRradix p * FtoRradix q))%R; [apply MinOppMax;auto|idtac]. rewrite (Fopp_correct radix); fold FtoRradix in |- *; auto with zarith; ring. intros r (s, (H5, (H6, (H7, (H8, H9))))); exists (Fopp r); exists (Fopp s); repeat (split; simpl in |- *; auto with float real zarith). repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H7; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H8; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix;ring. case (errorBoundedMultExpPos P H (Fopp p) (Fopp q) pq); auto with float real. rewrite (Fopp_correct radix); auto with real. rewrite (Fopp_correct radix); auto with real. replace (FtoRradix (Fopp p) * FtoRradix (Fopp q))%R with (FtoRradix p * FtoRradix q)%R; auto; repeat rewrite (Fopp_correct radix); fold FtoRradix in |- *; auto with zarith; ring. intros r (s, (H5, (H6, (H7, (H8, (H9, (H10, H11))))))); exists r; exists s; repeat (split; simpl in |- *; auto with float real zarith). fold FtoRradix in |- *; rewrite H8; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. case (Rle_or_lt 0 p); intros Rl1. case (Rle_or_lt 0 q); intros Rl2. apply (errorBoundedMultExpPos P); auto. case errorBoundedMultExpPos with (isMin b radix) p (Fopp q) (Fopp pq); auto with float real. apply MinRoundedModeP with precision; auto. rewrite (Fopp_correct radix); auto with real. replace (FtoRradix p * FtoRradix (Fopp q))%R with (- (FtoRradix p * FtoRradix q))%R; [apply MaxOppMin;auto|idtac]. rewrite (Fopp_correct radix); fold FtoRradix in |- *; auto with zarith; ring. intros r (s, (H5, (H6, (H7, (H8, H9))))); exists (Fopp r); exists (Fopp s); repeat (split; simpl in |- *; auto with float real zarith). repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H7; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H8; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. case (Rle_or_lt 0 q); intros Rl2. case errorBoundedMultExpPos with (isMin b radix) (Fopp p) q (Fopp pq); auto with float real. apply MinRoundedModeP with precision; auto. rewrite (Fopp_correct radix); auto with real. replace (FtoRradix (Fopp p) * FtoRradix q)%R with (- (FtoRradix p * FtoRradix q))%R; [apply MaxOppMin;auto|idtac]. rewrite (Fopp_correct radix); fold FtoRradix in |- *; auto with zarith; ring. intros r (s, (H5, (H6, (H7, (H8, H9))))); exists (Fopp r); exists (Fopp s); repeat (split; simpl in |- *; auto with float real zarith). repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H7; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix in |- *; rewrite H8; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix;ring. case (errorBoundedMultExpPos P H (Fopp p) (Fopp q) pq); auto with float real. rewrite (Fopp_correct radix); auto with real. rewrite (Fopp_correct radix); auto with real. replace (FtoRradix (Fopp p) * FtoRradix (Fopp q))%R with (FtoRradix p * FtoRradix q)%R; auto; repeat rewrite (Fopp_correct radix); fold FtoRradix in |- *; auto with zarith; ring. intros r (s, (H5, (H6, (H7, (H8, (H9, (H10, H11))))))); exists r; exists s; repeat (split; simpl in |- *; auto with float real zarith). fold FtoRradix in |- *; rewrite H8; repeat rewrite (Fopp_correct radix); auto with zarith; fold FtoRradix; ring. Qed. End FRoundP. float-8.10.0/FroundPlus.v000066400000000000000000000610711357127175600152200ustar00rootroot00000000000000(**************************************************************************** IEEE754 : FroundPlus Laurent Thery ******************************************************************************) Require Export Finduct. Require Export FroundProp. Section FRoundP. Variable b : Fbound. Variable radix : Z. Variable precision : 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 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem plusExpMin : forall P, RoundedModeP b radix P -> forall p q pq : float, P (p + q)%R pq -> exists s : float, Fbounded b s /\ s = pq :>R /\ (Z.min (Fexp p) (Fexp q) <= Fexp s)%Z. intros P H' p q pq H'0. case (RoundedModeRep b radix precision) with (p := Fplus radix p q) (q := pq) (P := P); auto with float arith. rewrite Fplus_correct; auto with float arith. simpl in |- *; intros x H'1. case (eqExpLess _ radixMoreThanOne b) with (p := pq) (q := Float x (Fexp (Fplus radix p q))); auto. apply (RoundedModeBounded b radix) with (P := P) (r := (p + q)%R); auto. simpl in |- *; intros x0 H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6; clear H'4 H'2. exists x0; split; [ idtac | split ]; auto. unfold FtoRradix in |- *; rewrite H'5; auto. apply le_IZR; auto. Qed. Theorem plusExpUpperBound : forall P, RoundedModeP b radix P -> forall p q pq : float, P (p + q)%R pq -> Fbounded b p -> Fbounded b q -> exists r : float, Fbounded b r /\ r = pq :>R /\ (Fexp r <= Z.succ (Zmax (Fexp p) (Fexp q)))%Z. intros P H' p q pq H'0 H'1 H'2. replace (Z.succ (Zmax (Fexp p) (Fexp q))) with (Fexp (Float (pPred (vNum b)) (Z.succ (Zmax (Fexp p) (Fexp q))))); [ idtac | simpl in |- *; auto ]. unfold FtoRradix in |- *; apply eqExpMax; auto. apply RoundedModeBounded with (radix := radix) (P := P) (r := (p + q)%R); auto with float arith. unfold pPred in |- *; apply maxFbounded; auto. apply Z.le_trans with (Fexp p); auto with float. apply Z.le_trans with (Z.succ (Fexp p)); auto with float zarith. replace (FtoR radix (Float (pPred (vNum b)) (Z.succ (Zmax (Fexp p) (Fexp q))))) with (radix * Float (pPred (vNum b)) (Zmax (Fexp p) (Fexp q)))%R. rewrite Fabs_correct; auto with zarith. unfold FtoRradix in |- *; apply RoundedModeMultAbs with (b := b) (precision := precision) (P := P) (r := (p + q)%R); auto. unfold pPred in |- *; apply maxFbounded; auto. apply Z.le_trans with (Fexp p); auto with float zarith. apply Rle_trans with (Rabs p + Rabs q)%R. apply Rabs_triang; auto. apply Rle_trans with (2%nat * FtoR radix (Float (pPred (vNum b)) (Zmax (Fexp p) (Fexp q))))%R; auto. cut (forall r : R, (2%nat * r)%R = (r + r)%R); [ intros tmp; rewrite tmp; clear tmp | intros; simpl in |- *; ring ]. apply Rplus_le_compat; auto. rewrite <- (Fabs_correct radix); auto with arith; apply maxMax1; auto; apply ZmaxLe1. rewrite <- (Fabs_correct radix); auto with arith; apply maxMax1; auto; apply ZmaxLe2. apply Rmult_le_compat; auto with real arith. replace 0%R with (INR 0); auto with real arith. apply LeFnumZERO; simpl in |- *; auto; replace 0%Z with (Z_of_nat 0); auto with zarith. unfold pPred in |- *; apply Zle_Zpred; auto with zarith. rewrite INR_IZR_INZ; apply Rle_IZR; simpl in |- *; auto with zarith. cut (1 < radix)%Z; auto with zarith;intros. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; ring. Qed. Theorem plusExpBound : forall P, RoundedModeP b radix P -> forall p q pq : float, P (p + q)%R pq -> Fbounded b p -> Fbounded b q -> exists r : float, Fbounded b r /\ r = pq :>R /\ (Z.min (Fexp p) (Fexp q) <= Fexp r)%Z /\ (Fexp r <= Z.succ (Zmax (Fexp p) (Fexp q)))%Z. intros P H' p q pq H'0 H'1 H'2. case (plusExpMin P H' _ _ _ H'0). intros r' H'3; elim H'3; intros H'4 H'5; elim H'5; intros H'6 H'7; clear H'5 H'3. case (Zle_or_lt (Fexp r') (Z.succ (Zmax (Fexp p) (Fexp q)))); intros Zl1. exists r'; repeat (split; auto). case (plusExpUpperBound P H' _ _ _ H'0); auto. intros r'' H'3; elim H'3; intros H'5 H'8; elim H'8; intros H'9 H'10; clear H'8 H'3. exists (Fshift radix (Z.abs_nat (Fexp r' - Z.succ (Zmax (Fexp p) (Fexp q)))) r'); split. apply FboundedShiftLess with (n := Z.abs_nat (Fexp r' - Fexp r'')); auto. apply ZleLe; auto. repeat rewrite <- Zabs_absolu. repeat rewrite Z.abs_eq; auto with zarith. rewrite FshiftCorrectInv; auto. apply trans_eq with (FtoRradix pq); auto. apply Z.le_trans with (1 := H'10); auto with zarith. split. unfold FtoRradix in |- *; rewrite FshiftCorrect; auto. split. simpl in |- *. repeat rewrite inj_abs; auto with zarith arith. apply Z.le_trans with (Zmax (Fexp p) (Fexp q)); auto with zarith. apply Zmin_Zmax; auto. simpl in |- *. repeat rewrite inj_abs; auto with zarith arith. Qed. Theorem minusRoundRep : forall P, RoundedModeP b radix P -> forall p q qmp qmmp : float, (0 <= p)%R -> (p <= q)%R -> P (q - p)%R qmp -> Fbounded b p -> Fbounded b q -> exists r : float, Fbounded b r /\ r = (q - qmp)%R :>R. intros P H' p q qmp H'0 H'1 H'2 H'3 H'4 H'5. case (Rle_or_lt (/ 2%nat * q) p); intros Rle1. exists p; split; auto. replace (FtoRradix qmp) with (FtoRradix (Fminus radix q p)). rewrite (Fminus_correct radix); auto with arith; unfold FtoRradix in |- *; ring. apply (RoundedModeProjectorIdemEq b radix precision) with (P := P); auto. rewrite <- Fopp_Fminus. apply oppBounded; auto. apply Sterbenz; auto. apply Rle_trans with (FtoRradix q); auto with real. apply Rledouble; auto. apply Rle_trans with (FtoRradix p); auto with real. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ]. apply (Cp (q - p)%R (Fminus radix q p) qmp); auto. rewrite (Fminus_correct radix); auto with arith. apply RoundedModeBounded with (radix := radix) (P := P) (r := (q - p)%R); auto; auto. exists (Fminus radix q qmp); split. rewrite <- Fopp_Fminus. apply oppBounded; auto. apply Sterbenz; auto. apply RoundedModeBounded with (radix := radix) (P := P) (r := (q - p)%R); auto; auto. case MaxEx with (r := (/ 2%nat * FtoR radix q)%R) (3 := pGivesBound); auto with arith. intros max H'6. apply Rle_trans with (FtoRradix max); [ apply isMax_inv1 with (1 := H'6); auto | idtac ]. apply (RleBoundRoundl b radix precision) with (P := P) (r := (q - p)%R); auto; fold FtoRradix in |- *. case H'6; auto. case MinEx with (r := (/ 2%nat * FtoR radix q)%R) (3 := pGivesBound); auto with arith. intros min H'7. replace (FtoRradix max) with (q - min)%R. apply Rplus_le_reg_l with (r := (- q)%R). cut (forall p q : R, (- p + (p - q))%R = (- q)%R); [ intros tmp; repeat rewrite tmp; clear tmp | intros; ring ]. apply Ropp_le_contravar. case H'7. intros H'8 H'9; elim H'9; intros H'10 H'11; apply H'11; clear H'9; auto. apply Rlt_le; auto. unfold FtoRradix in |- *; rewrite (div2IsBetween b radix precision) with (5 := H'7) (6 := H'6); auto. ring. apply Rle_trans with (FtoRradix q); auto with real. apply (RleBoundRoundr b radix precision) with (P := P) (r := (q - p)%R); auto; fold FtoRradix in |- *. apply Rplus_le_reg_l with (r := (- q)%R). cut (forall p q : R, (- p + (p - q))%R = (- q)%R); [ intros tmp; repeat rewrite tmp; clear tmp | intros; ring ]. replace (- q + q)%R with (-0)%R; [ auto with real | ring ]. apply Rle_trans with (FtoRradix q); auto with real. apply Rledouble; auto. apply Rle_trans with (FtoRradix p); auto with real. apply (Fminus_correct radix); auto with arith. Qed. Theorem radixRangeBoundExp : forall p q : float, Fcanonic radix b p -> Fcanonic radix b q -> (0 <= p)%R -> (p < q)%R -> (q < radix * p)%R -> Fexp p = Fexp q \/ Z.succ (Fexp p) = Fexp q. intros p q H' H'0 H'1 H'2 H'3. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := p) (q := q); auto with arith. 2: intros H'4; elim H'4; intros H'5 H'6; clear H'4; auto. intros H'4; right. Casec H'; intros H'. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := q) (q := Float (Fnum p) (Z.succ (Fexp p))); auto with arith. left. case H'; intros H1 H2. repeat split; simpl in |- *; auto with float. apply Z.le_trans with (Fexp p); auto with float zarith. apply Rle_trans with (FtoRradix p); auto; apply Rlt_le; auto. unfold FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; auto. rewrite <- Rmult_assoc; rewrite (fun (x : R) (y : Z) => Rmult_comm x y); rewrite Rmult_assoc; auto. simpl in |- *; intros; apply Zle_antisym; auto with zarith. simpl in |- *; auto. intros H'5; elim H'5; intros H'6 H'7; auto. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := q) (q := Float (nNormMin radix precision) (Z.succ (Fexp p))); auto with arith. left; repeat split; simpl in |- *. rewrite Z.abs_eq; auto with float zarith. apply ZltNormMinVnum; auto with zarith. apply Zlt_le_weak; auto with zarith. apply nNormPos; auto with zarith. case H'; auto with zarith float. rewrite (PosNormMin radix b precision); auto with zarith. apply Rle_trans with (1 := H'1); auto with real. apply Rlt_trans with (1 := H'3). unfold FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real arith; auto. rewrite <- Rmult_assoc; rewrite (fun (x : R) (y : Z) => Rmult_comm x y); rewrite Rmult_assoc; auto. apply Rmult_lt_compat_l; auto with real arith. replace (Fexp p) with (- dExp b)%Z. change (p < firstNormalPos radix b precision)%R in |- *. apply (FsubnormalLtFirstNormalPos radix); auto with arith. case H'; intros Z1 (Z2, Z3); auto. auto with real zarith. simpl in |- *; auto. intros H; apply Zle_antisym; auto with zarith. intros H'5; elim H'5; intros H'6 H'7; rewrite H'6; clear H'5; auto. Qed. Theorem ExactMinusIntervalAux : forall P, RoundedModeP b radix P -> forall p q : float, (0 < p)%R -> (2%nat * p < q)%R -> Fcanonic radix b p -> Fcanonic radix b q -> (exists r : float, Fbounded b r /\ r = (q - p)%R :>R) -> forall r : float, Fcanonic radix b r -> (2%nat * p < r)%R -> (r <= q)%R -> exists r' : float, Fbounded b r' /\ r' = (r - p)%R :>R. intros P H' p q H'0 H'1 H'2 H'3 H'4 r H'5 H'6 H'7. cut (0 <= p)%R; [ intros Rle0 | apply Rlt_le; auto ]. cut (0 <= r)%R; [ intros Rle1 | apply Rle_trans with (2%nat * p)%R; auto ]. 2: apply Rle_trans with (FtoRradix p); auto with float arith. 2: apply Rledouble; auto. 2: apply Rlt_le; auto. generalize H'6; clear H'6; pattern r in |- *; apply (FinductNeg b radix precision) with (p := q); auto with arith. apply Rle_trans with (FtoRradix r); auto. intros q0 H'6 H'8 H'9 H'10 H'11. elim H'10; [ intros r' E; elim E; intros H'13 H'14; clear E H'10 | clear H'10 ]; auto. 2: apply Rlt_trans with (1 := H'11); auto; apply (FPredLt b radix precision); auto with arith. cut (0 <= Fnormalize radix b precision r')%R; [ intros Rle2 | idtac ]. 2: rewrite (FnormalizeCorrect radix); auto with arith. 2: unfold FtoRradix in H'14; rewrite H'14. 2: apply Rplus_le_reg_l with (r := FtoR radix p). 2: replace (FtoR radix p + 0)%R with (FtoR radix p); [ idtac | ring ]. 2: replace (FtoR radix p + (FtoR radix q0 - FtoR radix p))%R with (FtoR radix q0); [ idtac | ring ]. 2: apply Rle_trans with (2%nat * p)%R; auto. 2: apply Rledouble; auto with real arith. 2: apply Rlt_le; apply Rlt_trans with (1 := H'11); auto with float. 2: apply (FPredLt b radix precision); auto with arith. cut (Fnormalize radix b precision r' < q0)%R; [ intros Rle3 | idtac ]. 2: rewrite (FnormalizeCorrect radix); auto with arith. 2: unfold FtoRradix in H'14; rewrite H'14. 2: apply Rplus_lt_reg_l with (r := (- q0)%R). 2: replace (- q0 + (FtoR radix q0 - FtoR radix p))%R with (- p)%R; [ idtac | unfold FtoRradix in |- *; ring; ring ]. 2: replace (- q0 + q0)%R with (-0)%R; [ auto with real | ring ]. case radixRangeBoundExp with (p := Fnormalize radix b precision r') (q := q0); auto with float arith; fold FtoRradix in |- *. rewrite (FnormalizeCorrect radix); auto with arith. apply Rlt_le_trans with (2%nat * r')%R; auto. rewrite H'14. rewrite Rmult_minus_distr_l. pattern (FtoRradix q0) at 1 in |- *; (replace (FtoRradix q0) with (2%nat * q0 - q0)%R; [ idtac | simpl in |- *; ring ]). unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_contravar. apply Rlt_trans with (1 := H'11). apply (FPredLt b radix precision); auto with arith. apply Rmult_le_compat_r; auto with real arith. unfold FtoRradix in Rle2; rewrite (FnormalizeCorrect radix) in Rle2; auto with arith. rewrite INR_IZR_INZ; cut (2 <= radix)%Z; auto with real zarith. cut (1 < radix)%Z; auto with zarith. intros H'10. case (FcanonicLtPos _ radixMoreThanOne b precision) with (p := Fnormalize radix b precision r') (q := q0); auto with arith. apply FnormalizeCanonic; auto with arith. intros; Contradict H'10; auto with zarith. intros H'12; elim H'12; intros H'15 H'16; clear H'12. exists (Float (Z.pred (Fnum (Fnormalize radix b precision r'))) (Fexp (Fnormalize radix b precision r'))). split. cut (Fbounded b (Fnormalize radix b precision r')); [ intros Fb0 | idtac ]. repeat split; simpl in |- *; auto with float. case Rle2; intros Z1. apply Z.le_lt_trans with (Z.abs (Fnum (Fnormalize radix b precision r'))); auto with float zarith. repeat rewrite Z.abs_eq; auto with zarith. apply (LeR0Fnum radix); auto with zarith. apply Zle_Zpred; apply (LtR0Fnum radix); auto with zarith. replace (Fnum (Fnormalize radix b precision r')) with 0%Z; simpl in |- *; auto with zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. apply sym_equal; change (is_Fzero (Fnormalize radix b precision r')) in |- *; apply (is_Fzero_rep2 radix); auto with zarith. apply FcanonicBound with (radix := radix); auto. apply FnormalizeCanonic; auto with arith. replace (Float (Z.pred (Fnum (Fnormalize radix b precision r'))) (Fexp (Fnormalize radix b precision r'))) with (Fminus radix (Fnormalize radix b precision r') (Fminus radix q0 (FPred b radix precision q0))). repeat rewrite (Fopp_correct radix); repeat rewrite (Fminus_correct radix); auto with arith. rewrite (FnormalizeCorrect radix); auto with arith. unfold FtoRradix in H'14; rewrite H'14. unfold FtoRradix in |- *; ring; ring. replace (FPred b radix precision q0) with (Float (Z.pred (Fnum q0)) (Fexp q0)); auto. unfold Fminus, Fopp, Fplus in |- *; simpl in |- *. repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; simpl in |- *; auto. rewrite H. repeat rewrite Zmin_n_n; repeat rewrite <- Zminus_diag_reverse; simpl in |- *; auto. repeat rewrite Zmult_1_r. apply floatEq; simpl in |- *; auto; unfold Z.pred in |- *; ring. case (Z.eq_dec (Fnum q0) (nNormMin radix precision)); intros Zeq2. case (Z.eq_dec (Fexp q0) (- dExp b)); intros Zeq1. rewrite Zeq1; rewrite Zeq2; rewrite <- (FPredSimpl3 b radix); auto with arith; rewrite <- Zeq1; rewrite <- Zeq2; auto. Contradict H'16. apply Zle_not_lt. rewrite Zeq2. rewrite <- (Z.abs_eq (Fnum (Fnormalize radix b precision r'))); auto with zarith. apply pNormal_absolu_min with (b := b); auto with arith. cut (Fcanonic radix b (Fnormalize radix b precision r')); [ intros Ca1; case Ca1; auto | auto with float arith ]. intros H'12; case Zeq1; rewrite <- H. case H'12; auto. intros Hbis H0; case H0; auto. apply (LeR0Fnum radix); auto. rewrite FPredSimpl4; auto. Contradict H'16; rewrite H'16. apply Zle_not_lt. unfold pPred in |- *; rewrite Zopp_Zpred_Zs; apply Zlt_le_succ. apply Zlt_Zabs_inv1. cut (Fbounded b (Fnormalize radix b precision r')); [ auto with float | idtac ]. apply (FcanonicBound radix b); auto with float arith. intros H'10. case (Z.eq_dec (Fnum q0) (nNormMin radix precision)); intros Zeq2. exists (Float (Z.pred (Fnum (Fnormalize radix b precision r'))) (Fexp (Fnormalize radix b precision r'))). cut (Fbounded b (Fnormalize radix b precision r')); [ intros Fb1 | idtac ]. repeat split; simpl in |- *; auto with float. case Rle2; intros Z1. apply Z.lt_trans with (Z.abs (Fnum (Fnormalize radix b precision r'))). repeat rewrite Z.abs_eq; auto with zarith. apply (LeR0Fnum radix); auto. apply Zle_Zpred; apply (LtR0Fnum radix); auto. case Fb1; auto. replace (Fnum (Fnormalize radix b precision r')) with 0%Z. simpl in |- *; apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. apply sym_equal; change (is_Fzero (Fnormalize radix b precision r')) in |- *; apply (is_Fzero_rep2 radix); auto with zarith. rewrite FPredSimpl2; auto with zarith. rewrite <- H'10. cut (forall z : Z, Z.pred (Z.succ z) = z); [ intros tmp; rewrite tmp; clear tmp | intros; unfold Z.succ, Z.pred in |- *; ring ]. unfold FtoRradix, FtoR in |- *; simpl in |- *. cut (forall x : Z, Z.pred x = (x - 1%nat)%Z); [ intros tmp; rewrite tmp; clear tmp | intros; unfold Z.pred in |- *; simpl in |- *; ring ]. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite <- Z_R_minus; auto. rewrite (fun x y => Rmult_comm (x - y)); rewrite Rmult_minus_distr_l; repeat rewrite (fun x y => Rmult_comm (powerRZ x y)). replace (Fnum (Fnormalize radix b precision r') * powerRZ radix (Fexp (Fnormalize radix b precision r')))%R with (FtoRradix (Fnormalize radix b precision r')). rewrite (FnormalizeCorrect radix); auto. unfold FtoRradix in H'14; rewrite H'14. unfold FtoR in |- *; simpl in |- *. pattern (Fexp q0) at 1 in |- *; rewrite <- H'10. rewrite Zeq2; rewrite powerRZ_Zs; auto with real zarith. rewrite <- Rmult_assoc. replace (nNormMin radix precision * radix)%R with (powerRZ radix precision). unfold pPred, nNormMin, Z.pred in |- *; rewrite pGivesBound. rewrite plus_IZR; repeat rewrite Zpower_nat_Z_powerRZ; simpl in |- *; try ring. rewrite <- Zpower_nat_Z_powerRZ; auto with zarith; rewrite <- Rmult_IZR; rewrite Zmult_comm; rewrite <- (PosNormMin radix b precision); auto with real zarith. auto. red in |- *; intros H'12; absurd (- dExp b <= Fexp (Fnormalize radix b precision r'))%Z; auto with float. apply Zlt_not_le. rewrite <- H'12; rewrite <- H'10; unfold Z.succ in |- *; auto with float zarith. apply (FcanonicBound radix b); auto with arith. apply FnormalizeCanonic; auto with arith. exists (Float (Fnum (Fnormalize radix b precision r') - radix) (Fexp (Fnormalize radix b precision r'))). cut (Fbounded b (Fnormalize radix b precision r')); [ intros Fb1 | idtac ]. repeat split; simpl in |- *; auto with float. case (Zle_or_lt (Fnum (Fnormalize radix b precision r')) radix); intros Z1. apply Z.le_lt_trans with radix. rewrite Zabs_eq_opp; auto with zarith. cut (0 <= Fnum (Fnormalize radix b precision r'))%Z; auto with zarith. apply (LeR0Fnum radix); auto. rewrite <- (Zpower_nat_1 radix); rewrite pGivesBound; auto with zarith. apply Z.le_lt_trans with (Z.abs (Fnum (Fnormalize radix b precision r'))). repeat rewrite Z.abs_eq; auto with zarith. case Fb1; auto. rewrite FPredSimpl4; auto with arith. rewrite <- H'10. unfold FtoRradix, FtoR in |- *; simpl in |- *. cut (forall x : Z, Z.pred x = (x - 1%nat)%Z); [ intros tmp; rewrite tmp; clear tmp | intros; unfold Z.pred in |- *; simpl in |- *; ring ]. repeat rewrite <- Z_R_minus; auto. repeat rewrite (fun x y => Rmult_comm (x - y)); repeat rewrite Rmult_minus_distr_l; repeat rewrite (fun x y => Rmult_comm (powerRZ x y)). replace (Fnum (Fnormalize radix b precision r') * powerRZ radix (Fexp (Fnormalize radix b precision r')))%R with (FtoRradix (Fnormalize radix b precision r')). rewrite (FnormalizeCorrect radix); auto. unfold FtoRradix in H'14; rewrite H'14. unfold FtoR in |- *; simpl in |- *. rewrite <- H'10. repeat rewrite powerRZ_Zs; auto with real arith. ring. auto with real zarith. unfold FtoR in |- *; simpl in |- *; auto. red in |- *; intros H'12; absurd (0 <= Fnum q0)%Z; auto. apply Zlt_not_le. rewrite H'12. replace 0%Z with (- 0%nat)%Z; [ apply Zlt_Zopp | simpl in |- *; auto ]. unfold pPred in |- *; apply Zlt_succ_pred; simpl in |- *; auto with zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. apply (LeR0Fnum radix); auto. apply Rlt_le; auto. apply (FcanonicBound radix b); auto with arith. apply FnormalizeCanonic; auto with arith. Qed. Theorem ExactMinusIntervalAux1 : forall P, RoundedModeP b radix P -> forall p q : float, (0 <= p)%R -> (p <= q)%R -> Fcanonic radix b p -> Fcanonic radix b q -> (exists r : float, Fbounded b r /\ r = (q - p)%R :>R) -> forall r : float, Fcanonic radix b r -> (p <= r)%R -> (r <= q)%R -> exists r' : float, Fbounded b r' /\ r' = (r - p)%R :>R. intros P H' p q H'0 H'1 H'2 H'3 H'4 r H'5 H'6 H'7. Casec H'0; intros H'0. case (Rle_or_lt q (2%nat * p)); intros Rl1. exists (Fminus radix r p); split; auto. rewrite <- Fopp_Fminus. apply oppBounded. apply Sterbenz; auto. apply (FcanonicBound radix b); auto with arith. apply (FcanonicBound radix b); auto with arith. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real arith; rewrite Rmult_1_l; auto. apply Rle_trans with (1 := H'7); auto. apply Rle_trans with (1 := H'6); auto. apply Rledouble; auto. apply Rle_trans with (2 := H'6); apply Rlt_le; auto. rewrite (Fminus_correct radix); auto with arith. case (Rle_or_lt r (2%nat * p)); intros Rl2. exists (Fminus radix r p); split; auto. rewrite <- Fopp_Fminus. apply oppBounded. apply Sterbenz; auto. apply (FcanonicBound radix b); auto with arith. apply (FcanonicBound radix b); auto with arith. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real arith; rewrite Rmult_1_l; auto. apply Rle_trans with (1 := H'6); auto. apply Rledouble; auto. apply Rle_trans with (2 := H'6); apply Rlt_le; auto. rewrite (Fminus_correct radix); auto with arith. apply ExactMinusIntervalAux with (P := P) (q := q); auto. exists r; split; auto. apply (FcanonicBound radix b); auto with arith. rewrite <- H'0; ring. Qed. Theorem ExactMinusInterval : forall P, RoundedModeP b radix P -> forall p q : float, (0 <= p)%R -> (p <= q)%R -> Fbounded b p -> Fbounded b q -> (exists r : float, Fbounded b r /\ r = (q - p)%R :>R) -> forall r : float, Fbounded b r -> (p <= r)%R -> (r <= q)%R -> exists r' : float, Fbounded b r' /\ r' = (r - p)%R :>R. intros P H' p q H'0 H'1 H'2 H'3 H'4 r H'5 H'6 H'7. replace (FtoRradix r) with (FtoRradix (Fnormalize radix b precision r)); [ idtac | apply (FnormalizeCorrect radix) ]; auto. replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)); [ idtac | apply (FnormalizeCorrect radix) ]; auto. apply ExactMinusIntervalAux1 with (P := P) (q := Fnormalize radix b precision q); auto; try repeat rewrite (FnormalizeCorrect radix); auto; apply FnormalizeCanonic; auto with arith. Qed. (* Properties concerning LSB MSB *) Theorem MSBroundLSB : forall P : R -> float -> Prop, RoundedModeP b radix P -> forall f1 f2 : float, P f1 f2 -> ~ is_Fzero (Fminus radix f1 f2) -> (MSB radix (Fminus radix f1 f2) < LSB radix f2)%Z. intros P H' f1 f2 H'0 HZ. apply (oneExp_Zlt radix); auto. apply Rlt_le_trans with (Fulp b radix precision f2). apply Rle_lt_trans with (FtoRradix (Fabs (Fminus radix f1 f2))). unfold FtoRradix in |- *; apply MSB_le_abs; auto. unfold FtoRradix in |- *; rewrite Fabs_correct; auto with arith; rewrite Fminus_correct; auto with arith. apply RoundedModeUlp with (4 := H'); auto. apply FUlp_Le_LSigB; auto. apply RoundedModeBounded with (1 := H') (2 := H'0); auto. Qed. Theorem LSBMinus : forall p q : float, ~ is_Fzero (Fminus radix p q) -> (Z.min (LSB radix p) (LSB radix q) <= LSB radix (Fminus radix p q))%Z. intros p q H'1. elim (LSB_rep_min radix) with (p := p); auto; intros z E. elim (LSB_rep_min radix) with (p := q); auto; intros z0 E0. replace (LSB radix (Fminus radix p q)) with (LSB radix (Fminus radix (Float z (LSB radix p)) (Float z0 (LSB radix q)))). replace (Z.min (LSB radix p) (LSB radix q)) with (Fexp (Fminus radix (Float z (LSB radix p)) (Float z0 (LSB radix q)))); [ idtac | simpl in |- *; auto ]. apply Fexp_le_LSB; auto. apply sym_equal; apply LSB_comp; auto. repeat rewrite Fminus_correct; auto with arith. unfold FtoRradix in E; unfold FtoRradix in E0; rewrite E; rewrite E0; auto. Qed. Theorem LSBPlus : forall p q : float, ~ is_Fzero (Fplus radix p q) -> (Z.min (LSB radix p) (LSB radix q) <= LSB radix (Fplus radix p q))%Z. intros p q H'. elim (LSB_rep_min _ radixMoreThanOne p); intros z E. elim (LSB_rep_min _ radixMoreThanOne q); intros z0 E0. replace (LSB radix (Fplus radix p q)) with (LSB radix (Fplus radix (Float z (LSB radix p)) (Float z0 (LSB radix q)))). replace (Z.min (LSB radix p) (LSB radix q)) with (Fexp (Fplus radix (Float z (LSB radix p)) (Float z0 (LSB radix q)))); [ idtac | simpl in |- *; auto ]. apply Fexp_le_LSB; auto. apply sym_equal; apply LSB_comp; auto. repeat rewrite Fplus_correct; auto with arith. unfold FtoRradix in E; unfold FtoRradix in E0; rewrite E; rewrite E0; auto. Qed. End FRoundP. float-8.10.0/FroundProp.v000066400000000000000000001513061357127175600152160ustar00rootroot00000000000000(**************************************************************************** IEEE754 : FroundProp Laurent Thery, Sylvie Boldo ******************************************************************************) Require Export Fround. Require Export MSB. Section FRoundP. Variable b : Fbound. Variable radix : Z. Variable precision : 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 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Definition Fulp (p : float) := powerRZ radix (Fexp (Fnormalize radix b precision p)). Theorem FulpComp : forall p q : float, Fbounded b p -> Fbounded b q -> p = q :>R -> Fulp p = Fulp q. intros p q H' H'0 H'1; unfold Fulp in |- *. rewrite FcanonicUnique with (p := Fnormalize radix b precision p) (q := Fnormalize radix b precision q) (3 := pGivesBound); auto with float arith. apply trans_eq with (FtoR radix p). apply FnormalizeCorrect; auto. apply trans_eq with (FtoR radix q); auto. apply sym_eq; apply FnormalizeCorrect; auto. Qed. Theorem FulpLe : forall p : float, Fbounded b p -> (Fulp p <= Float 1 (Fexp p))%R. intros p H'; unfold Fulp, FtoRradix, FtoR, Fnormalize in |- *; simpl in |- *; rewrite Rmult_1_l. case (Z_zerop (Fnum p)); simpl in |- *; auto. intros H'0; apply (Rle_powerRZ radix (- dExp b) (Fexp p)); auto with float real zarith. intros H'0; apply Rle_powerRZ; auto with real zarith arith. Qed. Theorem Fulp_zero : forall x : float, is_Fzero x -> Fulp x = powerRZ radix (- dExp b). intros x; unfold is_Fzero, Fulp, Fnormalize in |- *; case (Z_zerop (Fnum x)); simpl in |- *; auto. intros H' H'0; Contradict H'; auto. Qed. Theorem FulpLe2 : forall p : float, Fbounded b p -> Fnormal radix b (Fnormalize radix b precision p) -> (Fulp p <= Rabs p * powerRZ radix (Z.succ (- precision)))%R. intros p H1 H2; unfold Fulp in |- *. replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)); [ idtac | unfold FtoRradix in |- *; apply FnormalizeCorrect; auto ]. apply Rmult_le_reg_l with (powerRZ radix (Z.pred precision)). apply powerRZ_lt; auto with real arith. replace (powerRZ radix (Z.pred precision) * (Rabs (Fnormalize radix b precision p) * powerRZ radix (Z.succ (- precision))))%R with (Rabs (Fnormalize radix b precision p)). unfold FtoRradix in |- *; rewrite <- Fabs_correct; auto with arith real. unfold Fabs, FtoR in |- *; simpl in |- *. apply Rmult_le_compat_r; [ apply powerRZ_le | rewrite <- inj_pred ]; auto with real arith zarith. rewrite <- Zpower_nat_Z_powerRZ. replace (Zpower_nat radix (pred precision)) with (nNormMin radix precision); auto; apply Rle_IZR. apply pNormal_absolu_min with b; auto with arith zarith real. apply trans_eq with (Rabs (Fnormalize radix b precision p) * (powerRZ radix (Z.pred precision) * powerRZ radix (Z.succ (- precision))))%R; [ idtac | ring ]. rewrite <- powerRZ_add; auto with zarith real. replace (Z.pred precision + Z.succ (- precision))%Z with 0%Z; [ simpl in |- *; ring | unfold Z.succ, Z.pred in |- *; ring ]; auto with real zarith. Qed. Theorem FulpGe : forall p : float, Fbounded b p -> (Rabs p <= (powerRZ radix precision - 1) * Fulp p)%R. intros p H. replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)); [ idtac | unfold FtoRradix in |- *; apply FnormalizeCorrect; auto ]. unfold FtoRradix in |- *; rewrite <- Fabs_correct; auto with arith real. unfold FtoR in |- *; simpl in |- *; unfold Fulp in |- *. apply Rmult_le_compat_r; [ apply powerRZ_le | idtac ]; auto with real arith zarith. apply Rle_trans with (IZR (Z.pred (Zpos (vNum b)))); [ apply Rle_IZR; auto with float zarith | idtac ]. unfold Z.pred in |- *; right; rewrite pGivesBound; replace 1%R with (IZR 1); auto with real. rewrite <- Zpower_nat_Z_powerRZ; rewrite Z_R_minus;auto. Qed. Theorem LeFulpPos : forall x y : float, Fbounded b x -> Fbounded b y -> (0 <= x)%R -> (x <= y)%R -> (Fulp x <= Fulp y)%R. intros x y Hx Hy H1 H2; unfold Fulp in |- *. apply Rle_powerRZ; auto with real zarith. apply Fcanonic_Rle_Zle with radix b precision; auto with zarith arith. apply FnormalizeCanonic; auto with zarith arith. apply FnormalizeCanonic; auto with zarith arith. repeat rewrite FnormalizeCorrect; auto with zarith arith real. repeat rewrite Rabs_right; auto with zarith arith real. apply Rge_trans with (FtoRradix x); auto with real. Qed. Theorem FulpSucCan : forall p : float, Fcanonic radix b p -> (FSucc b radix precision p - p <= Fulp p)%R. intros p H'. replace (Fulp p) with (powerRZ radix (Fexp p)). 2: unfold Fulp in |- *; replace (Fnormalize radix b precision p) with p; auto; apply sym_equal; apply FcanonicUnique with (3 := pGivesBound); auto with arith; apply FnormalizeCanonic || apply FnormalizeCorrect; auto with float zarith. 2: apply FcanonicBound with (1 := H'); auto with float zarith. unfold FtoRradix in |- *; rewrite <- Fminus_correct; auto with zarith. case (Z.eq_dec (Fnum p) (- nNormMin radix precision)); intros H1'. case (Z.eq_dec (Fexp p) (- dExp b)); intros H2'. rewrite FSuccDiff2; auto with arith. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real. rewrite FSuccDiff3; auto with arith. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l. apply Rlt_le; apply Rlt_powerRZ; auto with real zarith. unfold Z.pred in |- *; auto with zarith. rewrite FSuccDiff1; auto with arith. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real. Qed. Theorem FulpSuc : forall p : float, Fbounded b p -> (FNSucc b radix precision p - p <= Fulp p)%R. intros p H'. replace (Fulp p) with (Fulp (Fnormalize radix b precision p)). replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)). unfold FNSucc in |- *; apply FulpSucCan; auto with float arith. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. apply FulpComp; auto with float arith. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. Qed. Theorem FulpPredCan : forall p : float, Fcanonic radix b p -> (p - FPred b radix precision p <= Fulp p)%R. intros p H'. replace (Fulp p) with (powerRZ radix (Fexp p)). 2: unfold Fulp in |- *; replace (Fnormalize radix b precision p) with p; auto; apply sym_equal; apply FcanonicUnique with (3 := pGivesBound); auto with arith; apply FnormalizeCanonic || apply FnormalizeCorrect; auto with arith. unfold FtoRradix in |- *; rewrite <- Fminus_correct; auto with arith. case (Z.eq_dec (Fnum p) (nNormMin radix precision)); intros H1'. case (Z.eq_dec (Fexp p) (- dExp b)); intros H2'. rewrite FPredDiff2; auto with arith. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real. rewrite FPredDiff3; auto with arith. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real. apply Rlt_le; apply Rlt_powerRZ; auto with real zarith. replace 1%R with (INR 1); auto with real arith. unfold Z.pred in |- *; auto with zarith. rewrite FPredDiff1; auto with arith. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real. apply FcanonicBound with (1 := H'). Qed. Theorem FulpPred : forall p : float, Fbounded b p -> (p - FNPred b radix precision p <= Fulp p)%R. intros p H'. replace (Fulp p) with (Fulp (Fnormalize radix b precision p)). replace (FtoRradix p) with (FtoRradix (Fnormalize radix b precision p)). unfold FNPred in |- *; apply FulpPredCan; auto with float arith. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. apply FulpComp; auto with float arith. unfold FtoRradix in |- *; apply FnormalizeCorrect; auto. Qed. Theorem FSuccDiffPos : forall x : float, (0 <= x)%R -> Fminus radix (FSucc b radix precision x) x = Float 1%nat (Fexp x) :>R. intros x H. unfold FtoRradix in |- *; apply FSuccDiff1; auto with arith. Contradict H; unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite H. apply Rlt_not_le. replace 0%R with (0 * powerRZ radix (Fexp x))%R; [ idtac | ring ]. apply Rlt_monotony_exp; auto with real arith. generalize (nNormPos _ radixMoreThanOne precision); replace 0%R with (IZR (- 0%nat)); auto with real zarith arith. Qed. Theorem FulpFPredGePos : forall f : float, Fbounded b f -> Fcanonic radix b f -> (0 < f)%R -> (Fulp (FPred b radix precision f) <= Fulp f)%R. intros f Hf1 Hf2 H. apply LeFulpPos; auto with zarith float; unfold FtoRradix in |- *. apply R0RltRlePred; auto with arith. apply Rlt_le; apply FPredLt; auto with arith. Qed. Theorem CanonicFulp : forall p : float, Fcanonic radix b p -> Fulp p = Float 1%nat (Fexp p). intros p H; unfold Fulp in |- *. rewrite FcanonicFnormalizeEq; auto with arith. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. Qed. Theorem FSuccUlpPos : forall x : float, Fcanonic radix b x -> (0 <= x)%R -> Fminus radix (FSucc b radix precision x) x = Fulp x :>R. intros x H H0; rewrite CanonicFulp; auto. apply FSuccDiffPos; auto. Qed. Theorem FNSuccUlpPos : forall x : float, Fcanonic radix b x -> (0 <= x)%R -> Fminus radix (FNSucc b radix precision x) x = Fulp x :>R. intros x H H0. unfold FNSucc in |- *. rewrite FcanonicFnormalizeEq; auto with arith. apply FSuccUlpPos; auto. Qed. Theorem FulpFabs : forall f : float, Fulp f = Fulp (Fabs f) :>R. intros f; unfold Fulp in |- *; case (Rle_or_lt 0 f); intros H'. replace (Fabs f) with f; auto; unfold Fabs in |- *; apply floatEq; simpl in |- *; auto with zarith real. apply sym_eq; apply Z.abs_eq; apply LeR0Fnum with radix; auto with zarith real. replace (Fabs f) with (Fopp f); [ rewrite Fnormalize_Fopp | apply floatEq; simpl in |- * ]; auto with arith. apply sym_eq; apply Zabs_eq_opp; apply R0LeFnum with radix; auto with zarith real. Qed. Theorem RoundedModeUlp : forall P, RoundedModeP b radix P -> forall (p : R) (q : float), P p q -> (Rabs (p - q) < Fulp q)%R. intros P H' p q H'0. case (Req_dec p q); intros Eq1. rewrite <- Eq1. replace (p - p)%R with 0%R; [ idtac | ring ]. rewrite Rabs_R0; auto. unfold Fulp, FtoRradix, FtoR in |- *; simpl in |- *; auto with real arith. case H'. intros H'1 H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6; case H'5 with (1 := H'0); clear H'5 H'4 H'2; intros H'5. rewrite Rabs_right; auto. cut (Fbounded b q); [ intros B0 | case H'5; auto ]. apply Rlt_le_trans with (2 := FulpSuc q B0). apply Rplus_lt_reg_l with (r := FtoR radix q). repeat rewrite Rplus_minus; auto. case (Rle_or_lt (FNSucc b radix precision q) p); auto. intros H'2; absurd (FNSucc b radix precision q <= q)%R; auto. apply Rgt_not_le; red in |- *; unfold FtoRradix in |- *; auto with real float arith. case H'5; auto. intros H'4 H'7; elim H'7; intros H'8 H'9; apply H'9; clear H'7; auto. apply (FcanonicBound radix b); auto with float arith. apply Rle_ge; apply Rplus_le_reg_l with (r := FtoR radix q). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; apply isMin_inv1 with (1 := H'5); auto. rewrite Faux.Rabsolu_left1; auto. rewrite Ropp_minus_distr; auto. cut (Fbounded b q); [ intros B0 | case H'5; auto ]. apply Rlt_le_trans with (2 := FulpPred q B0). apply Ropp_lt_cancel; repeat rewrite Rminus_0_l. apply Rplus_lt_reg_l with (r := FtoR radix q). repeat rewrite Rplus_minus; auto. case (Rle_or_lt p (FNPred b radix precision q)); auto. intros H'2; absurd (q <= FNPred b radix precision q)%R; auto. apply Rgt_not_le; red in |- *; unfold FtoRradix in |- *; auto with real float arith. case H'5; auto. intros H'4 H'7; elim H'7; intros H'8 H'9; apply H'9; clear H'7; auto. apply (FcanonicBound radix b); auto with float arith. intros H1; apply Rplus_lt_compat_l; auto with real; apply Ropp_lt_contravar; unfold Rminus in |- *; auto with real. apply Rplus_le_reg_l with (r := FtoR radix q). repeat rewrite Rplus_minus; auto. rewrite Rplus_0_r; apply isMax_inv1 with (1 := H'5). Qed. Theorem RoundedModeErrorExpStrict : forall P, RoundedModeP b radix P -> forall (p q : float) (x : R), Fbounded b p -> Fbounded b q -> P x p -> q = (x - p)%R :>R -> q <> 0%R :>R -> (Fexp q < Fexp p)%Z. intros P H p q x H0 H1 H2 H3 H4. apply Zlt_powerRZ with (e := IZR radix); auto with real zarith. apply Rle_lt_trans with (FtoRradix (Fabs q)). replace (powerRZ radix (Fexp q)) with (FtoRradix (Float 1%nat (Fexp q))); unfold FtoRradix in |- *; [ apply Fop.RleFexpFabs; auto with arith | unfold FtoR in |- *; simpl in |- *; ring ]. rewrite (Fabs_correct radix); auto with zarith. fold FtoRradix in |- *; rewrite H3. apply Rlt_le_trans with (Fulp p); [ apply RoundedModeUlp with P; auto | unfold Fulp in |- * ]. apply Rle_powerRZ; auto with real zarith. apply FcanonicLeastExp with radix b precision; auto with real arith. apply sym_eq; apply FnormalizeCorrect; auto. apply FnormalizeCanonic; auto with zarith. Qed. Theorem RoundedModeProjectorIdem : forall P (p : float), RoundedModeP b radix P -> Fbounded b p -> P p p. intros P p H' H. elim H'; intros H'0 H'1; elim H'1; intros H'2 H'3; elim H'3; intros H'4 H'5; clear H'3 H'1. case (H'0 p). intros x H'6. apply (H'2 p p x); auto. apply sym_eq; apply (RoundedProjector _ _ P H'); auto. Qed. Theorem RoundedModeBounded : forall P (r : R) (q : float), RoundedModeP b radix P -> P r q -> Fbounded b q. intros P r q H' H'0. case H'. intros H'1 H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6; case H'5 with (1 := H'0); clear H'4 H'2; intros H; case H; auto. Qed. Theorem RoundedModeProjectorIdemEq : forall (P : R -> float -> Prop) (p q : float), RoundedModeP b radix P -> Fbounded b p -> P (FtoR radix p) q -> p = q :>R. intros P p q H' H'0 H'1. cut (MinOrMaxP b radix P); [ intros Mn; case (Mn p q); auto; intros Mn1 | auto with inv ]. apply sym_eq; apply MinEq with (1 := Mn1); auto. apply (RoundedModeProjectorIdem (isMin b radix)); auto. apply MinRoundedModeP with (precision := precision); auto. apply sym_eq; apply MaxEq with (1 := Mn1); auto. apply (RoundedModeProjectorIdem (isMax b radix)); auto. apply MaxRoundedModeP with (precision := precision); auto. Qed. Theorem RoundedModeMult : forall P, RoundedModeP b radix P -> forall (r : R) (q q' : float), P r q -> Fbounded b q' -> (r <= radix * q')%R -> (q <= radix * q')%R. intros P H' r q q' H'0 H'1. replace (radix * q')%R with (FtoRradix (Float (Fnum q') (Fexp q' + 1%nat))). intros H'2; case H'2. intros H'3; case H'; intros H'4 H'5; elim H'5; intros H'6 H'7; elim H'7; intros H'8 H'9; apply H'9 with (1 := H'3); clear H'7 H'5; auto. apply RoundedModeProjectorIdem; auto. apply FBoundedScale; auto. intros H'3. replace (FtoRradix q) with (FtoRradix (Float (Fnum q') (Fexp q' + 1%nat))); auto with real. apply (RoundedProjector _ _ P H'); auto. apply FBoundedScale; auto. case H'. intros H'4 H'5; elim H'5; intros H'6 H'7; clear H'5. apply (H'6 r (Float (Fnum q') (Fexp q' + 1%nat)) q); auto. apply RoundedModeBounded with (P := P) (r := r); auto. rewrite (FvalScale _ radixMoreThanOne b). rewrite powerRZ_1; auto. Qed. Theorem RoundedModeMultLess : forall P, RoundedModeP b radix P -> forall (r : R) (q q' : float), P r q -> Fbounded b q' -> (radix * q' <= r)%R -> (radix * q' <= q)%R. intros P H' r q q' H'0 H'1. replace (radix * q')%R with (FtoRradix (Float (Fnum q') (Fexp q' + 1%nat))). intros H'2; case H'2. intros H'3; case H'; intros H'4 H'5; elim H'5; intros H'6 H'7; elim H'7; intros H'8 H'9; apply H'9 with (1 := H'3); clear H'7 H'5; auto. apply RoundedModeProjectorIdem; auto. apply FBoundedScale; auto. intros H'3. replace (FtoRradix q) with (FtoRradix (Float (Fnum q') (Fexp q' + 1%nat))); auto with real. apply (RoundedProjector _ _ P H'); auto. apply FBoundedScale; auto. unfold FtoRradix in H'3; rewrite H'3; auto. case H'. intros H'4 H'5; elim H'5; intros H'6 H'7; clear H'5. unfold FtoRradix in |- *; rewrite FvalScale; auto. rewrite powerRZ_1; auto. Qed. Theorem RleMinR0 : forall (r : R) (min : float), (0 <= r)%R -> isMin b radix r min -> (0 <= min)%R. intros r min H' H'0. rewrite <- (FzeroisZero radix b). case H'; intros H'1. apply (MonotoneMin b radix) with (p := FtoRradix (Fzero (- dExp b))) (q := r); auto. unfold FtoRradix in |- *; rewrite (FzeroisZero radix b); auto. apply (RoundedModeProjectorIdem (isMin b radix)); auto. apply MinRoundedModeP with (precision := precision); auto with float. apply FboundedFzero; auto. replace (FtoR radix (Fzero (- dExp b))) with (FtoRradix min); auto with real. apply sym_eq; apply (ProjectMin b radix). apply FboundedFzero; auto. rewrite <- H'1 in H'0; rewrite <- (FzeroisZero radix b) in H'0; auto. Qed. Theorem RleRoundedR0 : forall (P : R -> float -> Prop) (p : float) (r : R), RoundedModeP b radix P -> P r p -> (0 <= r)%R -> (0 <= p)%R. intros P p r H' H'0 H'1. case H'. intros H'2 H'3; Elimc H'3; intros H'3 H'4; Elimc H'4; intros H'4 H'5; case (H'4 r p); auto; intros H'6. apply RleMinR0 with (r := r); auto. apply Rle_trans with r; auto; apply isMax_inv1 with (1 := H'6). Qed. Theorem RleMaxR0 : forall (r : R) (max : float), (r <= 0)%R -> isMax b radix r max -> (max <= 0)%R. intros r max H' H'0. rewrite <- (FzeroisZero radix b). case H'; intros H'1. apply (MonotoneMax b radix) with (q := FtoRradix (Fzero (- dExp b))) (p := r); auto. unfold FtoRradix in |- *; rewrite FzeroisZero; auto. apply (RoundedModeProjectorIdem (isMax b radix)); auto. apply MaxRoundedModeP with (precision := precision); auto. apply FboundedFzero; auto. replace (FtoR radix (Fzero (- dExp b))) with (FtoRradix max); auto with real. apply sym_eq; apply (ProjectMax b radix). apply FboundedFzero; auto. rewrite H'1 in H'0; rewrite <- (FzeroisZero radix b) in H'0; auto. Qed. Theorem RleRoundedLessR0 : forall (P : R -> float -> Prop) (p : float) (r : R), RoundedModeP b radix P -> P r p -> (r <= 0)%R -> (p <= 0)%R. intros P p r H' H'0 H'1. case H'. intros H'2 H'3; Elimc H'3; intros H'3 H'4; Elimc H'4; intros H'4 H'5; case (H'4 r p); auto; intros H'6. apply Rle_trans with r; auto; apply isMin_inv1 with (1 := H'6). apply RleMaxR0 with (r := r); auto. Qed. Theorem PminPos : forall p min : float, (0 <= p)%R -> Fbounded b p -> isMin b radix (/ 2%nat * p) min -> exists c : float, Fbounded b c /\ c = (p - min)%R :>R. intros p min H' H'0 H'1. cut (min <= / 2%nat * p)%R; [ intros Rl1; Casec Rl1; intros Rl1 | apply isMin_inv1 with (1 := H'1); auto ]. case (eqExpMax _ radixMoreThanOne b min p); auto. case H'1; auto. rewrite Fabs_correct; auto with arith. rewrite Rabs_right; auto. apply Rle_trans with (/ 2%nat * p)%R; auto. apply Rlt_le; auto. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_ne_r; auto with real. apply Rle_ge; apply RleMinR0 with (r := (/ 2%nat * p)%R); auto. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_1_l; rewrite Rmult_0_r; auto with real. intros min' H'2; elim H'2; intros H'3 H'4; elim H'4; intros H'5 H'6; clear H'4 H'2. case (FboundNext _ radixMoreThanOne b precision) with (p := min'); auto with arith; fold FtoRradix in |- *. intros Smin H'2; elim H'2; intros H'4 H'7; clear H'2. exists Smin; split; auto. rewrite H'7; auto. unfold FtoRradix in |- *. rewrite <- H'5; auto. replace (Float (Z.succ (Fnum min')) (Fexp min')) with (Float (Fnum (Fshift radix (Z.abs_nat (Fexp p - Fexp min')) p) - Fnum min') (Fexp min')); auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite <- Z_R_minus. rewrite (fun x y z : R => Rmult_comm (x - y) z); rewrite Rmult_minus_distr_l; repeat rewrite (fun x : Z => Rmult_comm (powerRZ radix x)). rewrite Rmult_IZR. rewrite Zpower_nat_powerRZ_absolu; auto with zarith. rewrite Rmult_assoc. rewrite <- (powerRZ_add radix); auto with real zarith. replace (Fexp p - Fexp min' + Fexp min')%Z with (Fexp p); [ auto | ring ]. apply floatEq; auto; simpl in |- *. apply Zle_antisym. apply Zlt_succ_le. apply Zplus_lt_reg_l with (p := Fnum min'); auto. cut (forall x y : Z, (x + (y - x))%Z = y); [ intros tmp; rewrite tmp; clear tmp | intros; ring ]. replace (Fnum min' + Z.succ (Z.succ (Fnum min')))%Z with (2%nat * Z.succ (Fnum min'))%Z. apply (Rlt_Float_Zlt radix) with (r := Fexp min'); auto; fold FtoRradix in |- *. replace (FtoRradix (Float (2%nat * Z.succ (Fnum min')) (Fexp min'))) with (2%nat * Float (Z.succ (Fnum min')) (Fexp min'))%R. rewrite <- H'7. replace (Float (Fnum p * Zpower_nat radix (Z.abs_nat (Fexp p - Fexp min'))) (Fexp min')) with (Fshift radix (Z.abs_nat (Fexp p - Fexp min')) p). unfold FtoRradix in |- *; rewrite FshiftCorrect; auto. apply Rmult_lt_reg_l with (r := (/ 2%nat)%R); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real; rewrite Rmult_1_l; auto with real. case (Rle_or_lt Smin (/ 2%nat * FtoR radix p)); auto. intros H'2; absurd (min < Smin)%R. apply Rle_not_lt. case H'1; auto. intros H'8 H'9; elim H'9; intros H'10 H'11; apply H'11; clear H'9; auto. rewrite H'7; unfold FtoRradix in |- *; rewrite <- H'5; auto. unfold FtoR in |- *; simpl in |- *; apply Rlt_monotony_exp; auto with real zarith. unfold Fshift in |- *; simpl in |- *. replace (Fexp p - Z.abs_nat (Fexp p - Fexp min'))%Z with (Fexp min'); auto. rewrite inj_abs; auto. ring. auto with zarith. replace (FtoRradix (Float (2%nat * Z.succ (Fnum min')) (Fexp min'))) with ((2%nat * Z.succ (Fnum min'))%Z * powerRZ radix (Fexp min'))%R. rewrite Rmult_IZR; auto. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. simpl in |- *; auto. replace (Z_of_nat 2) with (Z.succ (Z.succ 0)). repeat rewrite <- Zmult_succ_l_reverse; unfold Z.succ in |- *; ring. simpl in |- *; auto. apply Zlt_le_succ; auto. apply Zplus_lt_reg_l with (p := Fnum min'); auto. cut (forall x y : Z, (x + (y - x))%Z = y); [ intros tmp; rewrite tmp; clear tmp | intros; ring ]. replace (Fnum min' + Fnum min')%Z with (2%nat * Fnum min')%Z. apply (Rlt_Float_Zlt radix) with (r := Fexp min'); auto; fold FtoRradix in |- *. replace (FtoRradix (Float (2%nat * Fnum min') (Fexp min'))) with (2%nat * Float (Fnum min') (Fexp min'))%R. replace (Float (Fnum p * Zpower_nat radix (Z.abs_nat (Fexp p - Fexp min'))) (Fexp min')) with (Fshift radix (Z.abs_nat (Fexp p - Fexp min')) p). unfold FtoRradix in |- *; rewrite FshiftCorrect; auto. apply Rmult_lt_reg_l with (r := (/ 2%nat)%R); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real; rewrite Rmult_1_l; auto with real. replace (FtoR radix (Float (Fnum min') (Fexp min'))) with (FtoR radix min); auto. unfold Fshift in |- *; simpl in |- *. replace (Fexp p - Z.abs_nat (Fexp p - Fexp min'))%Z with (Fexp min'); auto. rewrite inj_abs; auto. ring. auto with zarith. replace (FtoRradix (Float (2%nat * Fnum min') (Fexp min'))) with ((2%nat * Fnum min')%Z * powerRZ radix (Fexp min'))%R. rewrite Rmult_IZR; auto. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. simpl in |- *; auto. replace (Z_of_nat 2) with (Z.succ (Z.succ 0)). repeat rewrite <- Zmult_succ_l_reverse; unfold Z.succ in |- *; ring. simpl in |- *; auto. exists min; split; auto. case H'1; auto. rewrite Rl1. pattern (FtoRradix p) at 2 in |- *; replace (FtoRradix p) with (2%nat * (/ 2%nat * p))%R. simpl in |- *; ring. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_ne_r; auto with real. Qed. Theorem div2IsBetweenPos : forall p min max : float, (0 <= p)%R -> Fbounded b p -> isMin b radix (/ 2%nat * p) min -> isMax b radix (/ 2%nat * p) max -> p = (min + max)%R :>R. intros p min max P H' H'0 H'1; apply Rle_antisym. apply Rplus_le_reg_l with (r := (- max)%R). replace (- max + p)%R with (p - max)%R; [ idtac | ring ]. replace (- max + (min + max))%R with (FtoRradix min); [ idtac | ring ]. rewrite <- (Fminus_correct radix); auto with arith. case H'0. intros H'2 H'3; elim H'3; intros H'4 H'5; apply H'5; clear H'3; auto. apply Sterbenz; auto. case H'1; auto. apply Rle_trans with (FtoRradix max); auto. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_1_l; auto with real. apply Rledouble; auto. apply Rle_trans with (FtoRradix min); auto. apply RleMinR0 with (r := (/ 2%nat * p)%R); auto. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_1_l; rewrite Rmult_0_r; auto with real. apply Rle_trans with (/ 2%nat * p)%R; auto; apply isMax_inv1 with (1 := H'1). case H'1. intros H'3 H'6; elim H'6; intros H'7 H'8; apply H'8; clear H'6; auto. apply Rmult_le_reg_l with (r := INR 2); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real; rewrite Rmult_1_l; auto with real. apply Rmult_le_reg_l with (r := (/ 2%nat)%R); auto with real. rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real; rewrite Rmult_1_l; auto with real. apply isMax_inv1 with (1 := H'1). rewrite Fminus_correct; auto with arith. apply Rplus_le_reg_l with (r := FtoR radix max). replace (FtoR radix max + (FtoR radix p - FtoR radix max))%R with (FtoR radix p); [ idtac | ring ]. apply Rplus_le_reg_l with (r := (- (/ 2%nat * p))%R). replace (- (/ 2%nat * p) + FtoR radix p)%R with (/ 2%nat * p)%R. replace (- (/ 2%nat * p) + (FtoR radix max + / 2%nat * p))%R with (FtoR radix max); [ apply isMax_inv1 with (1 := H'1) | ring ]. replace (FtoR radix p) with (2%nat * (/ 2%nat * p))%R. simpl in |- *; ring. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real. apply Rplus_le_reg_l with (r := (- min)%R). replace (- min + p)%R with (p - min)%R; [ idtac | ring ]. replace (- min + (min + max))%R with (FtoRradix max); [ idtac | ring ]. case (PminPos p min); auto. intros x H'2; elim H'2; intros H'3 H'4; elim H'4; clear H'2. case H'1. intros H'2 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. unfold FtoRradix in H'4; rewrite H'4; auto. fold FtoRradix in |- *; apply Rplus_le_reg_l with (r := FtoRradix min). replace (min + (p - min))%R with (FtoRradix p); [ idtac | ring ]. apply Rplus_le_reg_l with (r := (- (/ 2%nat * p))%R). replace (- (/ 2%nat * p) + p)%R with (/ 2%nat * p)%R. replace (- (/ 2%nat * p) + (min + / 2%nat * p))%R with (FtoRradix min); [ apply isMin_inv1 with (1 := H'0) | ring ]. pattern (FtoRradix p) at 3 in |- *; replace (FtoRradix p) with (2%nat * (/ 2%nat * p))%R. simpl in |- *; ring. rewrite <- Rmult_assoc; rewrite Rinv_r; auto with real. Qed. Theorem div2IsBetween : forall p min max : float, Fbounded b p -> isMin b radix (/ 2%nat * p) min -> isMax b radix (/ 2%nat * p) max -> p = (min + max)%R :>R. intros p min max H' H'0 H'1; case (Rle_or_lt 0 p); intros H'2. apply div2IsBetweenPos; auto. cut (forall x y : R, (- x)%R = (- y)%R -> x = y); [ intros H'3; apply H'3; clear H'3 | idtac ]. replace (- (min + max))%R with (- max + - min)%R; [ idtac | ring ]. repeat rewrite <- (Fopp_correct radix); auto with float. apply div2IsBetweenPos; auto with float. rewrite (Fopp_correct radix); auto. replace 0%R with (-0)%R; try apply Rlt_le; auto with real. replace (/ 2%nat * Fopp p)%R with (- (/ 2%nat * p))%R; auto with float. rewrite (Fopp_correct radix); auto; fold FtoRradix; ring. replace (/ 2%nat * Fopp p)%R with (- (/ 2%nat * p))%R; auto with float. rewrite (Fopp_correct radix); auto; fold FtoRradix;ring. intros x y H'3; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); rewrite H'3; auto. Qed. Theorem RoundedModeMultAbs : forall P, RoundedModeP b radix P -> forall (r : R) (q q' : float), P r q -> Fbounded b q' -> (Rabs r <= radix * q')%R -> (Rabs q <= radix * q')%R. intros P H' r q q' H'0 H'1 H'2. case (Rle_or_lt 0 r); intros Rl0. rewrite Rabs_right; auto. apply RoundedModeMult with (P := P) (r := r); auto. rewrite <- (Rabs_right r); auto with real. apply Rle_ge; apply RleRoundedR0 with (P := P) (r := r); auto. rewrite Faux.Rabsolu_left1; auto. replace (radix * q')%R with (- (radix * - q'))%R; [ apply Ropp_le_contravar | ring ]. rewrite <- (Fopp_correct radix). apply RoundedModeMultLess with (P := P) (r := r); auto. apply oppBounded; auto. unfold FtoRradix in |- *; rewrite Fopp_correct. rewrite <- (Ropp_involutive r). replace (radix * - FtoR radix q')%R with (- (radix * q'))%R; [ apply Ropp_le_contravar | fold FtoRradix;ring ]; auto. rewrite <- (Faux.Rabsolu_left1 r); auto. apply Rlt_le; auto. apply RleRoundedLessR0 with (P := P) (r := r); auto. apply Rlt_le; auto. Qed. Theorem isMinComp : forall (r1 r2 : R) (min max : float), isMin b radix r1 min -> isMax b radix r1 max -> (min < r2)%R -> (r2 < max)%R -> isMin b radix r2 min. intros r1 r2 min max H' H'0 H'1 H'2; split. case H'; auto. split. apply Rlt_le; auto. intros f H'3 H'4. case H'; auto. intros H'5 H'6; elim H'6; intros H'7 H'8; apply H'8; clear H'6; auto. case (Rle_or_lt (FtoR radix f) r1); auto; intros C1. absurd (FtoR radix f < max)%R. apply Rle_not_lt. case H'0. intros H'6 H'9; elim H'9; intros H'10 H'11; apply H'11; clear H'9; auto. apply Rlt_le; auto. apply Rle_lt_trans with (2 := H'2); auto. Qed. Theorem isMaxComp : forall (r1 r2 : R) (min max : float), isMin b radix r1 min -> isMax b radix r1 max -> (min < r2)%R -> (r2 < max)%R -> isMax b radix r2 max. intros r1 r2 min max H' H'0 H'1 H'2; split. case H'0; auto. split. apply Rlt_le; auto. intros f H'3 H'4. case H'0; auto. intros H'5 H'6; elim H'6; intros H'7 H'8; apply H'8; clear H'6; auto. case (Rle_or_lt r1 (FtoR radix f)); auto; intros C1. absurd (min < FtoR radix f)%R. apply Rle_not_lt. case H'. intros H'6 H'9; elim H'9; intros H'10 H'11; apply H'11; clear H'9; auto. apply Rlt_le; auto. apply Rlt_le_trans with (1 := H'1); auto. Qed. Theorem roundedModeLessMult : forall (P : R -> float -> Prop) (p : float) (r : R), RoundedModeP b radix P -> P r p -> (Float 1%nat (- dExp b) <= r)%R -> (p <= radix * r)%R. intros P p r H' H'0 H'1. cut (0 < Float 1%nat (- dExp b))%R; [ intros Rl0 | unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real arith ]. cut (0 < r)%R; [ intros Rl1 | apply Rlt_le_trans with (1 := Rl0) ]; auto. cut (0 <= r)%R; [ intros Rl2 | apply Rlt_le; auto ]. case H'. intros H'2 H'3; Elimc H'3; intros H'3 H'4; Elimc H'4; intros H'4 H'5; case (H'4 r p); auto; intros H'6. apply Rle_trans with r; auto with real. apply isMin_inv1 with (1 := H'6). rewrite Rmult_comm; pattern r at 1 in |- *; replace r with (r * 1%nat)%R; [ apply Rmult_le_compat_l | simpl; ring ]; auto with real arith. case (MinEx b radix precision) with (r := r); auto with arith; intros min Hmin. cut (Fbounded b (Float (Fnum min) (Z.succ (Fexp min)))); [ intros F2 | idtac ]. cut (FtoRradix (Float (Fnum min) (Z.succ (Fexp min))) = (radix * min)%R :>R); [ intros F2Eq | idtac ]. apply Rle_trans with (FtoRradix (Float (Fnum min) (Z.succ (Fexp min)))). case H'6. intros H'7 H'8; elim H'8; intros H'9 H'10; apply H'10; clear H'8; auto. case (Rle_or_lt r (Float (Fnum min) (Z.succ (Fexp min)))); auto; intros Rlt0. absurd (Float (Fnum min) (Z.succ (Fexp min)) <= min)%R. apply Rgt_not_le. rewrite F2Eq; auto with real. rewrite Rmult_comm. pattern (FtoRradix min) at 2 in |- *; replace (FtoRradix min) with (min * 1%nat)%R; auto with real. red in |- *; apply Rmult_lt_compat_l; auto with real arith. case (RleMinR0 r min); auto. intros H'8; case H'1. intros H'11; absurd (Float 1%nat (- dExp b) <= min)%R. apply Rgt_not_le; auto. rewrite <- H'8; auto. apply (MonotoneMin b radix) with (p := FtoRradix (Float 1%nat (- dExp b))) (q := r); auto. apply (RoundedModeProjectorIdem (isMin b radix)); auto. apply MinRoundedModeP with (precision := precision); auto. repeat split. simpl in |- *; auto with zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. simpl in |- *; auto with zarith. intros H'11; absurd (min = Float 1%nat (- dExp b) :>R). rewrite <- H'8. apply Rlt_dichotomy_converse; left; auto. apply (MinUniqueP b radix r); auto. rewrite <- H'11. apply (RoundedModeProjectorIdem (isMin b radix)); auto. apply MinRoundedModeP with (precision := precision); auto. repeat split. simpl in |- *; auto with zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. simpl in |- *; auto with zarith. case Hmin. intros H'8 H'11; elim H'11; intros H'12 H'13; apply H'13; clear H'11; auto. apply Rlt_le; auto. rewrite F2Eq. apply Rmult_le_compat_l; auto with real arith. replace 0%R with (INR 0); auto with real arith. apply isMin_inv1 with (1 := Hmin). unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; ring. cut (Fbounded b min); [ unfold Fbounded in |- *; intros Fb0 | case Hmin; auto ]. elim Fb0; intros H H0; auto. repeat (split; simpl in |- *); auto. apply Z.le_trans with (Fexp min); auto with zarith. Qed. Theorem roundedModeMoreMult : forall (P : R -> float -> Prop) (p : float) (r : R), RoundedModeP b radix P -> P r p -> (r <= Float (- 1%nat) (- dExp b))%R -> (radix * r <= p)%R. intros P p r H' H'0 H'1. cut (Float (- 1%nat) (- dExp b) < 0)%R; [ intros Rl0 | unfold FtoRradix, FtoR in |- *; simpl in |- *; unfold IZR at 1; rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; auto with real arith ]. 2: replace 0%R with (-0)%R; auto with real arith; ring. cut (r < 0)%R; [ intros Rl1 | apply Rle_lt_trans with (2 := Rl0) ]; auto. cut (r <= 0)%R; [ intros Rl2 | apply Rlt_le; auto ]. case H'. intros H'2 H'3; Elimc H'3; intros H'3 H'4; Elimc H'4; intros H'4 H'5; case (H'4 r p); auto; intros H'6. case (MaxEx b radix precision) with (r := r); auto with arith; intros max Hmax. cut (Fbounded b (Float (Fnum max) (Z.succ (Fexp max)))); [ intros F2 | idtac ]. cut (FtoRradix (Float (Fnum max) (Z.succ (Fexp max))) = (radix * max)%R :>R); [ intros F2Eq | idtac ]. apply Rle_trans with (FtoRradix (Float (Fnum max) (Z.succ (Fexp max)))). rewrite F2Eq; auto with real. apply Rmult_le_compat_l; auto with real arith. replace 0%R with (INR 0); auto with real arith. apply isMax_inv1 with (1 := Hmax); auto. case H'6. intros H'7 H'8; elim H'8; intros H'9 H'10; apply H'10; clear H'8; auto. case (Rle_or_lt (Float (Fnum max) (Z.succ (Fexp max))) r); auto; intros Rlt0. absurd (max <= Float (Fnum max) (Z.succ (Fexp max)))%R. apply Rgt_not_le. rewrite F2Eq. replace (radix * max)%R with (- (- max * radix))%R; [ idtac | ring ]. pattern (FtoRradix max) at 1 in |- *; replace (FtoRradix max) with (- (- max * 1%nat))%R; [ idtac | simpl in |- *; ring ]. apply Ropp_lt_gt_contravar; apply Rmult_lt_compat_l; auto with real. replace 0%R with (-0)%R; [ apply Ropp_lt_contravar | ring ]. case (RleMaxR0 r max); auto. intros H'8; case H'1. intros H'11; absurd (max <= Float (- 1%nat) (- dExp b))%R. apply Rgt_not_le; auto. rewrite H'8; auto. apply (MonotoneMax b radix) with (q := FtoRradix (Float (- 1%nat) (- dExp b))) (p := r); auto. apply (RoundedModeProjectorIdem (isMax b radix)); auto. apply MaxRoundedModeP with (precision := precision); auto. repeat split. simpl in |- *; auto with zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. simpl in |- *; auto with zarith. intros H'11; absurd (Float (- 1%nat) (- dExp b) = max :>R). rewrite H'8; auto. apply Rlt_dichotomy_converse; left; auto. apply (MaxUniqueP b radix r); auto. rewrite H'11. apply (RoundedModeProjectorIdem (isMax b radix)); auto. apply MaxRoundedModeP with (precision := precision); auto. repeat split. simpl in |- *; auto with zarith. apply (vNumbMoreThanOne radix) with (precision := precision); auto with zarith. simpl in |- *; auto with zarith. case Hmax. intros H'8 H'11; elim H'11; intros H'12 H'13; apply H'13; clear H'11; auto. apply Rlt_le; auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; ring. cut (Fbounded b max); [ unfold Fbounded in |- *; intros Fb0 | case Hmax; auto ]. elim Fb0; intros H H0; repeat (split; simpl in |- *); auto. apply Z.le_trans with (Fexp max); auto with zarith. apply Rle_trans with r; auto with real. pattern r at 2 in |- *; replace r with (- (- r * 1%nat))%R; [ idtac | simpl; ring ]. replace (radix * r)%R with (- (- r * radix))%R; [ idtac | ring ]. apply Ropp_le_contravar; apply Rmult_le_compat_l; auto with real arith. replace 0%R with (-0)%R; auto with real arith. apply isMax_inv1 with (1 := H'6). Qed. Theorem roundedModeAbsMult : forall (P : R -> float -> Prop) (p : float) (r : R), RoundedModeP b radix P -> P r p -> (Float 1%nat (- dExp b) <= Rabs r)%R -> (Rabs p <= radix * Rabs r)%R. intros P p r H' H'0 H'1; case (Rle_or_lt 0 r); intros H'2. repeat rewrite Rabs_right; auto with real. apply roundedModeLessMult with (P := P); auto. rewrite <- (Rabs_right r); auto with real. apply Rle_ge; apply (RleRoundedR0 P) with (r := r); auto. repeat rewrite Faux.Rabsolu_left1; auto. replace (radix * - r)%R with (- (radix * r))%R; [ apply Ropp_le_contravar | ring ]. apply roundedModeMoreMult with (P := P); auto. rewrite <- (Ropp_involutive r); rewrite <- (Faux.Rabsolu_left1 r); auto. replace (Float (- 1%nat) (- dExp b)) with (Fopp (Float 1%nat (- dExp b))). unfold FtoRradix in |- *; rewrite Fopp_correct; auto with real. simpl in |- *; auto. apply Rlt_le; auto. apply Rlt_le; auto. apply (RleRoundedLessR0 P) with (r := r); auto. apply Rlt_le; auto. Qed. Theorem RleBoundRoundl : forall P, RoundedModeP b radix P -> forall (p q : float) (r : R), Fbounded b p -> (p <= r)%R -> P r q -> (p <= q)%R. intros P H' p q r H'0 H'1 H'2; case H'1; intros H'3. cut (MonotoneP radix P); [ intros Mn | apply RoundedModeP_inv4 with (1 := H'); auto ]. apply (Mn p r); auto. apply RoundedModeProjectorIdem with (P := P); auto. rewrite RoundedModeProjectorIdemEq with (P := P) (p := p) (q := q); auto with real. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ]. apply (Cp r p q); auto. apply RoundedModeBounded with (P := P) (r := r); auto. Qed. Theorem RleBoundRoundr : forall P, RoundedModeP b radix P -> forall (p q : float) (r : R), Fbounded b p -> (r <= p)%R -> P r q -> (q <= p)%R. intros P H' p q r H'0 H'1 H'2; case H'1; intros H'3. cut (MonotoneP radix P); [ intros Mn | apply RoundedModeP_inv4 with (1 := H'); auto ]. apply (Mn r p); auto. apply RoundedModeProjectorIdem with (P := P); auto. rewrite RoundedModeProjectorIdemEq with (P := P) (p := p) (q := q); auto with real. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ]. apply (Cp r p q); auto. apply RoundedModeBounded with (P := P) (r := r); auto. Qed. Theorem RoundAbsMonotoner : forall (P : R -> float -> Prop) (p : R) (q r : float), RoundedModeP b radix P -> Fbounded b r -> P p q -> (Rabs p <= r)%R -> (Rabs q <= r)%R. intros P p q r H' H'0 H'1 H'2. case (Rle_or_lt 0 p); intros Rl1. rewrite Rabs_right; auto with real. apply RleBoundRoundr with (P := P) (r := p); auto with real. rewrite <- (Rabs_right p); auto with real. apply Rle_ge; apply RleRoundedR0 with (P := P) (r := p); auto. rewrite Faux.Rabsolu_left1; auto. rewrite <- (Ropp_involutive r); apply Ropp_le_contravar. rewrite <- (Fopp_correct radix); auto. apply RleBoundRoundl with (P := P) (r := p); auto with float. rewrite (Fopp_correct radix); rewrite <- (Ropp_involutive p); rewrite <- (Faux.Rabsolu_left1 p); auto with real; apply Rlt_le; auto. apply RleRoundedLessR0 with (P := P) (r := p); auto; apply Rlt_le; auto. Qed. Theorem RoundAbsMonotonel : forall (P : R -> float -> Prop) (p : R) (q r : float), RoundedModeP b radix P -> Fbounded b r -> P p q -> (r <= Rabs p)%R -> (r <= Rabs q)%R. intros P p q r H' H'0 H'1 H'2. case (Rle_or_lt 0 p); intros Rl1. rewrite Rabs_right; auto. apply RleBoundRoundl with (P := P) (r := p); auto. rewrite <- (Rabs_right p); auto with real. apply Rle_ge; apply RleRoundedR0 with (P := P) (r := p); auto. rewrite Faux.Rabsolu_left1; auto. rewrite <- (Ropp_involutive r); apply Ropp_le_contravar. rewrite <- (Fopp_correct radix); auto. apply RleBoundRoundr with (P := P) (r := p); auto with float. rewrite (Fopp_correct radix); rewrite <- (Ropp_involutive p); rewrite <- (Faux.Rabsolu_left1 p); auto with real; apply Rlt_le; auto. apply RleRoundedLessR0 with (P := P) (r := p); auto; apply Rlt_le; auto. Qed. (* Rounded of natural numbers are natural *) Theorem ZroundZ : forall (P : R -> float -> Prop) (z : Z) (p : float), RoundedModeP b radix P -> P z p -> exists z' : Z, p = z' :>R. intros P z p HP H'. case (RoundedModeRep b radix precision) with (P := P) (p := Float z 0%nat) (q := p); auto. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := HP); auto ]; auto. apply Cp with (1 := H'); auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite Rmult_1_r; auto. apply RoundedModeBounded with (P := P) (r := IZR z); auto. intros x H'0; exists x; auto. unfold FtoRradix in |- *; rewrite H'0. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite Rmult_1_r; auto. Qed. Theorem NroundN : forall (P : R -> float -> Prop) (n : nat) (p : float), RoundedModeP b radix P -> P n p -> exists n' : nat, p = n' :>R. intros P n p HP H'. case (ZroundZ P (Z_of_nat n) p); auto. repeat rewrite <- INR_IZR_INZ; auto. intros x H'0; exists (Z.abs_nat x). rewrite <- (inj_abs x) in H'0. rewrite H'0. repeat rewrite <- INR_IZR_INZ; auto. apply le_IZR; simpl in |- *. rewrite <- H'0; auto. apply RleRoundedR0 with (P := P) (r := INR n); auto. replace 0%R with (INR 0); auto with real arith. Qed. (* Properties of LSB and MSB *) Theorem FUlp_Le_LSigB : forall x : float, Fbounded b x -> (Fulp x <= Float 1%nat (LSB radix x))%R. intros x H; unfold is_Fzero, Fulp, Fnormalize in |- *; case (Z_zerop (Fnum x)); intros ZH. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite Rmult_1_l. apply Rle_powerRZ. replace 1%R with (INR 1); auto with real arith. apply Z.le_trans with (Fexp x); auto. case H; auto. apply Fexp_le_LSB; auto. rewrite LSB_shift with (n := min (precision - Fdigit radix x) (Z.abs_nat (dExp b + Fexp x))); auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite Rmult_1_l. apply Rle_powerRZ; auto with arith. replace 1%R with (INR 1); auto with real arith. exact (Fexp_le_LSB radix (Fshift radix (min (precision - Fdigit radix x) (Z.abs_nat (dExp b + Fexp x))) x)). Qed. Theorem MSBisMin : forall f1 f2 : float, (0 <= f1)%R -> isMin b radix f1 f2 -> ~ is_Fzero f1 -> ~ is_Fzero f2 -> MSB radix f1 = MSB radix f2. intros f1 f2 H' H'0 H'1 H'2. apply Zle_antisym. 2: apply MSB_monotone; auto. 2: repeat rewrite Fabs_correct1; auto with arith. 2: apply isMin_inv1 with (1 := H'0). 2: apply RleRoundedR0 with (P := isMin b radix) (r := FtoRradix f1); auto. 2: apply MinRoundedModeP with (precision := precision); auto. case (Zle_or_lt (MSB radix f1) (MSB radix f2)); auto. intros H'3; absurd (Float 1%nat (Z.succ (MSB radix f2)) <= f2)%R. apply Rgt_not_le. red in |- *; unfold FtoRradix in |- *; rewrite <- Fabs_correct1; auto with float arith. apply abs_lt_MSB; auto. apply RleRoundedR0 with (P := isMin b radix) (r := FtoRradix f1); auto with float. apply MinRoundedModeP with (precision := precision); auto. case H'0. intros H'4 H'5; elim H'5; intros H'6 H'7; apply H'7; clear H'5; auto. apply (FboundedOne _ radixMoreThanOne b precision); auto with arith. apply Z.le_trans with (Fexp f2). case H'4; auto. apply Z.le_trans with (MSB radix f2); auto with zarith. apply Fexp_le_MSB; auto. apply Rle_trans with (FtoR radix (Float 1%nat (MSB radix f1))); auto. apply oneExp_le; auto with zarith. unfold FtoRradix in |- *; rewrite <- Fabs_correct1 with (x := f1); auto with float arith. apply MSB_le_abs; auto. Qed. Theorem MSBtoZero : forall f1 f2 : float, ToZeroP b radix f1 f2 -> ~ is_Fzero f1 -> ~ is_Fzero f2 -> MSB radix f1 = MSB radix f2. intros f1 f2 H' H'0 H'1; Casec H'; intros tmp; Elimc tmp; intros H1 H2. apply MSBisMin; auto. rewrite (MSB_opp radix f1). rewrite (MSB_opp radix f2). apply MSBisMin; auto with float. unfold FtoRradix in |- *; rewrite Fopp_correct. replace 0%R with (-0)%R; auto with real. unfold FtoRradix in |- *; rewrite Fopp_correct; auto with float. Qed. Theorem MSBBoundNotZero : forall P : R -> float -> Prop, RoundedModeP b radix P -> forall f1 f2 : float, P f1 f2 -> f1 <> 0%R :>R -> (- dExp b <= MSB radix f1)%Z -> f2 <> 0%R :>R. intros P H' f1 f2 H'0 H'1 H'2. case (Rle_or_lt 0 f1); intros Rl1. apply Rlt_dichotomy_converse; right; red in |- *. apply Rlt_le_trans with (r2 := FtoRradix (Float 1%nat (MSB radix f1))); auto. unfold FtoRradix, FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real arith. cut (Float 1%nat (MSB radix f1) <= Fabs f1)%R; unfold FtoRradix in |- *; [ rewrite Fabs_correct; auto with arith; rewrite Rabs_right; auto with real; intros Rl2; Casec Rl2; intros Rl2 | apply MSB_le_abs ]; auto. cut (MonotoneP radix P); [ intros Mn | apply RoundedModeP_inv4 with (1 := H'); auto ]. apply (Mn (Float 1%nat (MSB radix f1)) f1); auto. apply RoundedModeProjectorIdem; auto. apply (FboundedOne radix) with (precision := precision); auto with real zarith arith. replace (FtoR radix f2) with (FtoR radix (Float 1%nat (MSB radix f1))); auto with float real. apply RoundedModeProjectorIdemEq with (P := P); auto. apply (FboundedOne radix) with (precision := precision); auto with real zarith arith. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ]. apply (Cp f1) with (p := f2); auto. apply RoundedModeBounded with (P := P) (r := FtoRradix f1); auto. Contradict H'1; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto. apply Rlt_dichotomy_converse; left. apply Rle_lt_trans with (r2 := FtoRradix (Float (- 1%nat) (MSB radix f1))); auto. cut (MonotoneP radix P); [ intros Mn | apply RoundedModeP_inv4 with (1 := H'); auto ]. cut (f1 <= Float (- 1%nat) (MSB radix f1))%R; [ intros Rle1; Casec Rle1; intros Rle1 | idtac ]. apply (Mn f1 (Float (- 1%nat) (MSB radix f1))); auto. apply RoundedModeProjectorIdem; auto. apply oppBoundedInv; unfold Fopp in |- *; simpl in |- *. apply (FboundedOne radix) with (precision := precision); auto with real zarith arith. replace (FtoRradix f2) with (FtoRradix (Float (- 1%nat) (MSB radix f1))); auto with real. apply RoundedModeProjectorIdemEq with (P := P); auto. apply oppBoundedInv; unfold Fopp in |- *; simpl in |- *. apply (FboundedOne _ radixMoreThanOne b precision); auto with real zarith arith. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ]. apply (Cp f1) with (p := f2); auto. apply RoundedModeBounded with (P := P) (r := FtoRradix f1); auto. replace (FtoRradix f1) with (- FtoRradix (Fabs f1))%R. replace (Float (- 1%nat) (MSB radix f1)) with (Fopp (Float 1%nat (MSB radix f1))). unfold FtoRradix in |- *; rewrite Fopp_correct; auto. apply Ropp_le_contravar; apply MSB_le_abs; auto. Contradict H'1; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto. unfold Fopp in |- *; simpl in |- *; auto. unfold FtoRradix in |- *; rewrite Fabs_correct; auto with arith; rewrite Faux.Rabsolu_left1; try apply Rlt_le; auto; ring. replace (Float (- 1%nat) (MSB radix f1)) with (Fopp (Float 1%nat (MSB radix f1))); [ idtac | unfold Fopp in |- *; simpl in |- *; auto ]. replace 0%R with (-0)%R; [ idtac | ring ]. unfold FtoRradix in |- *; repeat rewrite Fopp_correct; apply Ropp_lt_contravar. unfold FtoR in |- *; simpl in |- *; rewrite Rmult_1_l; auto with real arith. Qed. Theorem RoundMSBmax : forall (P : R -> float -> Prop) (p q : float), RoundedModeP b radix P -> P p q -> p <> 0%R :>R -> (- dExp b <= MSB radix p)%Z -> (MSB radix q <= Z.succ (MSB radix p))%Z. intros P p q H' H'0 H'1 H'2. apply (oneExp_Zle radix); auto. apply Rle_trans with (FtoRradix (Fabs q)). unfold FtoRradix in |- *; apply MSB_le_abs; auto. red in |- *; intros H'3; absurd (q = 0%R :>R). apply MSBBoundNotZero with (P := P) (f1 := p); auto. apply (is_Fzero_rep1 radix); auto. unfold FtoRradix in |- *; rewrite Fabs_correct; auto with arith; fold FtoRradix in |- *. apply RoundAbsMonotoner with (P := P) (p := FtoRradix p); auto. apply (FboundedOne _ radixMoreThanOne b precision); auto with zarith. unfold FtoRradix in |- *; rewrite <- (Fabs_correct radix); auto with arith. apply Rlt_le; apply abs_lt_MSB; auto. Qed. Theorem RoundMSBmin : forall (P : R -> float -> Prop) (p q : float), RoundedModeP b radix P -> P p q -> p <> 0%R :>R -> (- dExp b <= MSB radix p)%Z -> (MSB radix p <= MSB radix q)%Z. intros P p q H' H'0 H'1 H'2. replace (MSB radix p) with (MSB radix (Float 1%nat (MSB radix p))). apply MSB_monotone; auto. unfold is_Fzero in |- *; simpl in |- *; red in |- *; intros; discriminate. red in |- *; intros H'3; absurd (q = 0%R :>R). apply MSBBoundNotZero with (P := P) (f1 := p); auto. unfold FtoRradix in |- *; apply is_Fzero_rep1; auto. replace (Fabs (Float 1%nat (MSB radix p))) with (Float 1%nat (MSB radix p)); [ idtac | unfold Fabs in |- *; simpl in |- *; auto ]. rewrite Fabs_correct; auto with arith; fold FtoRradix in |- *. apply RoundAbsMonotonel with (P := P) (p := FtoRradix p); auto. apply (FboundedOne _ radixMoreThanOne b precision); auto with zarith. unfold FtoRradix in |- *; rewrite <- (Fabs_correct radix); auto with arith; apply MSB_le_abs; auto. Contradict H'1; unfold FtoRradix in |- *; apply is_Fzero_rep1; auto. unfold MSB, Fdigit in |- *; simpl in |- *. case (Z.pred (digit radix (Fnum p) + Fexp p)); simpl in |- *; auto with zarith. intros p0; case p0; simpl in |- *; auto. intros p1; elim p1; simpl in |- *; auto. intros p2 H; injection H; intros H1; rewrite <- H1; auto. intros p0; case p0; simpl in |- *; auto. intros p1; case p1; simpl in |- *; auto. intros p2; elim p2; simpl in |- *; auto. intros p3 H; injection H; intros H1; rewrite H1; auto. Qed. Theorem RoundLSBMax : forall (P : R -> float -> Prop) (p q : float), RoundedModeP b radix P -> P p q -> ~ is_Fzero q -> (LSB radix p <= LSB radix q)%Z. intros P p q H' H'0 H'2. elim (LSB_rep_min radix) with (p := p); auto; intros z E. case (RoundedModeRep b radix precision) with (P := P) (p := Float z (LSB radix p)) (q := q); auto. cut (CompatibleP b radix P); [ intros Cp | apply RoundedModeP_inv2 with (1 := H'); auto ]. apply (Cp p (Float z (LSB radix p)) q); auto. apply RoundedModeBounded with (P := P) (r := FtoRradix p); auto. intros x H'3. replace (LSB radix p) with (Fexp (Float x (LSB radix p))); [ idtac | simpl in |- *; auto ]. replace (LSB radix q) with (LSB radix (Float x (LSB radix p))). apply Fexp_le_LSB. apply LSB_comp; auto. apply NisFzeroComp with (radix := radix) (x := q); auto. Qed. (* General theorem about the binade *) Theorem InBinade : forall (P : R -> float -> Prop) (p q r : float) (e : Z), RoundedModeP b radix P -> Fbounded b p -> Fbounded b q -> P (p + q)%R r -> (- dExp b <= e)%Z -> (Float (Zpower_nat radix (pred precision)) e <= p)%R -> (p <= Float (pPred (vNum b)) e)%R -> (0%nat < q)%R -> (q < powerRZ radix e)%R -> r = p :>R \/ r = (p + powerRZ radix e)%R :>R. intros P p q r e Rp H' H'0 H'1 H'2 H'3 H'4 H'5 H'6. cut (p < p + q)%R; [ intros Rlt1 | idtac ]. cut (p + q < FNSucc b radix precision p)%R; [ intros Rlt2 | idtac ]. cut (isMin b radix (p + q) p); [ intros Min1 | idtac ]. cut (isMax b radix (p + q) (FNSucc b radix precision p)); [ intros Max1 | idtac ]. cut (MinOrMaxP b radix P); [ intros MinOrMax | apply RoundedModeP_inv3 with (1 := Rp); auto ]. case (MinOrMax (p + q)%R r); auto; intros H1. left. apply (MinUniqueP b radix (p + q)%R); auto. right. cut ((p + powerRZ radix e)%R = FNSucc b radix precision p); [ intros Eq1; rewrite Eq1 | idtac ]. apply (MaxUniqueP b radix (p + q)%R); auto. replace (FtoRradix (FNSucc b radix precision p)) with (Fnormalize radix b precision p + (FNSucc b radix precision p - Fnormalize radix b precision p))%R; [ idtac | ring ]. unfold FNSucc in |- *; rewrite <- (Fminus_correct radix); auto with arith; rewrite (FSuccDiff1 b radix precision); auto with arith. rewrite (boundedNorMinGivesExp radix) with (x := e); auto with zarith. rewrite (FnormalizeCorrect radix); auto; unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. apply sym_not_equal; apply Zlt_not_eq. apply Z.le_lt_trans with 0%Z; auto with zarith. replace 0%Z with (- (0))%Z; auto with zarith; apply Zle_Zopp; apply Zlt_le_weak; apply nNormPos; auto with zarith. apply (LtR0Fnum radix); auto. rewrite FnormalizeCorrect; fold FtoRradix in |- *; auto. apply Rlt_le_trans with (2 := H'3). apply (LtFnumZERO radix); simpl in |- *; (replace 0%Z with (Z_of_nat 0); auto with zarith arith). apply MinMax; auto with arith. Contradict Rlt1. rewrite Rlt1; auto with real. apply MinBinade with (precision := precision); auto with arith. apply Rlt_le; auto. replace (FtoRradix (FNSucc b radix precision p)) with (Fnormalize radix b precision p + (FNSucc b radix precision p - Fnormalize radix b precision p))%R; [ idtac | ring ]. unfold FNSucc in |- *; rewrite <- (Fminus_correct radix); auto with arith; rewrite (FSuccDiff1 b radix precision); auto with arith. rewrite (boundedNorMinGivesExp radix) with (x := e); auto with zarith. rewrite (FnormalizeCorrect radix); auto; fold FtoRradix in |- *. replace (FtoRradix (Float 1%nat e)) with (powerRZ radix e); auto with real. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. apply sym_not_equal; apply Zlt_not_eq. apply Z.le_lt_trans with 0%Z; auto with zarith. replace 0%Z with (- (0))%Z; auto with zarith; apply Zle_Zopp; apply Zlt_le_weak; apply nNormPos; auto with zarith. apply (LtR0Fnum radix); auto. rewrite FnormalizeCorrect; fold FtoRradix in |- *; auto. apply Rlt_le_trans with (2 := H'3). apply (LtFnumZERO radix); simpl in |- *; (replace 0%Z with (Z_of_nat 0); auto with zarith arith). pattern (FtoRradix p) at 1 in |- *; replace (FtoRradix p) with (p + 0)%R; [ idtac | ring ]. apply Rplus_lt_compat_l; auto. Qed. End FRoundP. Hint Resolve FulpSucCan FulpSuc FulpPredCan FulpPred: float.float-8.10.0/LICENSE000066400000000000000000000635001357127175600137340ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! float-8.10.0/MSB.v000066400000000000000000000461311357127175600135400ustar00rootroot00000000000000(**************************************************************************** IEEE754 : MSB Laurent Thery ******************************************************************************) Require Export Fprop. Require Export Zdivides. Require Export Fnorm. Section mf. Variable radix : Z. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Let FtoRradix := FtoR radix. Local Coercion FtoRradix : float >-> R. Fixpoint maxDiv (v : Z) (p : nat) {struct p} : nat := match p with | O => 0 | S p' => match ZdividesP v (Zpower_nat radix p) with | left _ => p | right _ => maxDiv v p' end end. Theorem maxDivLess : forall (v : Z) (p : nat), maxDiv v p <= p. intros v p; elim p; simpl in |- *; auto. intros n H'; case (ZdividesP v (radix * Zpower_nat radix n)); auto. Qed. Theorem maxDivLt : forall (v : Z) (p : nat), ~ Zdivides v (Zpower_nat radix p) -> maxDiv v p < p. intros v p; case p; simpl in |- *; auto. intros H'; case H'. apply Zdivides1. intros n H'; case (ZdividesP v (radix * Zpower_nat radix n)); auto. intros H'0; case H'; auto. intros H'0; generalize (maxDivLess v n); auto with arith. Qed. Theorem maxDivCorrect : forall (v : Z) (p : nat), Zdivides v (Zpower_nat radix (maxDiv v p)). intros v p; elim p. unfold maxDiv in |- *; rewrite Zpower_nat_O; auto. apply Zdivides1. simpl in |- *. intros n H'; case (ZdividesP v (radix * Zpower_nat radix n)); simpl in |- *; auto with zarith. Qed. Theorem maxDivSimplAux : forall (v : Z) (p q : nat), p = maxDiv v (S (q + p)) -> p = maxDiv v (S p). intros v p q; elim q. simpl in |- *; case (ZdividesP v (radix * Zpower_nat radix p)); auto. intros n H' H'0. apply H'; auto; clear H'. simpl in H'0; generalize H'0; clear H'0. case (ZdividesP v (radix * (radix * Zpower_nat radix (n + p)))). 2: simpl in |- *; auto. intros H' H'0; Contradict H'0; auto with zarith. Qed. Theorem maxDivSimpl : forall (v : Z) (p q : nat), p < q -> p = maxDiv v q -> p = maxDiv v (S p). intros v p q H' H'0. apply maxDivSimplAux with (q := q - S p); auto. replace (S (q - S p + p)) with q; auto with zarith. Qed. Theorem maxDivSimplInvAux : forall (v : Z) (p q : nat), p = maxDiv v (S p) -> p = maxDiv v (S (q + p)). intros v p q H'; elim q. simpl in |- *; auto. intros n; simpl in |- *. case (ZdividesP v (radix * Zpower_nat radix (n + p))); auto. case (ZdividesP v (radix * (radix * Zpower_nat radix (n + p)))); auto. intros H'0 H'1 H'2; Contradict H'2; auto with zarith. case (ZdividesP v (radix * (radix * Zpower_nat radix (n + p)))); auto. intros H'0 H'1 H'2; case H'1. case H'0; intros z1 Hz1; exists (radix * z1)%Z;rewrite Hz1. unfold Zpower_nat; simpl; ring. Qed. Theorem maxDivSimplInv : forall (v : Z) (p q : nat), p < q -> p = maxDiv v (S p) -> p = maxDiv v q. intros v p q H' H'0. replace q with (S (q - S p + p)); auto with zarith. apply maxDivSimplInvAux; auto. Qed. Theorem maxDivUnique : forall (v : Z) (p : nat), p = maxDiv v (S p) -> Zdivides v (Zpower_nat radix p) /\ ~ Zdivides v (Zpower_nat radix (S p)). intros v p H'; split. rewrite H'. apply maxDivCorrect; auto. red in |- *; intros H'0; generalize H'; clear H'. simpl in |- *. case (ZdividesP v (radix * Zpower_nat radix p)); simpl in |- *; auto. intros H' H'1; Contradict H'1; auto with zarith. Qed. Theorem maxDivUniqueDigit : forall v : Z, v <> 0 -> Zdivides v (Zpower_nat radix (maxDiv v (digit radix v))) /\ ~ Zdivides v (Zpower_nat radix (S (maxDiv v (digit radix v)))). intros v H'. apply maxDivUnique; auto. apply maxDivSimpl with (q := digit radix v); auto. apply maxDivLt; auto. apply NotDividesDigit; auto. Qed. Theorem maxDivUniqueInverse : forall (v : Z) (p : nat), Zdivides v (Zpower_nat radix p) -> ~ Zdivides v (Zpower_nat radix (S p)) -> p = maxDiv v (S p). intros v p H' H'0; simpl in |- *. case (ZdividesP v (radix * Zpower_nat radix p)); auto. intros H'1; case H'0; simpl in |- *; auto. intros H'1. generalize H'; case p; simpl in |- *; auto. intros n H'2; case (ZdividesP v (radix * Zpower_nat radix n)); auto. intros H'3; case H'3; auto. Qed. Theorem maxDivUniqueInverseDigit : forall (v : Z) (p : nat), v <> 0 -> Zdivides v (Zpower_nat radix p) -> ~ Zdivides v (Zpower_nat radix (S p)) -> p = maxDiv v (digit radix v). intros v p H' H'0 H'1. apply maxDivSimplInv; auto. 2: apply maxDivUniqueInverse; auto. apply Zpower_nat_anti_monotone_lt with (n := radix); auto. apply Z.le_lt_trans with (m := Z.abs v); auto. rewrite <- (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith; apply ZDividesLe; auto. apply digitMore; auto. Qed. Theorem maxDivPlus : forall (v : Z) (n : nat), v <> 0 -> maxDiv (v * Zpower_nat radix n) (digit radix v + n) = maxDiv v (digit radix v) + n. intros v n H. replace (digit radix v + n) with (digit radix (v * Zpower_nat radix n)); auto. apply sym_equal. apply maxDivUniqueInverseDigit; auto. red in |- *; intros Z1; case (Zmult_integral _ _ Z1); intros Z2. case H; auto. absurd (0 < Zpower_nat radix n)%Z; auto with zarith. rewrite Zpower_nat_is_exp. repeat rewrite (fun x : Z => Zmult_comm x (Zpower_nat radix n)). apply ZdividesMult; auto. case (maxDivUniqueDigit v); auto. replace (S (maxDiv v (digit radix v) + n)) with (S (maxDiv v (digit radix v)) + n); auto. rewrite Zpower_nat_is_exp. repeat rewrite (fun x : Z => Zmult_comm x (Zpower_nat radix n)). red in |- *; intros H'. absurd (Zdivides v (Zpower_nat radix (S (maxDiv v (digit radix v))))). case (maxDivUniqueDigit v); auto. apply ZdividesDiv with (p := Zpower_nat radix n); auto with zarith. apply digitAdd; auto with zarith. Qed. Definition LSB (x : float) := (Z_of_nat (maxDiv (Fnum x) (Fdigit radix x)) + Fexp x)%Z. Theorem LSB_shift : forall (x : float) (n : nat), ~ is_Fzero x -> LSB x = LSB (Fshift radix n x). intros x n H'; unfold LSB, Fdigit in |- *; simpl in |- *. rewrite digitAdd; auto with arith. rewrite maxDivPlus; auto. rewrite inj_plus; ring. Qed. Theorem LSB_comp : forall (x y : float) (n : nat), ~ is_Fzero x -> x = y :>R -> LSB x = LSB y. intros x y H' H'0 H'1. case (FshiftCorrectSym radix) with (2 := H'1); auto. intros m1 H'2; elim H'2; intros m2 E; clear H'2. rewrite (LSB_shift x m1); auto. rewrite E; auto. apply sym_equal; apply LSB_shift; auto. apply (NisFzeroComp radix) with (x := x); auto. Qed. Theorem maxDiv_opp : forall (v : Z) (p : nat), maxDiv v p = maxDiv (- v) p. intros v p; elim p; simpl in |- *; auto. intros n H; case (ZdividesP v (radix * Zpower_nat radix n)); case (ZdividesP (- v) (radix * Zpower_nat radix n)); auto. intros Z1 Z2; case Z1. case Z2; intros z1 Hz1; exists (- z1)%Z; rewrite Hz1; ring. intros Z1 Z2; case Z2. case Z1; intros z1 Hz1; exists (- z1)%Z. rewrite <- (Z.opp_involutive v); rewrite Hz1; ring. Qed. Theorem LSB_opp : forall x : float, LSB x = LSB (Fopp x). intros x; unfold LSB in |- *; simpl in |- *. rewrite Fdigit_opp; auto. rewrite maxDiv_opp; auto. Qed. Theorem maxDiv_abs : forall (v : Z) (p : nat), maxDiv v p = maxDiv (Z.abs v) p. intros v p; elim p; simpl in |- *; auto. intros n H; case (ZdividesP v (radix * Zpower_nat radix n)); case (ZdividesP (Z.abs v) (radix * Zpower_nat radix n)); auto. intros Z1 Z2; case Z1. case Z2; intros z1 Hz1; exists (Z.abs z1); rewrite Hz1. rewrite Zabs_Zmult; f_equal. apply Z.abs_eq. auto with zarith. intros Z1 Z2; case Z2. case Z1; intros z1 Hz1. case (Zle_or_lt v 0); intros Z4. exists (- z1)%Z; rewrite <- (Z.opp_involutive v); rewrite <- (Zabs_eq_opp v); auto; rewrite Hz1; ring. exists z1; rewrite <- (Z.abs_eq v); auto with zarith; rewrite Hz1; ring. Qed. Theorem LSB_abs : forall x : float, LSB x = LSB (Fabs x). intros x; unfold LSB in |- *; simpl in |- *. rewrite Fdigit_abs; auto. rewrite maxDiv_abs; auto. Qed. Definition MSB (x : float) := Z.pred (Z_of_nat (Fdigit radix x) + Fexp x). Theorem MSB_shift : forall (x : float) (n : nat), ~ is_Fzero x -> MSB x = MSB (Fshift radix n x). intros; unfold MSB, Fshift, Fdigit in |- *; simpl in |- *. rewrite digitAdd; auto with zarith. rewrite inj_plus; unfold Z.pred in |- *; ring. Qed. Theorem MSB_comp : forall (x y : float) (n : nat), ~ is_Fzero x -> x = y :>R -> MSB x = MSB y. intros x y H' H'0 H'1. case (FshiftCorrectSym radix) with (2 := H'1); auto. intros m1 H'2; elim H'2; intros m2 E; clear H'2. rewrite (MSB_shift x m1); auto. rewrite E; auto. apply sym_equal; apply MSB_shift; auto. apply (NisFzeroComp radix) with (x := x); auto. Qed. Theorem MSB_opp : forall x : float, MSB x = MSB (Fopp x). intros x; unfold MSB in |- *; simpl in |- *. rewrite Fdigit_opp; auto. Qed. Theorem MSB_abs : forall x : float, MSB x = MSB (Fabs x). intros x; unfold MSB in |- *; simpl in |- *. rewrite Fdigit_abs; auto. Qed. Theorem LSB_le_MSB : forall x : float, ~ is_Fzero x -> (LSB x <= MSB x)%Z. intros x H'; unfold LSB, MSB in |- *. apply Zle_Zpred. cut (maxDiv (Fnum x) (Fdigit radix x) < Fdigit radix x); auto with zarith. apply maxDivLt; auto. unfold Fdigit in |- *; apply NotDividesDigit; auto. Qed. Theorem Fexp_le_LSB : forall x : float, (Fexp x <= LSB x)%Z. intros x; unfold LSB in |- *. auto with zarith. Qed. Theorem Ulp_Le_LSigB : forall x : float, (Float 1%nat (Fexp x) <= Float 1%nat (LSB x))%R. intros x; apply (oneExp_le radix); auto. apply Fexp_le_LSB; auto. Qed. Theorem Fexp_le_MSB : forall x : float, ~ is_Fzero x -> (Fexp x <= MSB x)%Z. intros x H'; unfold MSB in |- *. cut (Fdigit radix x <> 0%Z :>Z); unfold Z.pred in |- *; auto with zarith. unfold Fdigit in |- *. red in |- *; intros H'0; absurd (digit radix (Fnum x) = 0); auto with zarith. apply not_eq_sym; apply lt_O_neq; apply digitNotZero; auto. Qed. Theorem MSB_le_abs : forall x : float, ~ is_Fzero x -> (Float 1%nat (MSB x) <= Fabs x)%R. intros x H'; unfold MSB, FtoRradix, FtoR in |- *; simpl in |- *. replace (Z.pred (Fdigit radix x + Fexp x)) with (Z.pred (Fdigit radix x) + Fexp x)%Z; [ idtac | unfold Z.pred in |- *; ring ]. rewrite powerRZ_add; auto with real zarith. rewrite Rmult_1_l. repeat rewrite (fun r : R => Rmult_comm r (powerRZ radix (Fexp x))). apply Rmult_le_compat_l; auto with real zarith. rewrite <- inj_pred; auto with real zarith. rewrite <- Zpower_nat_Z_powerRZ; auto. apply Rle_IZR; auto. unfold Fdigit in |- *; auto with arith. apply digitLess; auto. unfold Fdigit in |- *. apply not_eq_sym; apply lt_O_neq; apply digitNotZero; auto. Qed. Theorem abs_lt_MSB : forall x : float, (Fabs x < Float 1%nat (Z.succ (MSB x)))%R. intros x. rewrite (MSB_abs x). unfold MSB, FtoRradix, FtoR in |- *. rewrite <- Zsucc_pred; simpl in |- *. rewrite powerRZ_add; auto with real zarith. rewrite Rmult_1_l. repeat rewrite (fun r : R => Rmult_comm r (powerRZ radix (Fexp x))). apply Rmult_lt_compat_l; auto with real zarith. rewrite <- Zpower_nat_Z_powerRZ; auto with arith. apply Rlt_IZR. unfold Fdigit in |- *; auto with arith. unfold Fabs in |- *; simpl in |- *. pattern (Z.abs (Fnum x)) at 1 in |- *; rewrite <- (Z.abs_eq (Z.abs (Fnum x))); auto with zarith. Qed. Theorem LSB_le_abs : forall x : float, ~ is_Fzero x -> (Float 1%nat (LSB x) <= Fabs x)%R. intros x H'; apply Rle_trans with (FtoRradix (Float 1%nat (MSB x))). apply (oneExp_le radix); auto. apply LSB_le_MSB; auto. apply MSB_le_abs; auto. Qed. Theorem MSB_monotoneAux : forall x y : float, (Fabs x <= Fabs y)%R -> Fexp x = Fexp y -> (MSB x <= MSB y)%Z. intros x y H' H'0; unfold MSB in |- *. rewrite <- H'0. cut (Fdigit radix x <= Fdigit radix y)%Z; [ unfold Z.pred in |- *; auto with zarith | idtac ]. unfold Fdigit in |- *; apply inj_le. apply digit_monotone; auto. apply le_IZR. apply Rmult_le_reg_l with (r := powerRZ radix (Fexp x)); auto with real zarith. repeat rewrite (Rmult_comm (powerRZ radix (Fexp x))); auto. pattern (Fexp x) at 2 in |- *; rewrite H'0; auto. Qed. Theorem MSB_monotone : forall x y : float, ~ is_Fzero x -> ~ is_Fzero y -> (Fabs x <= Fabs y)%R -> (MSB x <= MSB y)%Z. intros x y H' H'0 H'1; rewrite (MSB_abs x); rewrite (MSB_abs y). case (Zle_or_lt (Fexp (Fabs x)) (Fexp (Fabs y))); simpl in |- *; intros Zle1. rewrite MSB_shift with (x := Fabs y) (n := Z.abs_nat (Fexp (Fabs y) - Fexp (Fabs x))). apply MSB_monotoneAux; auto. unfold FtoRradix in |- *; repeat rewrite Fabs_correct; auto with real arith. rewrite FshiftCorrect; auto with real arith. repeat rewrite Fabs_correct; auto with real arith. repeat rewrite Rabs_Rabsolu; repeat rewrite <- Fabs_correct; auto with real arith. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; [ ring | auto with zarith ]. apply Fabs_Fzero; auto. rewrite MSB_shift with (x := Fabs x) (n := Z.abs_nat (Fexp (Fabs x) - Fexp (Fabs y))). apply MSB_monotoneAux; auto. unfold FtoRradix in |- *; repeat rewrite Fabs_correct; auto with real arith. rewrite FshiftCorrect; auto with real arith. repeat rewrite Fabs_correct; auto with real arith. repeat rewrite Rabs_Rabsolu; repeat rewrite <- Fabs_correct; auto with real arith. unfold Fshift in |- *; simpl in |- *. rewrite inj_abs; [ ring | auto with zarith ]. apply Fabs_Fzero; auto. Qed. Theorem MSB_le_multAux : forall x y : float, ~ is_Fzero x -> ~ is_Fzero y -> (MSB x + MSB y <= MSB (Fmult x y))%Z. intros x y H' H'0; unfold MSB, Fmult, Fdigit in |- *; simpl in |- *. replace (Z.pred (digit radix (Fnum x) + Fexp x) + Z.pred (digit radix (Fnum y) + Fexp y))%Z with (Z.pred (digit radix (Fnum x) + Z.pred (digit radix (Fnum y)) + (Fexp x + Fexp y))); [ idtac | unfold Z.pred in |- *; ring ]. cut (digit radix (Fnum x) + Z.pred (digit radix (Fnum y)) <= digit radix (Fnum x * Fnum y))%Z; [ unfold Z.pred in |- *; auto with zarith | idtac ]. rewrite <- inj_pred; auto with float zarith; try rewrite <- inj_plus. apply inj_le. rewrite <- digitAdd; auto with zarith. apply digit_monotone; auto with zarith. repeat rewrite Zabs_Zmult. apply Zle_Zmult_comp_l; auto with zarith. rewrite (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith. apply not_eq_sym; apply lt_O_neq; apply digitNotZero; auto. Qed. Theorem MSB_le_mult : forall x y : float, ~ is_Fzero x -> ~ is_Fzero y -> (Fmult (Float 1%nat (MSB x)) (Float 1%nat (MSB y)) <= Float 1%nat (MSB (Fmult x y)))%R. intros x y H' H'0. rewrite <- oneZplus. apply (oneExp_le radix); auto. apply MSB_le_multAux; auto. Qed. Theorem mult_le_MSBAux : forall x y : float, ~ is_Fzero x -> ~ is_Fzero y -> (MSB (Fmult x y) <= Z.succ (MSB x + MSB y))%Z. intros x y H' H'0; unfold MSB, Fmult, Fdigit in |- *; simpl in |- *. replace (Z.succ (Z.pred (digit radix (Fnum x) + Fexp x) + Z.pred (digit radix (Fnum y) + Fexp y))) with (Z.pred (digit radix (Fnum x) + digit radix (Fnum y) + (Fexp x + Fexp y))); [ idtac | unfold Z.pred, Z.succ in |- *; ring ]. cut (digit radix (Fnum x * Fnum y) <= digit radix (Fnum x) + digit radix (Fnum y))%Z; [ unfold Z.pred in |- *; auto with zarith | idtac ]. rewrite <- inj_plus. apply inj_le; auto. rewrite <- digitAdd; auto with arith. apply digit_monotone; auto with arith. repeat rewrite Zabs_Zmult. apply Zle_Zmult_comp_l; auto with zarith. rewrite (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith. Qed. Theorem mult_le_MSB : forall x y : float, ~ is_Fzero x -> ~ is_Fzero y -> (Float 1%nat (MSB (Fmult x y)) <= radix * Fmult (Float 1%nat (MSB x)) (Float 1%nat (MSB y)))%R. intros x y H' H'0; rewrite <- oneZplus. replace (radix * Float 1%nat (MSB x + MSB y))%R with (FtoRradix (Float 1%nat (Z.succ (MSB x + MSB y)))). apply (oneExp_le radix); auto. apply mult_le_MSBAux; auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; ring. Qed. Theorem MSB_mix : forall x y : float, ~ is_Fzero x -> ~ is_Fzero y -> (Fabs x * Float 1%nat (MSB y) < radix * (Fabs y * Float 1%nat (MSB x)))%R. intros x y H' H'0; rewrite (MSB_abs x); rewrite (MSB_abs y). apply Rle_lt_trans with (Fabs x * Fabs y)%R; auto with real. apply Rmult_le_compat_l; auto with real. unfold FtoRradix in |- *; rewrite Fabs_correct; auto with real arith. rewrite <- MSB_abs; apply MSB_le_abs; auto. rewrite (Rmult_comm (Fabs x)). replace (radix * (Fabs y * Float 1%nat (MSB (Fabs x))))%R with (Fabs y * (radix * Float 1%nat (MSB (Fabs x))))%R; [ idtac | ring ]. apply Rmult_lt_compat_l; auto with real. unfold FtoRradix, FtoR in |- *; simpl in |- *; auto with real arith. rewrite Rmult_comm; replace 0%R with (powerRZ radix (Fexp y) * 0)%R; [ idtac | ring ]. apply Rmult_lt_compat_l; auto with real arith. rewrite Zabs_absolu. replace 0%R with (INR 0); [ idtac | simpl in |- *; auto ]; rewrite <- INR_IZR_INZ; apply INR_lt_nm. apply absolu_lt_nz; auto. replace (radix * Float 1%nat (MSB (Fabs x)))%R with (FtoRradix (Float 1%nat (Z.succ (MSB (Fabs x))))). rewrite <- MSB_abs; apply abs_lt_MSB; auto. unfold FtoRradix, FtoR in |- *; simpl in |- *. rewrite powerRZ_Zs; auto with real zarith; ring. Qed. Theorem LSB_rep : forall x y : float, ~ is_Fzero y -> (LSB x <= LSB y)%Z -> exists z : Z, y = Float z (Fexp x) :>R. intros x y H' H'0. case (Zle_or_lt (Fexp x) (Fexp y)); intros Zl1. exists (Fnum y * Zpower_nat radix (Z.abs_nat (Fexp y - Fexp x)))%Z. pattern (Fexp x) at 2 in |- *; replace (Fexp x) with (Fexp y - Z.abs_nat (Fexp y - Fexp x))%Z. unfold FtoRradix in |- *; rewrite <- (FshiftCorrect radix) with (n := Z.abs_nat (Fexp y - Fexp x)) (x := y); auto. rewrite inj_abs; try ring; auto with zarith. exists (Zquotient (Fnum y) (Zpower_nat radix (Z.abs_nat (Fexp x - Fexp y)))). unfold FtoRradix in |- *; rewrite <- (FshiftCorrect radix) with (n := Z.abs_nat (Fexp x - Fexp y)) (x := Float (Zquotient (Fnum y) (Zpower_nat radix (Z.abs_nat (Fexp x - Fexp y)))) (Fexp x)); auto. unfold Fshift in |- *; simpl in |- *. cut (0 <= Fexp x - Fexp y)%Z; [ intros Le1; repeat rewrite inj_abs | auto with zarith ]; auto. unfold FtoR in |- *; simpl in |- *; auto. replace (Fexp x - (Fexp x - Fexp y))%Z with (Fexp y); [ idtac | ring ]. replace (Zquotient (Fnum y) (Zpower_nat radix (Z.abs_nat (Fexp x - Fexp y))) * Zpower_nat radix (Z.abs_nat (Fexp x - Fexp y)))%Z with ( Fnum y); auto. apply ZdividesZquotient; auto with zarith. apply ZdividesTrans with (m := Zpower_nat radix (maxDiv (Fnum y) (Fdigit radix y))). apply maxDivCorrect. apply ZdividesLessPow; auto. apply ZleLe. rewrite inj_abs; auto with zarith. apply Zplus_le_reg_l with (p := Fexp y). apply Z.le_trans with (LSB x). replace (Fexp y + (Fexp x - Fexp y))%Z with (Fexp x); [ idtac | ring ]. apply Fexp_le_LSB. rewrite Zplus_comm; auto. Qed. Theorem LSB_rep_min : forall p : float, exists z : Z, p = Float z (LSB p) :>R. intros p; exists (Zquotient (Fnum p) (Zpower_nat radix (Z.abs_nat (LSB p - Fexp p)))). unfold FtoRradix, FtoR, LSB in |- *; simpl in |- *. rewrite powerRZ_add; auto with real zarith. rewrite <- Rmult_assoc. replace (maxDiv (Fnum p) (Fdigit radix p) + Fexp p - Fexp p)%Z with (Z_of_nat (maxDiv (Fnum p) (Fdigit radix p))); auto. rewrite absolu_INR. rewrite <- Zpower_nat_Z_powerRZ; auto with zarith. rewrite <- Rmult_IZR. rewrite <- ZdividesZquotient; auto with zarith. apply maxDivCorrect. ring. Qed. End mf.float-8.10.0/MSBProp.v000066400000000000000000000063001357127175600143730ustar00rootroot00000000000000(**************************************************************************** IEEE754 : MSBProp Laurent Thery, Sylvie Boldo ******************************************************************************) Require Export MSB. Section MSBProp. Variable b : Fbound. Variable precision : nat. Variable radix : Z. Let FtoRradix := FtoR radix. Coercion FtoRradix : float >-> R. Hypothesis radixMoreThanOne : (1 < radix)%Z. Let radixMoreThanZERO : (0 < radix)%Z := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne). Hint Resolve radixMoreThanZERO: zarith. Hypothesis precisionGreaterThanOne : 1 < precision. Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision. Theorem boundOnePrecision : forall a : float, Fbounded b a -> (Rabs a < Float 1%nat (precision + Fexp a))%R. intros a H. replace (FtoRradix (Float 1%nat (precision + Fexp a))) with (FtoRradix (Fshift radix precision (Float 1%nat (precision + Fexp a)))); [ idtac | apply (FshiftCorrect radix); auto ]. unfold Fshift, FtoRradix, FtoR in |- *; simpl in |- *. rewrite <- pGivesBound. replace (precision + Fexp a - precision)%Z with (Fexp a); [ idtac | ring ]. rewrite Rabs_mult; rewrite (fun x y => Rabs_pos_eq (powerRZ x y)); auto with real zarith. apply Rlt_monotony_exp; auto with float real zarith. rewrite Faux.Rabsolu_Zabs; auto with float real zarith. Qed. Theorem boundNormalMult : forall x y : float, Fnormal radix b x -> Fbounded b y -> (Rabs y * Float 1%nat (Fexp x) < radix * (Rabs x * Float 1%nat (Fexp y)))%R. intros x y H H0. apply Rlt_le_trans with (Float (Zpos (vNum b)) (Fexp y) * Float 1%nat (Fexp x))%R. apply Rmult_lt_compat_r. unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *. replace (1 * powerRZ radix (Fexp x))%R with (powerRZ radix (Fexp x)); [ idtac | ring ]. apply powerRZ_lt; auto with real arith. unfold FtoRradix in |- *; apply MaxFloat; auto. replace (Float (Zpos (vNum b)) (Fexp y) * Float 1%nat (Fexp x))%R with (Zpos (vNum b) * Float 1%nat (Fexp x) * Float 1%nat (Fexp y))%R. replace (radix * (Rabs x * Float 1%nat (Fexp y)))%R with (radix * Rabs x * Float 1%nat (Fexp y))%R; [ idtac | ring ]. apply Rmult_le_compat_r. unfold FtoRradix in |- *; unfold FtoR in |- *; simpl in |- *. replace (1 * powerRZ radix (Fexp y))%R with (powerRZ radix (Fexp y)); [ idtac | ring ]. apply powerRZ_le; auto with real arith. replace (Zpos (vNum b) * Float 1%nat (Fexp x))%R with (FtoRradix (Float (Zpos (vNum b)) (Fexp x))). rewrite <- (Fabs_correct radix); auto with real zarith. unfold Fabs, FtoRradix, FtoR in |- *. rewrite <- Rmult_assoc. apply Rle_monotone_exp; auto with real arith. rewrite <- Rmult_IZR; apply Rle_IZR; simpl in |- *. rewrite <- (Z.abs_eq radix); auto with zarith; rewrite <- Zabs_Zmult; auto with float. case H; simpl in |- *; auto. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. unfold FtoRradix, FtoR in |- *; simpl in |- *; ring. Qed. End MSBProp.float-8.10.0/Make000066400000000000000000000005131357127175600135220ustar00rootroot00000000000000-R . Float AllFloat.v Closest.v Closest2Plus.v Closest2Prop.v ClosestMult.v ClosestPlus.v ClosestProp.v Digit.v FPred.v FSucc.v Faux.v Fbound.v Fcomp.v Finduct.v Float.v Fmin.v Fnorm.v Fodd.v Fop.v Fprop.v Fround.v FroundMult.v FroundPlus.v FroundProp.v MSB.v MSBProp.v Option.v Paux.v Power.v Zdivides.v Zenum.v sTactic.v Rpow.v float-8.10.0/Makefile000066400000000000000000000003751357127175600143700ustar00rootroot00000000000000all: Makefile.coq +make -f Makefile.coq all clean: Makefile.coq +make -f Makefile.coq clean rm -f Makefile.coq Makefile.coq: Make $(COQBIN)coq_makefile -f Make -o Makefile.coq Make: ; %: Makefile.coq +make -f Makefile.coq $@ .PHONY: all clean float-8.10.0/Option.v000066400000000000000000000001631357127175600143620ustar00rootroot00000000000000(* Usual option type *) Inductive Option (A : Set) : Set := | Some : forall x : A, Option A | None : Option A.float-8.10.0/Paux.v000066400000000000000000001116241357127175600140340ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Paux Laurent Thery ******************************************************************************) Require Export Digit. Require Export Option. Require Export Inverse_Image. Require Export Wf_nat. Require Import BinPos. Fixpoint exp (n m : nat) {struct m} : nat := match m with | O => 1 | S m' => n * exp n m' end. Theorem expPlus : forall n p q : nat, exp n (p + q) = exp n p * exp n q. intros n p; elim p; simpl in |- *; auto with arith. intros n0 H' q; rewrite mult_assoc_reverse; rewrite <- H'; auto. Qed. Fixpoint positive_exp (p n : positive) {struct n} : positive := match n with | xH => p | xO n1 => match positive_exp p n1 with | r => (fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) r ( fun x => x) r end | xI n1 => match positive_exp p n1 with | r => (fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) p ( fun x => x) ((fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) r ( fun x => x) r) end end. Theorem positive_exp_correct : forall p n : positive, nat_of_P (positive_exp p n) = exp (nat_of_P p) (nat_of_P n). intros p n; elim n; simpl in |- *; auto. intros p0 H. repeat rewrite (fun (x y : positive) (_ : positive -> positive) => nat_of_P_mult_morphism x y); simpl in |- *; auto. rewrite ZL6; rewrite expPlus; rewrite H; auto. intros p0 H. repeat rewrite (fun (x y : positive) (_ : positive -> positive) => nat_of_P_mult_morphism x y); simpl in |- *; auto. rewrite H; rewrite <- expPlus; rewrite <- ZL6; auto. rewrite mult_comm; simpl in |- *; auto. Qed. Fixpoint Pdiv (p q : positive) {struct p} : Option positive * Option positive := match p with | xH => match q with | xH => (Some _ 1%positive, None _) | xO r => (None _, Some _ p) | xI r => (None _, Some _ p) end | xI p' => match Pdiv p' q with | (None, None) => match (1 - Zpos q)%Z with | Z0 => (Some _ 1%positive, None _) | Zpos r' => (Some _ 1%positive, Some _ r') | Zneg r' => (None _, Some _ 1%positive) end | (None, Some r1) => match (Zpos (xI r1) - Zpos q)%Z with | Z0 => (Some _ 1%positive, None _) | Zpos r' => (Some _ 1%positive, Some _ r') | Zneg r' => (None _, Some _ (xI r1)) end | (Some q1, None) => match (1 - Zpos q)%Z with | Z0 => (Some _ (xI q1), None _) | Zpos r' => (Some _ (xI q1), Some _ r') | Zneg r' => (Some _ (xO q1), Some _ 1%positive) end | (Some q1, Some r1) => match (Zpos (xI r1) - Zpos q)%Z with | Z0 => (Some _ (xI q1), None _) | Zpos r' => (Some _ (xI q1), Some _ r') | Zneg r' => (Some _ (xO q1), Some _ (xI r1)) end end | xO p' => match Pdiv p' q with | (None, None) => (None _, None _) | (None, Some r1) => match (Zpos (xO r1) - Zpos q)%Z with | Z0 => (Some _ 1%positive, None _) | Zpos r' => (Some _ 1%positive, Some _ r') | Zneg r' => (None _, Some _ (xO r1)) end | (Some q1, None) => (Some _ (xO q1), None _) | (Some q1, Some r1) => match (Zpos (xO r1) - Zpos q)%Z with | Z0 => (Some _ (xI q1), None _) | Zpos r' => (Some _ (xI q1), Some _ r') | Zneg r' => (Some _ (xO q1), Some _ (xO r1)) end end end. Definition oZ h := match h with | None => 0 | Some p => nat_of_P p end. Theorem Pdiv_correct : forall p q, nat_of_P p = oZ (fst (Pdiv p q)) * nat_of_P q + oZ (snd (Pdiv p q)) /\ oZ (snd (Pdiv p q)) < nat_of_P q. intros p q; elim p; simpl in |- *; auto. 3: case q; simpl in |- *; try intros q1; split; auto; unfold nat_of_P in |- *; simpl in |- *; auto with arith. intros p'; simpl in |- *; case (Pdiv p' q); simpl in |- *; intros q1 r1 (H1, H2); split. unfold nat_of_P in |- *; simpl in |- *. rewrite ZL6; rewrite H1. case q1; case r1; simpl in |- *. intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xI r2) q Datatypes.Eq); simpl in |- *; auto. intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *; unfold nat_of_P in |- *; simpl in |- *. apply f_equal with (f := S); repeat rewrite (fun x y => mult_comm x (S y)); repeat rewrite ZL6; unfold nat_of_P in |- *; simpl in |- *; ring. intros H3; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; apply f_equal with (f := S); ring. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4. apply trans_equal with (nat_of_P q + nat_of_P h + Pmult_nat q2 2 * Pmult_nat q 1); [ rewrite <- nat_of_P_plus_morphism; rewrite H5; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply f_equal with (f := S) | unfold nat_of_P in |- * ]; ring. intros r2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare 1 q Datatypes.Eq); simpl in |- *; auto. intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; simpl in |- *; apply f_equal with (f := S);ring. intros H3; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; apply f_equal with (f := S); repeat rewrite ZL6; unfold nat_of_P in |- *; simpl in |- *; ring. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply trans_equal with (nat_of_P q + nat_of_P h + Pmult_nat r2 2 * Pmult_nat q 1); [ rewrite <- nat_of_P_plus_morphism; rewrite H5; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply f_equal with (f := S) | unfold nat_of_P in |- * ]; ring. intros r2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xI r2) q Datatypes.Eq); simpl in |- *; auto. intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply f_equal with (f := S); ring. intros H3; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply f_equal with (f := S); ring. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply trans_equal with (nat_of_P q + nat_of_P h); [ rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply f_equal with (f := S) | unfold nat_of_P in |- * ]; ring. case q; simpl in |- *; auto. generalize H2; case q1; case r1; simpl in |- *; auto. intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xI r2) q Datatypes.Eq); simpl in |- *; auto. intros; apply lt_O_nat_of_P; auto. intros H H0; apply nat_of_P_lt_Lt_compare_morphism; auto. intros H3 H7; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply plus_lt_reg_l with (p := nat_of_P q); rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply le_lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1); auto with arith. intros r2 HH; case q; simpl in |- *; auto. intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *; auto with arith. intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *; auto with arith. intros r2 HH. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xI r2) q Datatypes.Eq); simpl in |- *. intros; apply lt_O_nat_of_P; auto. intros H3; apply nat_of_P_lt_Lt_compare_morphism; auto. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply plus_lt_reg_l with (p := nat_of_P q); rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply le_lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1); auto with arith. intros HH; case q; simpl in |- *; auto. intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *; auto with arith. intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *; auto with arith. intros p'; simpl in |- *; case (Pdiv p' q); simpl in |- *; intros q1 r1 (H1, H2); split. unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; rewrite H1. case q1; case r1; simpl in |- *; auto. intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xO r2) q Datatypes.Eq); simpl in |- *; auto. intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; ring. intros H3; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; ring. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply trans_equal with (nat_of_P q + nat_of_P h + Pmult_nat q2 2 * Pmult_nat q 1); [ rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- * | unfold nat_of_P in |- * ]; ring. intros H3; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; ring. intros r2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xO r2) q Datatypes.Eq); simpl in |- *; auto. intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; ring. intros H3; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; ring. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply trans_equal with (nat_of_P q + nat_of_P h); [ rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- * | unfold nat_of_P in |- * ]; ring. generalize H2; case q1; case r1; simpl in |- *. intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xO r2) q Datatypes.Eq); simpl in |- *; auto. intros; apply lt_O_nat_of_P; auto. intros H H0; apply nat_of_P_lt_Lt_compare_morphism; auto. intros H3 H7; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply plus_lt_reg_l with (p := nat_of_P q); rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1); auto with arith. intros; apply lt_O_nat_of_P; auto. intros r2 HH. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare (xO r2) q Datatypes.Eq); simpl in |- *. intros; apply lt_O_nat_of_P; auto. intros H3; apply nat_of_P_lt_Lt_compare_morphism; auto. intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6)); unfold Pminus in |- *; rewrite H4; apply plus_lt_reg_l with (p := nat_of_P q); rewrite <- (nat_of_P_plus_morphism q); rewrite H5; unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6; unfold nat_of_P in |- *; apply lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1); auto with arith. auto. Qed. Section bugFix. Variable PdivAux : positive -> positive -> Option positive * Option positive. Fixpoint PdivlessAux (bound p base length : positive) {struct length} : Option positive * Option positive * nat := match Pcompare bound p Datatypes.Eq with | Datatypes.Gt => (Some _ p, None _, 0) | _ => match PdivAux p base with | (None, None) => (None _, None _, 1) | (None, Some r1) => (None _, Some _ r1, 1) | (Some q1, None) => match length with | xH => (Some _ q1, None _, 0) | xO length' => match PdivlessAux bound q1 base length' with | (s2, None, n) => (s2, None _, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) r2 (fun x => x) base), S n) end | xI length' => match PdivlessAux bound q1 base length' with | (s2, None, n) => (s2, None _, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) r2 (fun x => x) base), S n) end end | (Some q1, Some r1) => match length with | xH => (Some _ q1, None _, 0) | xO length' => match PdivlessAux bound q1 base length' with | (s2, None, n) => (s2, Some _ r1, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => x * y) r2 ( fun x => x) base + r1)%positive, S n) end | xI length' => match PdivlessAux bound q1 base length' with | (s2, None, n) => (s2, Some _ r1, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => x * y) r2 ( fun x => x) base + r1)%positive, S n) end end end end. End bugFix. Definition Pdivless := PdivlessAux Pdiv. Theorem Pdivless1 : forall bound p q base, Pcompare bound p Datatypes.Eq = Datatypes.Gt -> Pdivless bound p base q = (Some _ p, None _, 0). intros bound p q base H; case q; simpl in |- *; auto; intros; rewrite H; auto. Qed. Theorem Pdivless2 : forall bound p length base, Pcompare bound p Datatypes.Eq <> Datatypes.Gt -> Pdivless bound p base length = match Pdiv p base with | (None, None) => (None _, None _, 1) | (None, Some r1) => (None _, Some _ r1, 1) | (Some q1, None) => match length with | xH => (Some _ q1, None _, 0) | xO length' => match Pdivless bound q1 base length' with | (s2, None, n) => (s2, None _, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) r2 ( fun x => x) base), S n) end | xI length' => match Pdivless bound q1 base length' with | (s2, None, n) => (s2, None _, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => (x * y)%positive) r2 ( fun x => x) base), S n) end end | (Some q1, Some r1) => match length with | xH => (Some _ q1, None _, 0) | xO length' => match Pdivless bound q1 base length' with | (s2, None, n) => (s2, Some _ r1, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => x * y) r2 ( fun x => x) base + r1)%positive, S n) end | xI length' => match Pdivless bound q1 base length' with | (s2, None, n) => (s2, Some _ r1, S n) | (s2, Some r2, n) => (s2, Some _ ((fun (x : positive) (_ : positive -> positive) (y : positive) => x * y) r2 ( fun x => x) base + r1)%positive, S n) end end end. intros bound p length base; case length; simpl in |- *; case (Pcompare bound p Datatypes.Eq); auto; (intros H; case H; auto; fail) || (intros p' H; case H; auto). Qed. Theorem compare_SUP_dec : forall p q : positive, Pcompare p q Datatypes.Eq = Datatypes.Gt \/ Pcompare p q Datatypes.Eq <> Datatypes.Gt. intros p q; case (Pcompare p q Datatypes.Eq); auto; right; red in |- *; intros; discriminate. Qed. Hint Resolve lt_O_nat_of_P: arith. Theorem odd_even_lem : forall p q, 2 * p + 1 <> 2 * q. intros p; elim p; auto. intros q; case q; simpl in |- *. red in |- *; intros; discriminate. intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *; intros; discriminate. intros p' H q; case q. simpl in |- *; red in |- *; intros; discriminate. intros q'; red in |- *; intros H0; case (H q'). replace (2 * q') with (2 * S q' - 2). rewrite <- H0; simpl in |- *; auto. repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto. simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto. case q'; simpl in |- *; auto. Qed. Theorem Pdivless_correct : forall bound p q base, 1 < nat_of_P base -> nat_of_P p <= nat_of_P q -> nat_of_P p = oZ (fst (fst (Pdivless bound p base q))) * exp (nat_of_P base) (snd (Pdivless bound p base q)) + oZ (snd (fst (Pdivless bound p base q))) /\ (oZ (fst (fst (Pdivless bound p base q))) < nat_of_P bound /\ oZ (snd (fst (Pdivless bound p base q))) < exp (nat_of_P base) (snd (Pdivless bound p base q))) /\ (forall bound', nat_of_P bound = nat_of_P base * bound' -> nat_of_P bound <= nat_of_P p -> nat_of_P bound <= nat_of_P base * oZ (fst (fst (Pdivless bound p base q)))). intros bound p q base Hb; generalize q; pattern p in |- *; apply well_founded_ind with (R := fun a b => nat_of_P a < nat_of_P b); auto; clear p q. apply wf_inverse_image with (R := lt); auto. exact lt_wf; auto. intros p Rec q Hq. case (compare_SUP_dec bound p); intros H1. rewrite Pdivless1; auto; simpl in |- *. repeat (split; auto with arith). ring; auto. apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; auto. intros bound' H'1 H2; Contradict H2; apply lt_not_le; apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; auto. rewrite Pdivless2; auto; simpl in |- *. generalize (Pdiv_correct p base); case (Pdiv p base); simpl in |- *. intros o1; case o1; simpl in |- *. intros o1' o2; case o2; simpl in |- *. intros o2' (Ho1, Ho2). generalize Hq; case q; simpl in |- *; auto. intros p0 Hq0; (cut (nat_of_P o1' <= nat_of_P p0); [ intros Hrec | idtac ]). cut (nat_of_P o1' < nat_of_P p); [ intros Hrec1 | idtac ]. generalize (Rec _ Hrec1 _ Hrec). CaseEq (Pdivless bound o1' base p0); simpl in |- *. intros p1; case p1; simpl in |- *. intros o3; case o3; simpl in |- *; auto. intros o3' o4; case o4; simpl in |- *; auto. intros o4' n Eq1; rewrite nat_of_P_plus_morphism; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (S (nat_of_P o4') * nat_of_P base). simpl in |- *; rewrite (fun x y => plus_comm x (nat_of_P y)); auto with arith. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (nat_of_P base * 1); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. inversion Eq1. rewrite <- H0. case (le_or_lt bound' (nat_of_P o1')); intros H'8; auto. rewrite H'5; auto with arith. Contradict H'6; auto. apply lt_not_le; rewrite Ho1; auto. apply lt_le_trans with (nat_of_P o1' * nat_of_P base + 1 * nat_of_P base); auto with arith. simpl in |- *; auto with arith. rewrite <- mult_plus_distr_r. replace (nat_of_P o1' + 1) with (S (nat_of_P o1')); auto with arith. rewrite H'5; auto with arith. rewrite <- (fun x y => mult_comm (nat_of_P x) y); auto with arith. rewrite plus_comm; auto with arith. apply nat_of_P_gt_Gt_compare_complement_morphism; auto with arith. intros o4; case o4; simpl in |- *. intros o4' n Eq1; rewrite nat_of_P_plus_morphism; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (S (nat_of_P o4') * nat_of_P base). simpl in |- *; rewrite (fun x y => plus_comm x (nat_of_P y)); auto with arith. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H H0; apply (H'4 bound'); auto. case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'8; auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (nat_of_P base * 1); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. intros bound' H H0; apply (H'4 bound'); auto. case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'8; auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. rewrite Ho1; auto. apply lt_le_trans with (nat_of_P o1' * 1 + nat_of_P o2'); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. apply le_lt_trans with (nat_of_P o1' + 0); auto with arith. apply plus_le_lt_compat; auto with arith. apply mult_S_le_reg_l with (n := pred (nat_of_P base)). replace (S (pred (nat_of_P base))) with (nat_of_P base). apply (fun p n m : nat => plus_le_reg_l n m p) with (p := nat_of_P o2'). rewrite (plus_comm (nat_of_P o2')); simpl in |- *; auto with arith. rewrite (mult_comm (nat_of_P base)); simpl in |- *; auto with arith. rewrite <- Ho1; auto with arith. apply le_trans with (1 := Hq0); auto with arith. replace (nat_of_P (xI p0)) with (1 + 2 * nat_of_P p0); auto with arith. apply plus_le_compat; auto with arith. unfold nat_of_P in |- *; simpl in |- *; (rewrite ZL6; auto). generalize (lt_O_nat_of_P base); case (nat_of_P base); simpl in |- *; auto; intros tmp; inversion tmp. intros p0 Hq0; (cut (nat_of_P o1' <= nat_of_P p0); [ intros Hrec | idtac ]). cut (nat_of_P o1' < nat_of_P p); [ intros Hrec1 | idtac ]. generalize (Rec _ Hrec1 _ Hrec). CaseEq (Pdivless bound o1' base p0); simpl in |- *. intros p1; case p1; simpl in |- *. intros o3; case o3; simpl in |- *; auto. intros o3' o4; case o4; simpl in |- *; auto. intros o4' n Eq1; rewrite nat_of_P_plus_morphism; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (S (nat_of_P o4') * nat_of_P base). simpl in |- *; rewrite (fun x y => plus_comm x (nat_of_P y)); auto with arith. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (nat_of_P base * 1); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. inversion Eq1. rewrite <- H0. case (le_or_lt bound' (nat_of_P o1')); intros H'8; auto. rewrite H'5; auto with arith. Contradict H'6; auto. apply lt_not_le; rewrite Ho1; auto. apply lt_le_trans with (nat_of_P o1' * nat_of_P base + 1 * nat_of_P base); auto with arith. simpl in |- *; auto with arith. rewrite <- mult_plus_distr_r. replace (nat_of_P o1' + 1) with (S (nat_of_P o1')); auto with arith. rewrite H'5; auto with arith. rewrite <- (fun x y => mult_comm (nat_of_P x) y); auto with arith. rewrite plus_comm; auto with arith. apply nat_of_P_gt_Gt_compare_complement_morphism; auto with arith. intros o4; case o4; simpl in |- *. intros o4' n Eq1; rewrite nat_of_P_plus_morphism; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (S (nat_of_P o4') * nat_of_P base). simpl in |- *; rewrite (fun x y => plus_comm x (nat_of_P y)); auto with arith. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H H0; apply (H'4 bound'); auto. case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'8; auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (nat_of_P base * 1); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. rewrite Ho1; auto. intros bound' H H0; apply (H'4 bound'); auto. case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'8; auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. apply lt_le_trans with (nat_of_P o1' * 1 + nat_of_P o2'); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. apply le_lt_trans with (nat_of_P o1' + 0); auto with arith. apply plus_le_lt_compat; auto with arith. rewrite Ho1; auto with arith. apply mult_S_le_reg_l with (n := pred (nat_of_P base)). replace (S (pred (nat_of_P base))) with (nat_of_P base). apply (fun p n m : nat => plus_le_reg_l n m p) with (p := nat_of_P o2'). rewrite (plus_comm (nat_of_P o2')); simpl in |- *; auto with arith. rewrite (mult_comm (nat_of_P base)); simpl in |- *; auto with arith. rewrite <- Ho1; auto with arith. apply le_trans with (1 := Hq0); auto with arith. replace (nat_of_P (xO p0)) with (0 + 2 * nat_of_P p0); auto with arith. apply plus_le_compat; auto with arith. unfold nat_of_P in |- *; simpl in |- *; (rewrite ZL6; auto). generalize (lt_O_nat_of_P base); case (nat_of_P base); simpl in |- *; auto; intros tmp; inversion tmp. replace (nat_of_P 1) with 1; auto with arith. rewrite Ho1; generalize (lt_O_nat_of_P o2'); (case (nat_of_P o2'); simpl in |- *). intros tmp; Contradict tmp; auto with arith. generalize (lt_O_nat_of_P o1'); (case (nat_of_P o1'); simpl in |- *). intros tmp; Contradict tmp; auto with arith. generalize (lt_O_nat_of_P base); (case (nat_of_P base); simpl in |- *). intros tmp; Contradict tmp; auto with arith. intros n H n0 H0 n1 H01; rewrite (fun x y => plus_comm x (S y)); simpl in |- *. intros tmp; Contradict tmp; auto with arith. generalize Hq; case q; simpl in |- *; auto. intros p0 Hq0 (Ho1, Ho2); (cut (nat_of_P o1' <= nat_of_P p0); [ intros Hrec | idtac ]). cut (nat_of_P o1' < nat_of_P p); [ intros Hrec1 | idtac ]. generalize (Rec _ Hrec1 _ Hrec). CaseEq (Pdivless bound o1' base p0); simpl in |- *. intros p1; case p1; simpl in |- *. intros o3; case o3; simpl in |- *; auto. intros o3' o4; case o4; simpl in |- *; auto. intros o4' n Eq1; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. apply lt_le_trans with (nat_of_P base * 1); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. inversion Eq1. rewrite <- H0. case (le_or_lt bound' (nat_of_P o1')); intros H'8; auto. rewrite H'5; auto with arith. Contradict H'6; auto. apply lt_not_le; rewrite Ho1; auto. apply lt_le_trans with (nat_of_P o1' * nat_of_P base + 1 * nat_of_P base); auto with arith. simpl in |- *; auto with arith. rewrite <- mult_plus_distr_r. replace (nat_of_P o1' + 1) with (S (nat_of_P o1')); auto with arith. rewrite H'5; auto with arith. rewrite <- (fun x y => mult_comm (nat_of_P x) y); auto with arith. rewrite plus_comm; auto with arith. apply nat_of_P_gt_Gt_compare_complement_morphism; auto with arith. intros o4; case o4; simpl in |- *. intros o4' n Eq1; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H H0; apply (H'4 bound'); auto. case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'8; auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, (H'2, H'3)). generalize (lt_O_nat_of_P o1'); rewrite H'1; intros tmp; inversion tmp. rewrite Ho1; auto. apply le_lt_trans with (nat_of_P o1' * 1 + 0); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. repeat rewrite (fun x => plus_comm x 0); simpl in |- *; auto with arith. apply mult_S_le_reg_l with (n := pred (nat_of_P base)). replace (S (pred (nat_of_P base))) with (nat_of_P base). rewrite (mult_comm (nat_of_P base)); simpl in |- *; auto with arith. rewrite (fun x => plus_comm x 0) in Ho1; simpl in Ho1; rewrite <- Ho1. generalize Hq0; clear Hq0; replace (nat_of_P (xI p0)) with (2 * nat_of_P p0 + 1); try intros Hq0. case (le_lt_or_eq _ _ Hq0); auto. rewrite (fun x y => plus_comm x (S y)); intros Hl1. apply le_trans with (2 * nat_of_P p0); auto with arith. generalize Hb Ho1; case (nat_of_P base); auto. intros tmp; Contradict tmp; auto with arith. intros base'; case base'. intros tmp; Contradict tmp; auto with arith. intros base''; case base''. replace (nat_of_P (xI p0)) with (1 + 2 * nat_of_P p0); auto with arith. intros Hb0 Ho0 H; Contradict H; rewrite Ho0. rewrite (fun x y => mult_comm x (S y)). apply Compare.not_eq_sym. apply odd_even_lem. unfold nat_of_P in |- *; simpl in |- *; (rewrite ZL6; auto). intros n Hb0 Ho0 H; rewrite H. apply le_trans with (S (S n) * nat_of_P p0 + nat_of_P p0); auto with arith. apply plus_le_compat; auto with arith. rewrite plus_comm; simpl in |- *; auto with arith. rewrite plus_comm; unfold nat_of_P in |- *; simpl in |- *; (rewrite ZL6; unfold nat_of_P in |- *; auto). generalize (lt_O_nat_of_P base); case (nat_of_P base); simpl in |- *; auto; intros tmp; inversion tmp. intros p0 Hq0 (Ho1, Ho2); (cut (nat_of_P o1' <= nat_of_P p0); [ intros Hrec | idtac ]). cut (nat_of_P o1' < nat_of_P p); [ intros Hrec1 | idtac ]. generalize (Rec _ Hrec1 _ Hrec). CaseEq (Pdivless bound o1' base p0); simpl in |- *. intros p1; case p1; simpl in |- *. intros o3; case o3; simpl in |- *; auto. intros o3' o4; case o4; simpl in |- *; auto. intros o4' n Eq1; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. replace 0 with (0 * exp (nat_of_P base) n); auto with arith. intros bound' H'5 H'6; case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'7; auto. apply (H'4 bound'); auto. rewrite Pdivless1 in Eq1; auto. inversion Eq1. rewrite <- H0. case (le_or_lt bound' (nat_of_P o1')); intros H'8; auto. rewrite H'5; auto with arith. Contradict H'6; auto. apply lt_not_le; rewrite Ho1; auto. apply lt_le_trans with (nat_of_P o1' * nat_of_P base + 1 * nat_of_P base); auto with arith. simpl in |- *; auto with arith. rewrite <- mult_plus_distr_r. replace (nat_of_P o1' + 1) with (S (nat_of_P o1')); auto with arith. rewrite H'5; auto with arith. rewrite <- (fun x y => mult_comm (nat_of_P x) y); auto with arith. rewrite plus_comm; auto with arith. apply nat_of_P_gt_Gt_compare_complement_morphism; auto with arith. intros o4; case o4; simpl in |- *. intros o4' n Eq1; rewrite nat_of_P_mult_morphism. intros (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. rewrite (fun x y => mult_comm x (nat_of_P y)); auto with arith. intros bound' H H0; apply (H'4 bound'); auto. case (le_or_lt (nat_of_P bound) (nat_of_P o1')); intros H'8; auto. rewrite Pdivless1 in Eq1; auto. discriminate. apply nat_of_P_gt_Gt_compare_complement_morphism; auto. intros n Eq1 (H'1, ((H'2, H'3), H'4)); repeat (split; auto). rewrite Ho1; rewrite H'1; ring. replace 0 with (0 * exp (nat_of_P base) n); auto with arith. intros bound' H H0; Contradict H0; rewrite Ho1; rewrite H'1; simpl in |- *; auto with arith. rewrite Ho1; auto with arith. apply le_lt_trans with (nat_of_P o1' * 1 + 0); auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. apply mult_S_le_reg_l with (n := pred (nat_of_P base)). replace (S (pred (nat_of_P base))) with (nat_of_P base). apply le_trans with (nat_of_P p); auto. rewrite Ho1; rewrite (fun x => plus_comm x 0); simpl in |- *; auto. rewrite (mult_comm (nat_of_P base)); simpl in |- *; auto with arith. apply le_trans with (1 := Hq0); auto with arith. replace (nat_of_P (xO p0)) with (2 * nat_of_P p0); auto with arith. unfold nat_of_P in |- *; simpl in |- *; (rewrite ZL6; auto). generalize (lt_O_nat_of_P base); case (nat_of_P base); simpl in |- *; auto; intros tmp; inversion tmp. replace (nat_of_P 1) with 1; auto with arith. intros Hq0 (H, H0); Contradict Hq0. apply lt_not_le. rewrite H. generalize (lt_O_nat_of_P o1'); case (nat_of_P o1'); simpl in |- *; auto. intros tmp; Contradict tmp; auto with arith. intros n H2; generalize Hb. case (nat_of_P base); simpl in |- *; auto. intros tmp; Contradict tmp; auto with arith. intros base'; case base'; simpl in |- *; auto with arith. intros tmp; Contradict tmp; auto with arith. intros o2; case o2; simpl in |- *; auto with arith. intros o2' (Ho1, Ho2); repeat (split; auto with arith). rewrite mult_comm; simpl in |- *; auto with arith. intros bound' H H0; Contradict Ho2. apply le_not_lt. rewrite <- Ho1. generalize H; case bound'. rewrite mult_comm; simpl in |- *; auto. intros Eq2; generalize (lt_O_nat_of_P bound); rewrite Eq2; intros tmp; Contradict tmp; auto with arith. intros n Eq2; apply le_trans with (nat_of_P bound); auto with arith. rewrite Eq2; auto with arith. rewrite mult_comm; simpl in |- *; auto with arith. intros (Ho1, Ho2); generalize (lt_O_nat_of_P p); rewrite Ho1; intros tmp; Contradict tmp; auto with arith. Qed. Definition PdivBound bound p base := Pdivless bound p base p. Theorem PdivBound_correct : forall bound p base, 1 < nat_of_P base -> nat_of_P p = oZ (fst (fst (PdivBound bound p base))) * exp (nat_of_P base) (snd (PdivBound bound p base)) + oZ (snd (fst (PdivBound bound p base))) /\ (oZ (fst (fst (PdivBound bound p base))) < nat_of_P bound /\ oZ (snd (fst (PdivBound bound p base))) < exp (nat_of_P base) (snd (PdivBound bound p base))) /\ (forall bound', nat_of_P bound = nat_of_P base * bound' -> nat_of_P bound <= nat_of_P p -> nat_of_P bound <= nat_of_P base * oZ (fst (fst (PdivBound bound p base)))). intros; unfold PdivBound in |- *; apply Pdivless_correct; auto. Qed. Theorem PdivBound_correct1 : forall bound p base, 1 < nat_of_P base -> nat_of_P p = oZ (fst (fst (PdivBound bound p base))) * exp (nat_of_P base) (snd (PdivBound bound p base)) + oZ (snd (fst (PdivBound bound p base))). intros bound p base H; generalize (PdivBound_correct bound p base); intuition. Qed. Theorem PdivBound_correct2 : forall bound p base, 1 < nat_of_P base -> oZ (fst (fst (PdivBound bound p base))) < nat_of_P bound. intros bound p base H; generalize (PdivBound_correct bound p base); intuition. Qed. Theorem PdivBound_correct3 : forall bound p base, nat_of_P p < nat_of_P bound -> PdivBound bound p base = (Some _ p, None _, 0). intros bound p base H; (unfold PdivBound in |- *; apply Pdivless1; auto). apply nat_of_P_gt_Gt_compare_complement_morphism; auto with arith. Qed. Theorem PdivBound_correct4 : forall bound p base bound', 1 < nat_of_P base -> nat_of_P bound = nat_of_P base * bound' -> nat_of_P bound <= nat_of_P p -> nat_of_P bound <= nat_of_P base * oZ (fst (fst (PdivBound bound p base))). intros bound p base bound' H H1 H2; case (PdivBound_correct bound p base); auto; intros H'1 (H'2, H'3); apply (H'3 bound'); auto with arith. Qed. Transparent Pdiv. (* Eval Compute in (PdivBound (anti_convert (9)) (times1 (anti_convert (10)) [x : ?] x (anti_convert (10))) (anti_convert (9))).*) float-8.10.0/Power.v000066400000000000000000000325321357127175600142130ustar00rootroot00000000000000(* This program is free software; you can redistribute it and/or *) (* modify it under the terms of the GNU Lesser General Public License *) (* as published by the Free Software Foundation; either version 2.1 *) (* of the License, or (at your option) any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU General Public License for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public *) (* License along with this program; if not, write to the Free *) (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) (* 02110-1301 USA *) (**************************************************************************** IEEE754 : Rpower Laurent Thery ***************************************************************************** Definition of an exponential function over relative numbers *) Require Import Omega. Require Import Reals. Require Import Zpower. Require Import ZArith. Require Import Digit. Require Import Faux. Require Import sTactic. (* We have already an exponential over natural number, we prove some basic properties for this function *) Theorem pow_O : forall e : R, (e ^ 0)%R = 1%R. simpl in |- *; auto with real. Qed. Theorem pow_1 : forall e : R, (e ^ 1)%R = e. simpl in |- *; auto with real. Qed. Theorem pow_NR0 : forall (e : R) (n : nat), e <> 0%R -> (e ^ n)%R <> 0%R. intros e n; elim n; simpl in |- *; auto with real. Qed. Theorem pow_add : forall (e : R) (n m : nat), (e ^ (n + m))%R = (e ^ n * e ^ m)%R. intros e n; elim n; simpl in |- *; auto with real. intros n0 H' m; rewrite H'; auto with real. Qed. Hint Resolve pow_O pow_1 pow_NR0 pow_add: real. Theorem pow_RN_plus : forall (e : R) (n m : nat), e <> 0%R -> (e ^ n)%R = (e ^ (n + m) * / e ^ m)%R. intros e n; elim n; simpl in |- *; auto with real. intros n0 H' m H'0. rewrite Rmult_assoc; rewrite <- H'; auto. Qed. Theorem pow_lt : forall (e : R) (n : nat), (0 < e)%R -> (0 < e ^ n)%R. intros e n; elim n; simpl in |- *; auto with real. intros n0 H' H'0; replace 0%R with (e * 0)%R; auto with real. Qed. Hint Resolve pow_lt: real. Theorem Rlt_pow_R1 : forall (e : R) (n : nat), (1 < e)%R -> 0 < n -> (1 < e ^ n)%R. intros e n; elim n; simpl in |- *; auto with real. intros H' H'0; Contradict H'0; auto with arith. intros n0; case n0. simpl in |- *; rewrite Rmult_1_r; auto. intros n1 H' H'0 H'1. replace 1%R with (1 * 1)%R; auto with real. apply Rlt_trans with (r2 := (e * 1)%R); auto with real. apply Rmult_lt_compat_l; auto with real. apply Rlt_trans with (r2 := 1%R); auto with real. apply H'; auto with arith. Qed. Hint Resolve Rlt_pow_R1: real. Theorem Rlt_pow : forall (e : R) (n m : nat), (1 < e)%R -> n < m -> (e ^ n < e ^ m)%R. intros e n m H' H'0; replace m with (m - n + n). rewrite pow_add. pattern (e ^ n)%R at 1 in |- *; replace (e ^ n)%R with (1 * e ^ n)%R; auto with real. apply Rminus_lt. repeat rewrite (fun x : R => Rmult_comm x (e ^ n)); rewrite <- Rmult_minus_distr_l. replace 0%R with (e ^ n * 0)%R; auto with real. apply Rmult_lt_compat_l; auto with real. apply pow_lt; auto with real. apply Rlt_trans with (r2 := 1%R); auto with real. apply Rlt_minus; auto with real. apply Rlt_pow_R1; auto with arith. apply plus_lt_reg_l with (p := n); auto with arith. rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto. rewrite plus_comm; auto with arith. Qed. Hint Resolve Rlt_pow: real. Theorem pow_R1 : forall (r : R) (n : nat), (r ^ n)%R = 1%R -> Rabs r = 1%R \/ n = 0. intros r n H'. case (Req_dec (Rabs r) 1); auto; intros H'1. case (Rdichotomy _ _ H'1); intros H'2. generalize H'; case n; auto. intros n0 H'0. cut (r <> 0%R); [ intros Eq1 | idtac ]. 2: Contradict H'0; auto with arith. 2: simpl in |- *; rewrite H'0; rewrite Rmult_0_l; auto with real. cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto. absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0)%R; auto. replace (Rabs (/ r) ^ S n0)%R with 1%R. simpl in |- *; apply Rlt_irrefl; auto. rewrite Rabs_Rinv; auto. rewrite <- Rinv_pow; auto. rewrite RPow_abs; auto. rewrite H'0; rewrite Rabs_right; auto with real. apply Rlt_pow; auto with arith. rewrite Rabs_Rinv; auto. apply Rmult_lt_reg_l with (r := Rabs r). case (Rabs_pos r); auto. intros H'3; case Eq2; auto. rewrite Rmult_1_r; rewrite Rinv_r; auto with real. generalize H'; case n; auto. intros n0 H'0. cut (r <> 0%R); [ intros Eq1 | auto with real ]. 2: Contradict H'0; simpl in |- *; rewrite H'0; rewrite Rmult_0_l; auto with real. cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto. absurd (Rabs r ^ 0 < Rabs r ^ S n0)%R; auto with real arith. repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real. Qed. Theorem Zpower_NR0 : forall (e : BinInt.Z) (n : nat), (0 <= e)%Z -> (0 <= Zpower_nat e n)%Z. intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. Qed. Theorem Zpower_NR1 : forall (e : BinInt.Z) (n : nat), (1 <= e)%Z -> (1 <= Zpower_nat e n)%Z. intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. Qed. Hint Resolve Zpower_NR0 Zpower_NR1: zarith. (* To define exponential over relative number, we simply do a case analysis on the sign of the number *) Definition powerRZ (e : R) (n : BinInt.Z) := match n with | BinInt.Z0 => 1%R | BinInt.Zpos p => (e ^ BinPos.nat_of_P p)%R | BinInt.Zneg p => (/ e ^ BinPos.nat_of_P p)%R end. (* we now prove some basic properties of our exponential *) Theorem powerRZ_O : forall e : R, powerRZ e 0 = 1%R. simpl in |- *; auto. Qed. Theorem powerRZ_1 : forall e : R, powerRZ e (Z.succ 0) = e. simpl in |- *; auto with real. Qed. Theorem powerRZ_NOR : forall (e : R) (z : BinInt.Z), e <> 0%R -> powerRZ e z <> 0%R. intros e z; case z; simpl in |- *; auto with real. Qed. Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR: real. Theorem powerRZ_add : forall (e : R) (n m : BinInt.Z), e <> 0%R -> powerRZ e (n + m) = (powerRZ e n * powerRZ e m)%R. intros e n m; case n; case m; simpl in |- *; auto with real. intros n1 m1; rewrite Pnat.nat_of_P_plus_morphism; auto with real. intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare m1 n1 Datatypes.Eq); simpl in |- *; auto with real. intros H' H'0; rewrite BinPos.Pcompare_Eq_eq with (1 := H'); auto with real. intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism n1 m1); auto with real. rewrite (pow_RN_plus e (BinPos.nat_of_P n1 - BinPos.nat_of_P m1) (BinPos.nat_of_P m1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. rewrite Rinv_mult_distr; auto with real. rewrite Rinv_involutive; auto with real. apply lt_le_weak. apply Pnat.nat_of_P_lt_Lt_compare_morphism; auto. apply BinPos.ZC2; auto. intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism m1 n1); auto with real. rewrite (pow_RN_plus e (BinPos.nat_of_P m1 - BinPos.nat_of_P n1) (BinPos.nat_of_P n1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. apply lt_le_weak. change (BinPos.nat_of_P m1 > BinPos.nat_of_P n1) in |- *. apply Pnat.nat_of_P_gt_Gt_compare_morphism; auto. intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare n1 m1 Datatypes.Eq); simpl in |- *; auto with real. intros H' H'0; rewrite BinPos.Pcompare_Eq_eq with (1 := H'); auto with real. intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism m1 n1); auto with real. rewrite (pow_RN_plus e (BinPos.nat_of_P m1 - BinPos.nat_of_P n1) (BinPos.nat_of_P n1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. rewrite Rinv_mult_distr; auto with real. apply lt_le_weak. apply Pnat.nat_of_P_lt_Lt_compare_morphism; auto. apply BinPos.ZC2; auto. intros H' H'0; rewrite (Pnat.nat_of_P_minus_morphism n1 m1); auto with real. rewrite (pow_RN_plus e (BinPos.nat_of_P n1 - BinPos.nat_of_P m1) (BinPos.nat_of_P m1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. apply lt_le_weak. change (BinPos.nat_of_P n1 > BinPos.nat_of_P m1) in |- *. apply Pnat.nat_of_P_gt_Gt_compare_morphism; auto. intros n1 m1; rewrite Pnat.nat_of_P_plus_morphism; auto with real. intros H'; rewrite pow_add; auto with real. apply Rinv_mult_distr; auto. apply pow_NR0; auto. apply pow_NR0; auto. Qed. Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real. Theorem powerRZ_Zopp : forall (e : R) (z : BinInt.Z), e <> 0%R -> powerRZ e (- z) = (/ powerRZ e z)%R. intros e z H; case z; simpl in |- *; auto with real. intros p; apply sym_eq; apply Rinv_involutive. apply pow_nonzero; auto. Qed. Theorem powerRZ_Zs : forall (e : R) (n : BinInt.Z), e <> 0%R -> powerRZ e (Z.succ n) = (e * powerRZ e n)%R. intros e n H'0. replace (Z.succ n) with (n + Z.succ 0)%Z. rewrite powerRZ_add; auto. rewrite powerRZ_1. rewrite Rmult_comm; auto. auto with zarith. Qed. (* Conversion theorem between relative numbers and reals *) Theorem Zpower_nat_powerRZ : forall (n : BinInt.Z) (m : nat), IZR (Zpower_nat n m) = powerRZ (IZR n) (Z_of_nat m). intros n m; elim m; simpl in |- *; auto with real. intros m1 H'; rewrite Pnat.nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *. replace (Zpower_nat n (S m1)) with (n * Zpower_nat n m1)%Z. rewrite Rmult_IZR; auto with real. rewrite H'; simpl in |- *. case m1; simpl in |- *; auto with real. intros m2; rewrite Pnat.nat_of_P_o_P_of_succ_nat_eq_succ; auto. unfold Zpower_nat in |- *; auto. Qed. Theorem powerRZ_lt : forall (e : R) (z : BinInt.Z), (0 < e)%R -> (0 < powerRZ e z)%R. intros e z; case z; simpl in |- *; auto with real. Qed. Hint Resolve powerRZ_lt: real. Theorem powerRZ_le : forall (e : R) (z : BinInt.Z), (0 < e)%R -> (0 <= powerRZ e z)%R. intros e z H'; apply Rlt_le; auto with real. Qed. Hint Resolve powerRZ_le: real. Theorem Rlt_powerRZ : forall (e : R) (n m : BinInt.Z), (1 < e)%R -> (n < m)%Z -> (powerRZ e n < powerRZ e m)%R. intros e n m; case n; case m; simpl in |- *; try (unfold Z.lt in |- *; intros; discriminate); auto with real. intros p p0 H' H'0; apply Rlt_pow; auto with real. apply Pnat.nat_of_P_lt_Lt_compare_morphism; auto. intros p H' H'0; replace 1%R with (/ 1)%R; auto with real. intros p p0 H' H'0; apply Rlt_trans with (r2 := 1%R). replace 1%R with (/ 1)%R; auto with real. apply Rlt_pow_R1; auto with real. intros p p0 H' H'0; apply Rinv_1_lt_contravar; auto with real. apply Rlt_pow; auto with real. apply Pnat.nat_of_P_lt_Lt_compare_morphism; rewrite BinPos.ZC4; auto. Qed. Hint Resolve Rlt_powerRZ: real. Theorem Rpow_R1 : forall (r : R) (z : BinInt.Z), r <> 0%R -> powerRZ r z = 1%R -> Rabs r = 1%R \/ z = 0%Z. intros r z; case z; simpl in |- *; auto; intros p H' H'1; left. case (pow_R1 _ _ H'1); auto. intros H'0; Contradict H'0; auto with zarith; apply convert_not_O. rewrite Rinv_pow in H'1; auto. case (pow_R1 _ _ H'1); auto. intros H'0. rewrite <- H'0. apply Rmult_eq_reg_l with (r := 1%R); auto with real. pattern 1%R at 1 in |- *; rewrite <- H'0; auto with real. pattern (Rabs (/ r)) at 1 in |- *; rewrite Rabs_Rinv; try rewrite Rinv_l; auto with real. rewrite H'0; auto with real. apply Rabs_no_R0; auto. intros H'0; Contradict H'0; auto with zarith; apply convert_not_O. Qed. Theorem Rpow_eq_inv : forall (r : R) (p q : BinInt.Z), r <> 0%R -> Rabs r <> 1%R -> powerRZ r p = powerRZ r q -> p = q. intros r p q H' H'0 H'1. cut (powerRZ r (p - q) = 1%R); [ intros Eq0 | idtac ]. case (Rpow_R1 _ _ H' Eq0); auto with zarith. intros H'2; case H'0; auto. apply Rmult_eq_reg_l with (r := powerRZ r q); auto with real. rewrite <- powerRZ_add; auto. replace (q + (p - q))%Z with p; auto with zarith. rewrite <- H'1; rewrite Rmult_1_r; auto with arith. Qed. Theorem Zpower_nat_powerRZ_absolu : forall n m : BinInt.Z, (0 <= m)%Z -> IZR (Zpower_nat n (Z.abs_nat m)) = powerRZ (IZR n) m. intros n m; case m; simpl in |- *; auto with zarith. intros p H'; elim (BinPos.nat_of_P p); simpl in |- *; auto with zarith. intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith. rewrite <- Rmult_IZR; auto. intros p H'; Contradict H'; auto with zarith. Qed. Theorem powerRZ_R1 : forall n : BinInt.Z, powerRZ 1 n = 1%R. intros n; case n; simpl in |- *; auto. intros p; elim (BinPos.nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H'; ring. intros p; elim (BinPos.nat_of_P p); simpl in |- *. exact Rinv_1. intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H'; auto with real. Qed. Theorem Rle_powerRZ : forall (e : R) (n m : BinInt.Z), (1 <= e)%R -> (n <= m)%Z -> (powerRZ e n <= powerRZ e m)%R. intros e n m H' H'0. case H'; intros E1. case (Zle_lt_or_eq _ _ H'0); intros E2. apply Rlt_le; auto with real. rewrite <- E2; auto with real. repeat rewrite <- E1; repeat rewrite powerRZ_R1; auto with real. Qed. Theorem Zlt_powerRZ : forall (e : R) (n m : BinInt.Z), (1 <= e)%R -> (powerRZ e n < powerRZ e m)%R -> (n < m)%Z. intros e n m H' H'0. case (Zle_or_lt m n); auto; intros Z1. Contradict H'0. apply Rle_not_lt. apply Rle_powerRZ; auto. Qed.float-8.10.0/README000066400000000000000000000042621357127175600136070ustar00rootroot00000000000000This directory contains a library for floating point numbers. - This library is described in `A generic library of floating-point number and its application to exact computing' in TPHOLs 2001. To build the directory, do coq_makefile *.v > Makefile Then make depend;make all Laurent Thery & Sylvie Boldo & Laurence Rideau thery@sophia.inria.fr Sylvie.Boldo@ens-lyon.fr lrg@sophia.inria.fr Summary of what is in the library: AllFloat.v : load all the definitions and theorems of the library Float.v : definition of floating point number as pair of mantissa and exponent Record float : Set := Float { Fnum: Z; Fexp: Z }. Fop.v : usual operation on floats: +, -, * Fbound.v: Definition of a bound and what it is to be bounded for a float Record Fbound : Set := Bound { vNum: nat; dExp: nat }. Definition Fbounded := [b : Fbound] [d : float] ((Zle (Zopp (vNum b)) (Fnum d)) /\ (Zle (Fnum d) (vNum b))) /\ (Zle (Zopp (dExp b)) (Fexp d)). Fnorm.v: Definition of normal, subnormal and canonical numbers FSucc.v : The successor function for bounded numbers FPred.v : The predecessor function for bounded numbers Fprop.v : The proof of Sternbenz property MSB.v : Definition of Most Signigicant Bit and Least Significant Bit Fround.v: Defintion of rounding as a relation between a real and a float: (P r f) means f is a rounded value of r Definitions of the usual rounding modes. FroundProp.v: Standard properties of rounding FroundPlus.v: Standard properties of rounding for addition FroundMult.v: Standard properties of rounding for multiplication Closest.v: Definition of rounding to the closest ClosestProp.v: Standard properties of rounding to the closest ClosestPlus.v: Standard properties of rounding to the closest for addition ClosestMult.v: Standard properties of rounding to the closest for multiplication Closest2Prop.v: Standard properties of rounding to the closest in base 2 Closest2Plus.v: Standard properties of rounding to the closest for addition in base 2 Pradix.v : a simple verification of a program that computes the base. float-8.10.0/Rpow.v000066400000000000000000000307521357127175600140500ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Rpow Laurent Thery ***************************************************************************** Definition of an exponential function over relative numbers *) Require Export Omega. Require Export Digit. (* We have already an exponential over natural number, we prove some basic properties for this function *) Theorem pow_O : forall e : R, (e ^ 0)%R = 1%R. simpl in |- *; auto with real. Qed. Theorem pow_1 : forall e : R, (e ^ 1)%R = e. simpl in |- *; auto with real. Qed. Theorem pow_NR0 : forall (e : R) (n : nat), e <> 0%R -> (e ^ n)%R <> 0%R. intros e n; elim n; simpl in |- *; auto with real. Qed. Theorem pow_add : forall (e : R) (n m : nat), (e ^ (n + m))%R = (e ^ n * e ^ m)%R. intros e n; elim n; simpl in |- *; auto with real. intros n0 H' m; rewrite H'; auto with real. Qed. Hint Resolve pow_O pow_1 pow_NR0 pow_add: real. Theorem pow_RN_plus : forall (e : R) (n m : nat), e <> 0%R -> (e ^ n)%R = (e ^ (n + m) * / e ^ m)%R. intros e n; elim n; simpl in |- *; auto with real. intros n0 H' m H'0. rewrite Rmult_assoc; rewrite <- H'; auto. Qed. Theorem pow_lt : forall (e : R) (n : nat), (0 < e)%R -> (0 < e ^ n)%R. intros e n; elim n; simpl in |- *; auto with real. intros n0 H' H'0; replace 0%R with (e * 0)%R; auto with real. Qed. Hint Resolve pow_lt: real. Theorem Rlt_pow_R1 : forall (e : R) (n : nat), (1 < e)%R -> 0 < n -> (1 < e ^ n)%R. intros e n; elim n; simpl in |- *; auto with real. intros H' H'0; Contradict H'0; auto with arith. intros n0; case n0. simpl in |- *; rewrite Rmult_1_r; auto. intros n1 H' H'0 H'1. replace 1%R with (1 * 1)%R; auto with real. apply Rlt_trans with (r2 := (e * 1)%R); auto with real. apply Rmult_lt_compat_l; auto with real. apply Rlt_trans with (r2 := 1%R); auto with real. apply H'; auto with arith. Qed. Hint Resolve Rlt_pow_R1: real. Theorem Rlt_pow : forall (e : R) (n m : nat), (1 < e)%R -> n < m -> (e ^ n < e ^ m)%R. intros e n m H' H'0; replace m with (m - n + n). rewrite pow_add. pattern (e ^ n)%R at 1 in |- *; replace (e ^ n)%R with (1 * e ^ n)%R; auto with real. apply Rminus_lt. repeat rewrite (fun x : R => Rmult_comm x (e ^ n)); rewrite <- Rmult_minus_distr_l. replace 0%R with (e ^ n * 0)%R; auto with real. apply Rmult_lt_compat_l; auto with real. apply pow_lt; auto with real. apply Rlt_trans with (r2 := 1%R); auto with real. apply Rlt_minus; auto with real. apply Rlt_pow_R1; auto with arith. apply plus_lt_reg_l with (p := n); auto with arith. rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto. rewrite plus_comm; auto with arith. Qed. Hint Resolve Rlt_pow: real. Theorem pow_R1 : forall (r : R) (n : nat), (r ^ n)%R = 1%R -> Rabs r = 1%R \/ n = 0. intros r n H'. case (Req_dec (Rabs r) 1); auto; intros H'1. case (Rdichotomy _ _ H'1); intros H'2. generalize H'; case n; auto. intros n0 H'0. cut (r <> 0%R); [ intros Eq1 | idtac ]. 2: Contradict H'0; auto with arith. 2: simpl in |- *; rewrite H'0; rewrite Rmult_0_l; auto with real. cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto. absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0)%R; auto. replace (Rabs (/ r) ^ S n0)%R with 1%R. simpl in |- *; apply Rlt_irrefl; auto. rewrite Rabs_Rinv; auto. rewrite <- Rinv_pow; auto. rewrite RPow_abs; auto. rewrite H'0; rewrite Rabs_right; auto with real. apply Rlt_pow; auto with arith. rewrite Rabs_Rinv; auto. apply Rmult_lt_reg_l with (r := Rabs r). case (Rabs_pos r); auto. intros H'3; case Eq2; auto. rewrite Rmult_1_r; rewrite Rinv_r; auto with real. generalize H'; case n; auto. intros n0 H'0. cut (r <> 0%R); [ intros Eq1 | auto with real ]. 2: Contradict H'0; simpl in |- *; rewrite H'0; rewrite Rmult_0_l; auto with real. cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto. absurd (Rabs r ^ 0 < Rabs r ^ S n0)%R; auto with real arith. repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real. Qed. Theorem Zpower_NR0 : forall (e : Z) (n : nat), (0 <= e)%Z -> (0 <= Zpower_nat e n)%Z. intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. Qed. Theorem Zpower_NR1 : forall (e : Z) (n : nat), (1 <= e)%Z -> (1 <= Zpower_nat e n)%Z. intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. Qed. Hint Resolve Zpower_NR0 Zpower_NR1: zarith. (* To define exponential over relative number, we simply do a case analysis on the sign of the number *) (*Definition powerRZ := [e : R] [n : Z] Cases n of ZERO => R1 | (POS p) => (pow e (convert p)) | (NEG p) => (Rinv (pow e (convert p))) end.*) (* we now prove some basic properties of our exponential *) Theorem powerRZ_O : forall e : R, powerRZ e 0 = 1%R. simpl in |- *; auto. Qed. Theorem powerRZ_1 : forall e : R, powerRZ e (Z.succ 0) = e. simpl in |- *; auto with real. Qed. Theorem powerRZ_NOR : forall (e : R) (z : Z), e <> 0%R -> powerRZ e z <> 0%R. intros e z; case z; simpl in |- *; auto with real. Qed. Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR: real. Theorem powerRZ_add : forall (e : R) (n m : Z), e <> 0%R -> powerRZ e (n + m) = (powerRZ e n * powerRZ e m)%R. intros e n m; case n; case m; simpl in |- *; auto with real. intros n1 m1; rewrite nat_of_P_plus_morphism; auto with real. intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare m1 n1 Datatypes.Eq); simpl in |- *; auto with real. intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. rewrite (pow_RN_plus e (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. rewrite Rinv_mult_distr; auto with real. rewrite Rinv_involutive; auto with real. apply lt_le_weak. apply nat_of_P_lt_Lt_compare_morphism; auto. apply ZC2; auto. intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. rewrite (pow_RN_plus e (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. apply lt_le_weak. change (nat_of_P m1 > nat_of_P n1) in |- *. apply nat_of_P_gt_Gt_compare_morphism; auto. intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare. CaseEq (Pcompare n1 m1 Datatypes.Eq); simpl in |- *; auto with real. intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. rewrite (pow_RN_plus e (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. rewrite Rinv_mult_distr; auto with real. apply lt_le_weak. apply nat_of_P_lt_Lt_compare_morphism; auto. apply ZC2; auto. intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. rewrite (pow_RN_plus e (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); auto with real. rewrite plus_comm; rewrite le_plus_minus_r; auto with real. apply lt_le_weak. change (nat_of_P n1 > nat_of_P m1) in |- *. apply nat_of_P_gt_Gt_compare_morphism; auto. intros n1 m1; rewrite nat_of_P_plus_morphism; auto with real. intros H'; rewrite pow_add; auto with real. apply Rinv_mult_distr; auto. apply pow_NR0; auto. apply pow_NR0; auto. Qed. Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real. Theorem powerRZ_Zopp : forall (e : R) (z : Z), e <> 0%R -> powerRZ e (- z) = (/ powerRZ e z)%R. intros e z H; case z; simpl in |- *; auto with real. intros p; apply sym_eq; apply Rinv_involutive. apply pow_nonzero; auto. Qed. Theorem powerRZ_Zs : forall (e : R) (n : Z), e <> 0%R -> powerRZ e (Z.succ n) = (e * powerRZ e n)%R. intros e n H'0. replace (Z.succ n) with (n + Z.succ 0)%Z. rewrite powerRZ_add; auto. rewrite powerRZ_1. rewrite Rmult_comm; auto. auto with zarith. Qed. (* Conversion theorem between relative numbers and reals *) Theorem Zpower_nat_Z_powerRZ : forall (n : Z) (m : nat), IZR (Zpower_nat n m) = powerRZ (IZR n) (Z_of_nat m). intros n m; elim m; simpl in |- *; auto with real. intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *. replace (Zpower_nat n (S m1)) with (n * Zpower_nat n m1)%Z. rewrite Rmult_IZR; auto with real. rewrite H'; simpl in |- *. case m1; simpl in |- *; auto with real. intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto. unfold Zpower_nat in |- *; auto. Qed. Theorem powerRZ_lt : forall (e : R) (z : Z), (0 < e)%R -> (0 < powerRZ e z)%R. intros e z; case z; simpl in |- *; auto with real. Qed. Hint Resolve powerRZ_lt: real. Theorem powerRZ_le : forall (e : R) (z : Z), (0 < e)%R -> (0 <= powerRZ e z)%R. intros e z H'; apply Rlt_le; auto with real. Qed. Hint Resolve powerRZ_le: real. Theorem Rlt_powerRZ : forall (e : R) (n m : Z), (1 < e)%R -> (n < m)%Z -> (powerRZ e n < powerRZ e m)%R. intros e n m; case n; case m; simpl in |- *; try (unfold Z.lt in |- *; intros; discriminate); auto with real. intros p p0 H' H'0; apply Rlt_pow; auto with real. apply nat_of_P_lt_Lt_compare_morphism; auto. intros p H' H'0; replace 1%R with (/ 1)%R; auto with real. intros p p0 H' H'0; apply Rlt_trans with (r2 := 1%R). replace 1%R with (/ 1)%R; auto with real. apply Rlt_pow_R1; auto with real. intros p p0 H' H'0; apply Rinv_1_lt_contravar; auto with real. apply Rlt_pow; auto with real. apply nat_of_P_lt_Lt_compare_morphism; rewrite ZC4; auto. Qed. Hint Resolve Rlt_powerRZ: real. Theorem Rpow_R1 : forall (r : R) (z : Z), r <> 0%R -> powerRZ r z = 1%R -> Rabs r = 1%R \/ z = 0%Z. intros r z; case z; simpl in |- *; auto; intros p H' H'1; left. case (pow_R1 _ _ H'1); auto. intros H'0; Contradict H'0; auto with zarith; apply convert_not_O. rewrite Rinv_pow in H'1; auto. case (pow_R1 _ _ H'1); auto. intros H'0. rewrite <- H'0. apply Rmult_eq_reg_l with (r := 1%R); auto with real. pattern 1%R at 1 in |- *; rewrite <- H'0; auto with real. pattern (Rabs (/ r)) at 1 in |- *; rewrite Rabs_Rinv; try rewrite Rinv_l; auto with real. rewrite H'0; auto with real. apply Rabs_no_R0; auto. intros H'0; Contradict H'0; auto with zarith; apply convert_not_O. Qed. Theorem Rpow_eq_inv : forall (r : R) (p q : Z), r <> 0%R -> Rabs r <> 1%R -> powerRZ r p = powerRZ r q -> p = q. intros r p q H' H'0 H'1. cut (powerRZ r (p - q) = 1%R); [ intros Eq0 | idtac ]. case (Rpow_R1 _ _ H' Eq0); auto with zarith. intros H'2; case H'0; auto. apply Rmult_eq_reg_l with (r := powerRZ r q); auto with real. rewrite <- powerRZ_add; auto. replace (q + (p - q))%Z with p; auto with zarith. rewrite <- H'1; rewrite Rmult_1_r; auto with arith. Qed. Theorem Zpower_nat_powerRZ_absolu : forall n m : Z, (0 <= m)%Z -> IZR (Zpower_nat n (Z.abs_nat m)) = powerRZ (IZR n) m. intros n m; case m; simpl in |- *; auto with zarith. intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith. intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith. rewrite <- Rmult_IZR; auto. intros p H'; Contradict H'; auto with zarith. Qed. Theorem powerRZ_R1 : forall n : Z, powerRZ 1 n = 1%R. intros n; case n; simpl in |- *; auto. intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H'; ring. intros p; elim (nat_of_P p); simpl in |- *. exact Rinv_1. intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H'; auto with real. Qed. Theorem Rle_powerRZ : forall (e : R) (n m : Z), (1 <= e)%R -> (n <= m)%Z -> (powerRZ e n <= powerRZ e m)%R. intros e n m H' H'0. case H'; intros E1. case (Zle_lt_or_eq _ _ H'0); intros E2. apply Rlt_le; auto with real. rewrite <- E2; auto with real. repeat rewrite <- E1; repeat rewrite powerRZ_R1; auto with real. Qed. Theorem Zlt_powerRZ : forall (e : R) (n m : Z), (1 <= e)%R -> (powerRZ e n < powerRZ e m)%R -> (n < m)%Z. intros e n m H' H'0. case (Zle_or_lt m n); auto; intros Z1. Contradict H'0. apply Rle_not_lt. apply Rle_powerRZ; auto. Qed. Theorem Zle_powerRZ : forall (e : R) (n m : Z), (1 < e)%R -> (powerRZ e n <= powerRZ e m)%R -> (n <= m)%Z. intros e n m H' H'0. case (Zle_or_lt n m); auto; intros Z1. absurd (powerRZ e n <= powerRZ e m)%R; auto. apply Rlt_not_le. apply Rlt_powerRZ; auto. Qed. Theorem Rinv_powerRZ : forall (e : R) (n : Z), e <> 0%R -> (/ powerRZ e n)%R = powerRZ e (- n). intros e n H. apply Rmult_eq_reg_l with (powerRZ e n); auto with real zarith. rewrite Rinv_r; auto with real zarith. rewrite <- powerRZ_add; auto with real zarith. ring_simplify (n + - n)%Z; simpl in |- *; auto. Qed. float-8.10.0/Zdivides.v000066400000000000000000000431261357127175600147010ustar00rootroot00000000000000(**************************************************************************** IEEE754 : NDiv Laurent Thery ***************************************************************************** Definition of the quotient and divisibility for natural and relative numbers*) Require Export Omega. Require Export Paux. Definition oZ1 (x : Option positive) := match x with | None => 0%Z | Some z => Zpos z end. (* We use the function Pdiv function to build our Zquotient*) Definition Zquotient (n m : Z) := match n, m with | Z0, _ => 0%Z | _, Z0 => 0%Z | Zpos x, Zpos y => match Pdiv x y with | (x, _) => oZ1 x end | Zneg x, Zneg y => match Pdiv x y with | (x, _) => oZ1 x end | Zpos x, Zneg y => match Pdiv x y with | (x, _) => (- oZ1 x)%Z end | Zneg x, Zpos y => match Pdiv x y with | (x, _) => (- oZ1 x)%Z end end. Theorem inj_oZ1 : forall z, oZ1 z = Z_of_nat (oZ z). intros z; case z; simpl in |- *; try (intros; apply sym_equal; apply inject_nat_convert; auto); auto. Qed. Theorem Zero_le_oZ : forall z, 0 <= oZ z. intros z; case z; simpl in |- *; auto with arith. Qed. Hint Resolve Zero_le_oZ: arith. (* It has the required property *) Theorem ZquotientProp : forall m n : Z, n <> 0%Z -> ex (fun r : Z => m = (Zquotient m n * n + r)%Z /\ (Z.abs (Zquotient m n * n) <= Z.abs m)%Z /\ (Z.abs r < Z.abs n)%Z). intros m n; unfold Zquotient in |- *; case n; simpl in |- *. intros H; case H; auto. intros n' Hn'; case m; simpl in |- *; auto. exists 0%Z; repeat split; simpl in |- *; auto with zarith. intros m'; generalize (Pdiv_correct m' n'); case (Pdiv m' n'); simpl in |- *; auto. intros q r (H1, H2); exists (oZ1 r); repeat (split; auto with zarith). rewrite <- (inject_nat_convert (Zpos m') m'); auto. rewrite H1. rewrite inj_plus; rewrite inj_mult. rewrite <- (inject_nat_convert (Zpos n') n'); auto. repeat rewrite inj_oZ1; auto. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos m') m'); auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. intros m'; generalize (Pdiv_correct m' n'); case (Pdiv m' n'); simpl in |- *; auto. intros q r (H1, H2); exists (- oZ1 r)%Z; repeat (split; auto with zarith). replace (Zneg m') with (- Zpos m')%Z; [ idtac | simpl in |- *; auto ]. rewrite <- (inject_nat_convert (Zpos m') m'); auto. rewrite H1. rewrite inj_plus; rewrite inj_mult. rewrite <- (inject_nat_convert (Zpos n') n'); auto. repeat rewrite inj_oZ1; auto with zarith. ring. rewrite <- Zopp_mult_distr_l; rewrite Zabs_Zopp. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos m') m'); auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. rewrite Zabs_Zopp. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. intros n' Hn'; case m; simpl in |- *; auto. exists 0%Z; repeat split; simpl in |- *; auto with zarith. intros m'; generalize (Pdiv_correct m' n'); case (Pdiv m' n'); simpl in |- *; auto. intros q r (H1, H2); exists (oZ1 r); repeat (split; auto with zarith). replace (Zneg n') with (- Zpos n')%Z; [ idtac | simpl in |- *; auto ]. rewrite <- (inject_nat_convert (Zpos m') m'); auto. rewrite H1. rewrite inj_plus; rewrite inj_mult. rewrite <- (inject_nat_convert (Zpos n') n'); auto. repeat rewrite inj_oZ1; auto with zarith. ring. replace (Zneg n') with (- Zpos n')%Z; [ idtac | simpl in |- *; auto ]. rewrite Zmult_opp_opp. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. rewrite <- (inject_nat_convert (Zpos m') m'); auto with zarith. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. intros m'; generalize (Pdiv_correct m' n'); case (Pdiv m' n'); simpl in |- *; auto. intros q r (H1, H2); exists (- oZ1 r)%Z; repeat (split; auto with zarith). replace (Zneg m') with (- Zpos m')%Z; [ idtac | simpl in |- *; auto ]. rewrite <- (inject_nat_convert (Zpos m') m'); auto. replace (Zneg n') with (- Zpos n')%Z; [ idtac | simpl in |- *; auto ]. rewrite H1. rewrite inj_plus; rewrite inj_mult. rewrite <- (inject_nat_convert (Zpos n') n'); auto. repeat rewrite inj_oZ1; auto with zarith. ring. replace (Zneg n') with (- Zpos n')%Z; [ idtac | simpl in |- *; auto ]. rewrite <- Zopp_mult_distr_r; rewrite Zabs_Zopp. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos m') m'); auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. rewrite Zabs_Zopp. rewrite inj_oZ1; rewrite Z.abs_eq; auto with zarith. rewrite <- (inject_nat_convert (Zpos n') n'); auto with zarith. Qed. Theorem ZquotientPos : forall z1 z2 : Z, (0 <= z1)%Z -> (0 <= z2)%Z -> (0 <= Zquotient z1 z2)%Z. intros z1 z2 H H0; case (Z.eq_dec z2 0); intros Z1. rewrite Z1; red in |- *; case z1; simpl in |- *; auto; intros; red in |- *; intros; discriminate. case (ZquotientProp z1 z2); auto; intros r (H1, (H2, H3)). case (Zle_or_lt 0 (Zquotient z1 z2)); auto; intros Z2. Contradict H3; apply Zle_not_lt. replace r with (z1 - Zquotient z1 z2 * z2)%Z; [ idtac | pattern z1 at 1 in |- *; rewrite H1; ring ]. repeat rewrite Z.abs_eq; auto. pattern z2 at 1 in |- *; replace z2 with (0 + 1 * z2)%Z; [ idtac | ring ]. unfold Zminus in |- *; apply Z.le_trans with (z1 + 1 * z2)%Z; auto with zarith. apply Zplus_le_compat_l. rewrite Zopp_mult_distr_l. apply Zle_Zmult_comp_r; auto with zarith. unfold Zminus in |- *; rewrite Zopp_mult_distr_l; auto with zarith. Qed. (* The property of a number to divide another one (Ndivides n m) shoud be read as m divides n *) Definition Zdivides (n m : Z) := exists q : Z, n = (m * q)%Z. Theorem ZdividesZquotient : forall n m : Z, m <> 0%Z -> Zdivides n m -> n = (Zquotient n m * m)%Z. intros n m H' H'0. case H'0; intros z1 Hz1. case (ZquotientProp n m); auto; intros z2 (Hz2, (Hz3, Hz4)). cut (z2 = 0%Z); [ intros H1; pattern n at 1 in |- *; rewrite Hz2; rewrite H1; ring | idtac ]. cut (z2 = ((z1 - Zquotient n m) * m)%Z); [ intros H2 | idtac ]. case (Z.eq_dec (z1 - Zquotient n m) 0); intros H3. rewrite H2; rewrite H3; ring. Contradict Hz4. replace (Z.abs m) with (1 * Z.abs m)%Z; [ idtac | ring ]. apply Zle_not_lt; rewrite H2. rewrite Zabs_Zmult; apply Zle_Zmult_comp_r; auto with zarith. generalize H3; case (z1 - Zquotient n m)%Z; try (intros H1; case H1; auto; fail); simpl in |- *; intros p; case p; simpl in |- *; auto; intros; red in |- *; simpl in |- *; auto; red in |- *; intros; discriminate. rewrite Zmult_minus_distr_r; rewrite (Zmult_comm z1); rewrite <- Hz1; (pattern n at 1 in |- *; rewrite Hz2); ring. Qed. Theorem ZdividesZquotientInv : forall n m : Z, n = (Zquotient n m * m)%Z -> Zdivides n m. intros n m H'; red in |- *. exists (Zquotient n m); auto. pattern n at 1 in |- *; rewrite H'; auto with zarith. Qed. Theorem ZdividesMult : forall n m p : Z, Zdivides n m -> Zdivides (p * n) (p * m). intros n m p H'; red in H'. elim H'; intros q E. red in |- *. exists q. rewrite E. auto with zarith. Qed. Theorem Zeq_mult_simpl : forall a b c : Z, c <> 0%Z -> (a * c)%Z = (b * c)%Z -> a = b. intros a b c H H0. case (Zle_or_lt c 0); intros Zl1. apply Zle_antisym; apply Zmult_le_reg_r with (p := (- c)%Z); try apply Z.lt_gt; auto with zarith; repeat rewrite <- Zopp_mult_distr_r; rewrite H0; auto with zarith. apply Zle_antisym; apply Zmult_le_reg_r with (p := c); try apply Z.lt_gt; auto with zarith; rewrite H0; auto with zarith. Qed. Theorem ZdividesDiv : forall n m p : Z, p <> 0%Z -> Zdivides (p * n) (p * m) -> Zdivides n m. intros n m p H' H'0. case H'0; intros q E. exists q. apply Zeq_mult_simpl with (c := p); auto. rewrite (Zmult_comm n); rewrite E; ring. Qed. Definition ZdividesP : forall n m : Z, {Zdivides n m} + {~ Zdivides n m}. intros n m; case m. case n. left; red in |- *; exists 0%Z; auto with zarith. intros p; right; red in |- *; intros H; case H; simpl in |- *; intros f H1; discriminate. intros p; right; red in |- *; intros H; case H; simpl in |- *; intros f H1; discriminate. intros p; generalize (Z_eq_bool_correct (Zquotient n (Zpos p) * Zpos p) n); case (Z_eq_bool (Zquotient n (Zpos p) * Zpos p) n); intros H1. left; apply ZdividesZquotientInv; auto. right; Contradict H1; apply sym_equal; apply ZdividesZquotient; auto. red in |- *; intros; discriminate. intros p; generalize (Z_eq_bool_correct (Zquotient n (Zneg p) * Zneg p) n); case (Z_eq_bool (Zquotient n (Zneg p) * Zneg p) n); intros H1. left; apply ZdividesZquotientInv; auto. right; Contradict H1; apply sym_equal; apply ZdividesZquotient; auto. red in |- *; intros; discriminate. Defined. (* Eval Compute in (ZdividesP (POS (xO (xO xH))) (POS (xO xH))). *) Theorem Zquotient1 : forall m : Z, Zquotient m 1 = m. intros m. case (ZquotientProp m 1); auto. red in |- *; intros; discriminate. intros z (H1, (H2, H3)). pattern m at 2 in |- *; rewrite H1; replace z with 0%Z; try ring. generalize H3; case z; simpl in |- *; auto; intros p; case p; unfold Z.lt in |- *; simpl in |- *; intros; discriminate. Qed. Theorem Zdivides1 : forall m : Z, Zdivides m 1. intros m; exists m; auto with zarith. Qed. Theorem Zabs_eq_case : forall z1 z2 : Z, Z.abs z1 = Z.abs z2 -> z1 = z2 \/ z1 = (- z2)%Z. intros z1 z2; case z1; case z2; simpl in |- *; auto; try (intros; discriminate); intros p1 p2 H1; injection H1; (intros H2; rewrite H2); auto. Qed. Theorem Zabs_tri : forall z1 z2 : Z, (Z.abs (z1 + z2) <= Z.abs z1 + Z.abs z2)%Z. intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail). intros p1 p2; apply Zabs_intro with (P := fun x => (x <= Z.abs (Zpos p2) + Z.abs (Zneg p1))%Z); try rewrite Zopp_plus_distr; auto with zarith. intros p1 p2; apply Zabs_intro with (P := fun x => (x <= Z.abs (Zpos p2) + Z.abs (Zneg p1))%Z); try rewrite Zopp_plus_distr; auto with zarith. Qed. Hint Resolve Zabs_tri: zarith. Theorem ZquotientUnique : forall m n q r : Z, n <> 0%Z -> m = (q * n + r)%Z -> (Z.abs (q * n) <= Z.abs m)%Z -> (Z.abs r < Z.abs n)%Z -> q = Zquotient m n. intros m n q r H' H'0 H'1 H'2. case (ZquotientProp m n); auto; intros z (H0, (H1, H2)). case (Zle_or_lt (Z.abs q) (Z.abs (Zquotient m n))); intros Zl1; auto with arith. case (Zle_lt_or_eq _ _ Zl1); clear Zl1; intros Zl1; auto with arith. Contradict H1; apply Zlt_not_le. pattern m at 1 in |- *; rewrite H'0. apply Z.le_lt_trans with (Z.abs (q * n) + Z.abs r)%Z; auto with zarith. apply Z.lt_le_trans with (Z.abs (q * n) + Z.abs n)%Z; auto with zarith. repeat rewrite Zabs_Zmult. replace (Z.abs q * Z.abs n + Z.abs n)%Z with (Z.succ (Z.abs q) * Z.abs n)%Z; [ auto with zarith | unfold Z.succ in |- *; ring ]. case (Zabs_eq_case _ _ Zl1); auto. intros H; (cut (Zquotient m n = 0%Z); [ intros H3; rewrite H; repeat rewrite H3; simpl in |- *; auto | idtac ]). cut (Z.abs (Zquotient m n) < 1)%Z. case (Zquotient m n); simpl in |- *; auto; intros p; case p; unfold Z.lt in |- *; simpl in |- *; intros; discriminate. apply Zlt_mult_simpl_l with (c := Z.abs n); auto with zarith. case (Zle_lt_or_eq 0 (Z.abs n)); auto with zarith. intros H3; case H'; auto. generalize H3; case n; simpl in |- *; auto; intros; discriminate. rewrite <- Zabs_Zmult; rewrite (Zmult_comm n). replace (Z.abs n * 1)%Z with (Z.abs n); [ idtac | ring ]. apply Z.le_lt_trans with (1 := H1). apply Zlt_mult_simpl_l with (c := (1 + 1)%Z); auto with zarith. replace ((1 + 1) * Z.abs m)%Z with (Z.abs (m + m)). replace ((1 + 1) * Z.abs n)%Z with (Z.abs n + Z.abs n)%Z; [ idtac | ring ]. pattern m at 1 in |- *; rewrite H'0; rewrite H0; rewrite H. replace (- Zquotient m n * n + r + (Zquotient m n * n + z))%Z with (r + z)%Z; [ idtac | ring ]. apply Z.le_lt_trans with (Z.abs r + Z.abs z)%Z; auto with zarith. rewrite <- (Z.abs_eq (1 + 1)); auto with zarith. rewrite <- Zabs_Zmult; apply f_equal with (f := Z.abs); auto with zarith. Contradict H'1; apply Zlt_not_le. pattern m at 1 in |- *; rewrite H0. apply Z.le_lt_trans with (Z.abs (Zquotient m n * n) + Z.abs z)%Z; auto with zarith. apply Z.lt_le_trans with (Z.abs (Zquotient m n * n) + Z.abs n)%Z; auto with zarith. repeat rewrite Zabs_Zmult. replace (Z.abs (Zquotient m n) * Z.abs n + Z.abs n)%Z with (Z.succ (Z.abs (Zquotient m n)) * Z.abs n)%Z; [ auto with zarith | unfold Z.succ in |- *; ring ]. Qed. Theorem ZquotientZopp : forall m n : Z, Zquotient (- m) n = (- Zquotient m n)%Z. intros m n; case (Z.eq_dec n 0); intros Z1. rewrite Z1; unfold Zquotient in |- *; case n; case m; simpl in |- *; auto. case (ZquotientProp m n); auto; intros r1 (H'2, (H'3, H'4)); auto with zarith. apply sym_equal; apply ZquotientUnique with (q := (- Zquotient m n)%Z) (r := (- r1)%Z); auto. pattern m at 1 in |- *; rewrite H'2; ring. rewrite <- Zopp_mult_distr_l; repeat rewrite Zabs_Zopp; auto. rewrite Zabs_Zopp; auto. Qed. Theorem ZquotientMonotone : forall n m q : Z, (Z.abs n <= Z.abs m)%Z -> (Z.abs (Zquotient n q) <= Z.abs (Zquotient m q))%Z. intros n m q H; case (Zle_lt_or_eq _ _ H); intros Z0. case (Z.eq_dec q 0); intros Z1. rewrite Z1; unfold Zquotient in |- *; case n; case m; simpl in |- *; auto with zarith. case (Zle_or_lt (Z.abs (Zquotient n q)) (Z.abs (Zquotient m q))); auto; intros H'1. case (ZquotientProp m q); auto; intros r1 (H'2, (H'3, H'4)); auto with zarith. case (ZquotientProp n q); auto; intros r2 (H'5, (H'6, H'7)); auto with zarith. Contradict H'6. apply Zlt_not_le. apply Z.lt_le_trans with (1 := Z0). rewrite H'2. apply Z.le_trans with (Z.abs (Zquotient m q * q) + Z.abs r1)%Z; auto with zarith. apply Z.le_trans with (Z.abs (Zquotient m q * q) + Z.abs q)%Z; auto with zarith. repeat rewrite Zabs_Zmult. replace (Z.abs (Zquotient m q) * Z.abs q + Z.abs q)%Z with (Z.succ (Z.abs (Zquotient m q)) * Z.abs q)%Z; [ idtac | unfold Z.succ in |- *; ring ]. cut (0 < Z.abs q)%Z; auto with zarith. case (Zle_lt_or_eq 0 (Z.abs q)); auto with zarith. intros H'6; case Z1; auto. generalize H'6; case q; simpl in |- *; auto; intros; discriminate. case (Zabs_eq_case _ _ Z0); intros Z1; rewrite Z1; auto with zarith. rewrite ZquotientZopp; rewrite Zabs_Zopp; auto with zarith. Qed. Theorem NotDividesDigit : forall r v : Z, (1 < r)%Z -> v <> 0%Z -> ~ Zdivides v (Zpower_nat r (digit r v)). intros r v H H'; red in |- *; intros H'0; case H'0; intros q E. absurd (Z.abs v < Zpower_nat r (digit r v))%Z; auto with zarith. apply Zle_not_lt. case (Z.eq_dec q 0); intros Z1. case H'; rewrite E; rewrite Z1; ring. pattern v at 2 in |- *; rewrite E. rewrite Zabs_Zmult. pattern (Zpower_nat r (digit r v)) at 1 in |- *; replace (Zpower_nat r (digit r v)) with (Zpower_nat r (digit r v) * 1)%Z; [ idtac | ring ]. rewrite (fun x y => Z.abs_eq (Zpower_nat x y)); auto with zarith. apply Zle_Zmult_comp_l; auto with zarith. generalize Z1; case q; simpl in |- *; try (intros H1; case H1; auto; fail); intros p; (case p; unfold Z.le in |- *; simpl in |- *; intros; red in |- *; intros; discriminate). Qed. Theorem ZDividesLe : forall n m : Z, n <> 0%Z -> Zdivides n m -> (Z.abs m <= Z.abs n)%Z. intros n m H' H'0; case H'0; intros q E; rewrite E. rewrite Zabs_Zmult. pattern (Z.abs m) at 1 in |- *; replace (Z.abs m) with (Z.abs m * 1)%Z; [ idtac | ring ]. apply Zle_Zmult_comp_l; auto with zarith. generalize E H'; case q; simpl in |- *; auto; try (intros H1 H2; case H2; rewrite H1; ring; fail); intros p; case p; unfold Z.le in |- *; simpl in |- *; intros; red in |- *; discriminate. Qed. Theorem Zquotient_mult_comp : forall m n p : Z, p <> 0%Z -> Zquotient (m * p) (n * p) = Zquotient m n. intros m n p Z1; case (Z.eq_dec n 0); intros Z2. rewrite Z2; unfold Zquotient in |- *; case (m * p)%Z; case m; simpl in |- *; auto. case (ZquotientProp m n); auto; intros r (H1, (H2, H3)). apply sym_equal; apply ZquotientUnique with (r := (r * p)%Z); auto with zarith. pattern m at 1 in |- *; rewrite H1; ring. rewrite Zmult_assoc. repeat rewrite (fun x => Zabs_Zmult x p); auto with zarith. repeat rewrite Zabs_Zmult; auto with zarith. apply Zmult_gt_0_lt_compat_r; auto with zarith. apply Z.lt_gt; generalize Z1; case p; simpl in |- *; try (intros H4; case H4; auto; fail); unfold Z.lt in |- *; simpl in |- *; auto; intros; red in |- *; intros; discriminate. Qed. Theorem ZDivides_add : forall n m p : Z, Zdivides n p -> Zdivides m p -> Zdivides (n + m) p. intros n m p H' H'0. case H'; intros z1 Hz1. case H'0; intros z2 Hz2. exists (z1 + z2)%Z; rewrite Hz1; rewrite Hz2; ring. Qed. Theorem NDivides_minus : forall n m p : Z, Zdivides n p -> Zdivides m p -> Zdivides (n - m) p. intros n m p H' H'0. case H'; intros z1 Hz1. case H'0; intros z2 Hz2. exists (z1 - z2)%Z; rewrite Hz1; rewrite Hz2; ring. Qed. Theorem ZDivides_mult : forall n m p q : Z, Zdivides n p -> Zdivides m q -> Zdivides (n * m) (p * q). intros n m p q H' H'0. case H'; intros z1 Hz1. case H'0; intros z2 Hz2. exists (z1 * z2)%Z; rewrite Hz1; rewrite Hz2; ring. Qed. Theorem ZdividesTrans : forall n m p : Z, Zdivides n m -> Zdivides m p -> Zdivides n p. intros n m p H' H'0. case H'; intros z1 Hz1. case H'0; intros z2 Hz2. exists (z1 * z2)%Z; rewrite Hz1; rewrite Hz2; ring. Qed. Theorem ZdividesLessPow : forall (n : Z) (m p : nat), m <= p -> Zdivides (Zpower_nat n p) (Zpower_nat n m). intros n m p H'; exists (Zpower_nat n (p - m)). rewrite <- Zpower_nat_is_exp. rewrite <- le_plus_minus; auto. Qed. float-8.10.0/Zenum.v000066400000000000000000000130051357127175600142070ustar00rootroot00000000000000(**************************************************************************** IEEE754 : Zenum Laurent Thery ***************************************************************************** Simple functions to enumerate relative numbers *) Require Export Faux. Require Export Omega. Require Export List. (* Returns the list of relative numbers from z to z+n *) Fixpoint mZlist_aux (p : Z) (n : nat) {struct n} : list Z := match n with | O => p :: nil | S n1 => p :: mZlist_aux (Z.succ p) n1 end. Theorem mZlist_aux_correct : forall (n : nat) (p q : Z), (p <= q)%Z -> (q <= p + Z_of_nat n)%Z -> In q (mZlist_aux p n). intros n; elim n; clear n; auto. intros p q; try rewrite <- Zplus_0_r_reverse. intros H' H'0; simpl in |- *; left. apply Zle_antisym; auto. intros n H' p q H'0 H'1; case (Zle_lt_or_eq _ _ H'0); intros H'2. simpl in |- *; right. apply H'; auto with zarith. rewrite Zplus_succ_comm. rewrite <- inj_S; auto. simpl in |- *; auto. Qed. Theorem mZlist_aux_correct_rev1 : forall (n : nat) (p q : Z), In q (mZlist_aux p n) -> (p <= q)%Z. intros n; elim n; clear n; simpl in |- *; auto. intros p q H'; elim H'; auto with zarith. intros n H' p q H'0; elim H'0; auto with zarith. intros H'1; apply Zle_succ_le; auto with zarith. Qed. Theorem mZlist_aux_correct_rev2 : forall (n : nat) (p q : Z), In q (mZlist_aux p n) -> (q <= p + Z_of_nat n)%Z. intros n; elim n; clear n; auto. intros p q H'; elim H'; auto with zarith. intros H'0; elim H'0. intros n H' p q H'0; elim H'0; auto with zarith. intros H'1; rewrite inj_S; rewrite <- Zplus_succ_comm; auto. Qed. (* Return the list of of relative numbres from p to p+q if p= p :: nil | Zpos d => mZlist_aux p (nat_of_P d) | Zneg _ => nil (A:=Z) end. Theorem mZlist_correct : forall p q r : Z, (p <= r)%Z -> (r <= q)%Z -> In r (mZlist p q). intros p q r H' H'0; unfold mZlist in |- *; CaseEq (q - p)%Z; auto with zarith. intros H'1; rewrite (Zle_antisym r p); auto with datatypes. auto with zarith. intros p0 H'1; apply mZlist_aux_correct; auto. rewrite inject_nat_convert with (1 := H'1); auto with zarith. intros p0 H'1; absurd (p <= q)%Z; auto. apply Zlt_not_le; auto. apply Zlt_O_minus_lt; auto. replace (p - q)%Z with (- (q - p))%Z; auto with zarith. rewrite H'1; simpl in |- *; auto with zarith. unfold Z.lt in |- *; simpl in |- *; auto. apply Z.le_trans with (m := r); auto. Qed. Theorem mZlist_correct_rev1 : forall p q r : Z, In r (mZlist p q) -> (p <= r)%Z. intros p q r; unfold mZlist in |- *; CaseEq (q - p)%Z. intros H' H'0; elim H'0; auto with zarith. intros H'1; elim H'1. intros p0 H' H'0. apply mZlist_aux_correct_rev1 with (n := nat_of_P p0); auto. intros p0 H' H'0; elim H'0. Qed. Theorem mZlist_correct_rev2 : forall p q r : Z, In r (mZlist p q) -> (r <= q)%Z. intros p q r; unfold mZlist in |- *; CaseEq (q - p)%Z. intros H' H'0; elim H'0; auto with zarith. intros H'1; elim H'1. intros p0 H' H'0. rewrite <- (Zplus_minus p q). rewrite <- inject_nat_convert with (1 := H'). apply mZlist_aux_correct_rev2; auto. intros p0 H' H'0; elim H'0. Qed. (* Given two list returns the list of possible product of an element of the first list with an element of the second list *) Fixpoint mProd (A B C : Set) (l1 : list A) (l2 : list B) {struct l2} : list (A * B) := match l2 with | nil => nil | b :: l2' => map (fun a : A => (a, b)) l1 ++ mProd A B C l1 l2' end. Theorem mProd_correct : forall (A B C : Set) (l1 : list A) (l2 : list B) (a : A) (b : B), In a l1 -> In b l2 -> In (a, b) (mProd A B C l1 l2). intros A B C l1 l2; elim l2; simpl in |- *; auto. intros a l H' a0 b H'0 H'1; elim H'1; [ intros H'2; rewrite <- H'2; clear H'1 | intros H'2; clear H'1 ]; auto with datatypes. apply in_or_app; left; auto with datatypes. generalize H'0; elim l1; simpl in |- *; auto with datatypes. intros a1 l0 H'1 H'3; elim H'3; clear H'3; intros H'4; [ rewrite <- H'4 | idtac ]; auto with datatypes. Qed. Theorem mProd_correct_rev1 : forall (A B C : Set) (l1 : list A) (l2 : list B) (a : A) (b : B), In (a, b) (mProd A B C l1 l2) -> In a l1. intros A B C l1 l2; elim l2; simpl in |- *; auto. intros a H' H'0; elim H'0. intros a l H' a0 b H'0. case (in_app_or _ _ _ H'0); auto with datatypes. elim l1; simpl in |- *; auto with datatypes. intros a1 l0 H'1 H'2; elim H'2; clear H'2; intros H'3; [ inversion H'3 | idtac ]; auto with datatypes. intros H'1; apply H' with (b := b); auto. Qed. Theorem mProd_correct_rev2 : forall (A B C : Set) (l1 : list A) (l2 : list B) (a : A) (b : B), In (a, b) (mProd A B C l1 l2) -> In b l2. intros A B C l1 l2; elim l2; simpl in |- *; auto. intros a l H' a0 b H'0. case (in_app_or _ _ _ H'0); auto with datatypes. elim l1; simpl in |- *; auto with datatypes. intros H'1; elim H'1; auto. intros a1 l0 H'1 H'2; elim H'2; clear H'2; intros H'3; [ inversion H'3 | idtac ]; auto with datatypes. intros H'1; right; apply H' with (a := a0); auto. Qed. Theorem in_map_inv : forall (A B : Set) (f : A -> B) (l : list A) (x : A), (forall a b : A, f a = f b -> a = b) -> In (f x) (map f l) -> In x l. intros A B f l; elim l; simpl in |- *; auto. intros a l0 H' x H'0 H'1; elim H'1; clear H'1; intros H'2; auto. Qed. float-8.10.0/description000066400000000000000000000004721357127175600151740ustar00rootroot00000000000000Name: Float Title: Library for floating point numbers Author: Laurent Théry Institution: INRIA Sophia-Antipolis Author: Sylvie Boldo Institution: ENS Lyon Date: 2001 Description: A library for floating point numbers. Keywords: floating point arithmetic Category: Computer Science/Data Types and Data Structures float-8.10.0/sTactic.v000066400000000000000000000027441357127175600145130ustar00rootroot00000000000000 (**************************************************************************** IEEE754 : sTactic Laurent Thery ***************************************************************************** *) Global Set Asymmetric Patterns. (* Some simple tactics *) Theorem Contradict1 : forall a b : Prop, b -> (a -> ~ b) -> ~ a. intuition. Qed. Theorem Contradict2 : forall a b : Prop, b -> ~ b -> a. intuition. Qed. Theorem Contradict3 : forall a : Prop, a -> ~ ~ a. auto. Qed. (* Contradict is used to contradict an hypothesis H if we have H:~A |- B the result is |- A if we have H:~A |- ~B the result is H:B |- A *) Ltac Contradict name := (simple apply (fun a : Prop => Contradict1 a _ name); clear name; intros name) || (simple apply (fun a : Prop => Contradict2 a _ name); clear name); try simple apply Contradict3. (* Same as Case but keeps an equality *) Ltac CaseEq name := generalize (refl_equal name); pattern name at -1 in |- *; case name. (* Same as Case but cleans the case variable *) Ltac Casec name := case name; clear name. (* Same as Elim but cleans the elim variable *) Ltac Elimc name := elim name; clear name.