Library Float.Expansions.FexpPlus
Require Export Fexp.
Section mf.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Coercion Local FtoRradix := FtoR radix.
Variable b : Fbound.
Variable precision : nat.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
Variable TwoSum : float -> float -> float * float.
Hypothesis
TwoSum1 :
forall p q : float,
Fbounded b p ->
Fbounded b q -> Closest b radix (p + q) (fst (TwoSum p q)).
Hypothesis
TwoSum2 :
forall p q : float,
Fbounded b p ->
Fbounded b q -> snd (TwoSum p q) = (p + q - fst (TwoSum p q))%R :>R.
Hypothesis
TwoSum3 :
forall p q : float,
Fbounded b p -> Fbounded b q -> Fbounded b (fst (TwoSum p q)).
Hypothesis
TwoSum4 :
forall p q : float,
Fbounded b p -> Fbounded b q -> Fbounded b (snd (TwoSum p q)).
Hypothesis
TwoSumEq1 :
forall p q r s : float,
Fbounded b p ->
Fbounded b q ->
Fbounded b r ->
Fbounded b s ->
p = q :>R -> r = s :>R -> fst (TwoSum p r) = fst (TwoSum q s) :>R.
Hypothesis
TwoSumEq2 :
forall p q r s : float,
Fbounded b p ->
Fbounded b q ->
Fbounded b r ->
Fbounded b s ->
p = q :>R -> r = s :>R -> snd (TwoSum p r) = snd (TwoSum q s) :>R.
Fixpoint growExp (p : float) (L : list float) {struct L} :
list float :=
match L with
| nil => p :: nil
| x :: L1 => match TwoSum p x with
| (h, c) => c :: growExp h L1
end
end.
Theorem TwoSumExp :
forall p q : float,
Fbounded b p ->
Fbounded b q ->
IsExpansion b radix (snd (TwoSum p q) :: fst (TwoSum p q) :: nil).
intros p q H' H'0.
case (Z_zerop (Fnum (snd (TwoSum p q)))); intros Z1.
apply IsExpansionTop1; auto.
apply IsExpansionSingle; auto.
case (Z_zerop (Fnum (fst (TwoSum p q)))); intros Z2.
apply IsExpansionTop2; auto.
apply IsExpansionSingle; auto.
apply IsExpansionTop; auto.
cut
(snd (TwoSum p q) = Fminus radix (Fplus radix p q) (fst (TwoSum p q)) :>R);
[ intros Eq1 | idtac ].
rewrite (MSB_comp radix) with (4 := Eq1); auto.
apply (MSBroundLSB b radix precision) with (P := Closest b radix); auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix (p + q)%R) with (p0 := fst (TwoSum p q));
auto.
apply sym_eq; apply (Fplus_correct radix); auto with arith.
apply NisFzeroComp with (radix := radix) (x := snd (TwoSum p q)); auto.
rewrite (Fminus_correct radix); auto with arith;
rewrite (Fplus_correct radix); auto with arith.
apply IsExpansionSingle; auto.
Qed.
Theorem TwoSumOl1 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero q -> fst (TwoSum p q) = p :>R.
intros p q H' H'0 H'1; generalize (TwoSum1 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f H'2 H'3.
apply sym_eq;
apply
(RoundedModeProjectorIdemEq b radix precision) with (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := H'3); auto.
replace (FtoRradix q) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
Qed.
Theorem TwoSumOl2 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero q -> snd (TwoSum p q) = 0%R :>R.
intros p q H' H'0 H'1; generalize (TwoSumOl1 p q H' H'0 H'1);
generalize (TwoSum2 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f f0 H'2 H'3.
rewrite H'2.
rewrite H'3.
replace (FtoRradix q) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
Qed.
Theorem TwoSumOr1 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero p -> fst (TwoSum p q) = q :>R.
intros p q H' H'0 H'1; generalize (TwoSum1 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f H'2 H'3.
apply sym_eq;
apply
(RoundedModeProjectorIdemEq b radix precision) with (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := H'3); auto.
replace (FtoRradix p) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
Qed.
Theorem TwoSumOr2 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero p -> snd (TwoSum p q) = 0%R :>R.
intros p q H' H'0 H'1; generalize (TwoSumOr1 p q H' H'0 H'1);
generalize (TwoSum2 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f f0 H'2 H'3.
rewrite H'2.
rewrite H'3.
replace (FtoRradix p) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
Qed.
Theorem growExpIsVal :
forall L : list float,
IsExpansion b radix L ->
forall p : float,
Fbounded b p -> expValue radix (growExp p L) = (p + expValue radix L)%R :>R.
intros L; elim L.
simpl in |- *; auto.
intros H' p H'0; rewrite (Fplus_correct radix); auto with arith.
intros a l H' H'0 p H'1; simpl in |- *.
CaseEq (TwoSum p a).
intros f f0 H'2; simpl in |- *.
repeat rewrite (Fplus_correct radix); auto with arith.
rewrite H'.
repeat rewrite <- Rplus_assoc.
cut (Fbounded b a);
[ intros Fb1 | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (TwoSum2 _ _ H'1 Fb1); rewrite H'2; simpl in |- *.
unfold FtoRradix in |- *; intros H'3; rewrite H'3; ring; ring.
apply expInv with (a := a); auto.
cut (Fbounded b a);
[ intros Fb1 | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (TwoSum3 _ _ H'1 Fb1); rewrite H'2; simpl in |- *; auto.
Qed.
Theorem IsExpansionCons :
forall L : list float,
IsExpansion b radix L ->
forall p : float,
~ is_Fzero p ->
Fbounded b p ->
(forall q : float, In q L -> ~ is_Fzero q -> (MSB radix p < LSB radix q)%Z) ->
IsExpansion b radix (p :: L).
intros L; elim L.
intros H' p H'0 H'1 H'2; apply IsExpansionSingle; auto.
intros a l H' H'0 p H'1 H'2 H'3.
case (is_FzeroP a); intros Z1.
apply IsExpansionTop2; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply H'; auto.
apply expInv with (a := a); auto.
intros q H'4 H'5; apply H'3; auto.
simpl in |- *; auto.
apply IsExpansionTop; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply H'3; auto with datatypes.
Qed.
Theorem IsExpansionConsInvAux :
forall L : list float,
IsExpansion b radix L ->
forall (L' : list float) (p q : float),
~ is_Fzero p ->
L = p :: L' -> In q L' -> ~ is_Fzero q -> (MSB radix p < LSB radix q)%Z.
intros L H'; elim H'; auto.
intros L' p q H'0 H'1; discriminate.
intros x H'0 L' p q H'1 H'2; inversion H'2; simpl in |- *.
intros H'3; elim H'3.
intros x L0 H'0 H'1 H'2 H'3 L' p q H'4 H'5; inversion H'5; auto.
case H'4; rewrite <- H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 L' p q H'5 H'6; inversion H'6.
simpl in |- *; auto.
intros H'7 H'8; case H'7; intros H'9.
case H'8; rewrite <- H'9; auto.
apply H'4 with (L' := L0); auto.
rewrite H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 L' p q H'7 H'8; inversion H'8; auto.
simpl in |- *; auto.
intros H'9 H'10; case H'9; intros H'11.
rewrite <- H'11; rewrite <- H0; auto.
apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
apply H'6 with (L' := L0); auto.
Qed.
Theorem IsExpansionConsInv :
forall (L : list float) (p q : float),
~ is_Fzero p ->
IsExpansion b radix (p :: L) ->
In q L -> ~ is_Fzero q -> (MSB radix p < LSB radix q)%Z.
intros L p q H' H'0 H'1 H'2.
apply IsExpansionConsInvAux with (L := p :: L) (L' := L); auto.
Qed.
Theorem IsExpansionSkip :
forall (L : list float) (p q : float),
IsExpansion b radix (p :: q :: L) -> IsExpansion b radix (p :: L).
intros L p q H'.
case (is_FzeroP p); intros Z1.
apply IsExpansionTop1; auto.
apply expBoundedInv with (radix := radix) (L := q :: L); auto.
apply expInv with (a := q); auto.
apply expInv with (a := p); auto.
apply IsExpansionCons; auto.
apply expInv with (a := q); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := q :: L); auto.
intros q0 H'0 H'1.
apply IsExpansionConsInv with (L := q :: L); auto with datatypes.
Qed.
Theorem TwoSumLt1 :
forall p q : float,
Fbounded b p ->
Fbounded b q ->
~ is_Fzero p ->
~ is_Fzero q ->
~ is_Fzero (fst (TwoSum p q)) ->
(Zmin (LSB radix p) (LSB radix q) <= LSB radix (fst (TwoSum p q)))%Z.
intros p q H'0 H'1 H'2 H'3 H'4.
apply Zle_trans with (LSB radix (Fplus radix p q)); auto.
case (LSB_rep_min radix radixMoreThanOne p); auto; intros p' Hp'.
case (LSB_rep_min radix radixMoreThanOne q); auto; intros q' Hq'.
apply LSBPlus; auto.
Contradict H'4; auto.
apply (is_Fzero_rep2 radix); auto.
rewrite <- (FzeroisZero radix b); auto.
apply sym_eq;
apply
RoundedModeProjectorIdemEq
with (b := b) (precision := precision) (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply FboundedFzero; auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H'0 H'1); auto.
rewrite (FzeroisZero radix b); auto.
replace 0%R with (FtoRradix (Fplus radix p q)); auto.
rewrite (Fplus_correct radix); auto with arith.
apply (is_Fzero_rep1 radix); auto.
repeat rewrite (Fplus_correct radix); auto with arith.
apply
RoundLSBMax with (b := b) (precision := precision) (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H'0 H'1); auto.
rewrite Fplus_correct; auto with arith.
Qed.
Theorem TwoSumLt2 :
forall p q : float,
Fbounded b p ->
Fbounded b q ->
~ is_Fzero p ->
~ is_Fzero q ->
~ is_Fzero (snd (TwoSum p q)) ->
(Zmin (LSB radix p) (LSB radix q) <= LSB radix (snd (TwoSum p q)))%Z.
intros p q H' H'0 H'1 H'2 H'3.
case (is_FzeroP (fst (TwoSum p q))); intros Z1.
cut (snd (TwoSum p q) = Fplus radix p q :>R); [ intros Eq1 | idtac ].
replace (LSB radix (snd (TwoSum p q))) with (LSB radix (Fplus radix p q));
auto.
apply LSBPlus; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
apply LSB_comp; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
rewrite TwoSum2; auto.
unfold FtoRradix in |- *; rewrite (is_Fzero_rep1 radix) with (1 := Z1); auto.
rewrite Fplus_correct; auto with arith; ring.
cut
(snd (TwoSum p q) = Fminus radix (Fplus radix p q) (fst (TwoSum p q)) :>R);
[ intros Eq1 | idtac ].
replace (LSB radix (snd (TwoSum p q))) with
(LSB radix (Fminus radix (Fplus radix p q) (fst (TwoSum p q)))).
apply
Zle_trans
with (Zmin (LSB radix (Fplus radix p q)) (LSB radix (fst (TwoSum p q))));
auto.
apply Zmin_Zle; auto.
apply LSBPlus; auto.
Contradict Z1; auto.
apply (is_Fzero_rep2 radix); auto.
rewrite <- (FzeroisZero radix b); auto.
apply sym_eq;
apply
RoundedModeProjectorIdemEq
with (b := b) (precision := precision) (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply FboundedFzero; auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H' H'0); auto.
rewrite (FzeroisZero radix b); auto.
replace 0%R with (FtoRradix (Fplus radix p q)); auto.
rewrite (Fplus_correct radix); auto with arith.
apply (is_Fzero_rep1 radix); auto.
apply TwoSumLt1; auto.
apply LSBMinus; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
apply LSB_comp; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
rewrite TwoSum2; auto.
rewrite (Fminus_correct radix); auto with arith;
rewrite (Fplus_correct radix); auto with arith.
Qed.
Theorem IsExpansionGrowConsInvAux :
forall L : list float,
IsExpansion b radix L ->
forall (L' : list float) (p q r : float),
Fbounded b r ->
~ is_Fzero p ->
L = p :: L' ->
In q (growExp r L') ->
~ is_Fzero q ->
(is_Fzero r -> (MSB radix p < LSB radix q)%Z) /\
(~ is_Fzero r ->
(MSB radix p < LSB radix q)%Z \/ (LSB radix r <= LSB radix q)%Z).
intros L H'; elim H'; simpl in |- *; auto.
intros L' p q r H'0 H'1 H'2; discriminate.
intros x H'0 L' p q r H'1 H'2 H'3; inversion H'3; simpl in |- *; auto.
intros H'4 H'5; split; case H'4.
intros H'6 H'7; case H'5; rewrite <- H'6; auto.
intros H'6; elim H'6; auto.
intros H'6; rewrite <- H'6; auto with zarith.
intros H'6; elim H'6.
intros x L0 H'0 H'1 H'2 H'3 L' p q r H'4 H'5 H'6; inversion H'6; auto.
case H'5; rewrite <- H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 L' p q r H'5 H'6 H'7; inversion H'7.
simpl in |- *.
CaseEq (TwoSum r y); simpl in |- *; auto.
intros f f0 H'8 H'9; elim H'9; intros H'10.
intros H'11; case H'11; rewrite <- H'10.
apply (is_Fzero_rep2 radix); auto.
replace (FtoR radix f0) with (FtoRradix (snd (TwoSum r y))); auto.
apply TwoSumOl2; auto.
rewrite H'8; auto.
split.
intros H'11.
case (H'4 L0 p q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'8; auto.
rewrite <- H0; auto.
intros H'12 H'13; apply H'12; auto.
replace f with (fst (TwoSum r y)); auto.
apply (is_Fzero_rep2 radix); auto.
replace 0%R with (FtoRradix r).
apply TwoSumOl1; auto.
apply (is_Fzero_rep1 radix); auto.
rewrite H'8; auto.
intros H'11.
case (H'4 L0 p q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'8; auto.
rewrite <- H0; auto.
intros H'13 H'14.
case (is_FzeroP f); intros Z1; auto.
replace (LSB radix r) with (LSB radix f); auto.
apply LSB_comp; auto.
replace f with (fst (TwoSum r y)); auto.
apply TwoSumOl1; auto.
rewrite H'8; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 L' p q r H'7 H'8 H'9; inversion H'9.
simpl in |- *; auto.
CaseEq (TwoSum r y); simpl in |- *; auto.
intros f f0 H'10 H'11; case H'11; intros H'12.
rewrite <- H'12; auto.
intros H'13; split; auto.
intros H'14; case H'13.
replace f0 with (snd (TwoSum r y)); auto.
apply (is_Fzero_rep2 radix); auto.
apply TwoSumOr2; auto.
rewrite H'10; auto.
intros H'14.
cut (Zmin (LSB radix r) (LSB radix y) <= LSB radix (snd (TwoSum r y)))%Z.
rewrite H'10; simpl in |- *; auto.
unfold Zmin in |- *; case (LSB radix r ?= LSB radix y)%Z; auto.
intros H'15; left; apply Zlt_le_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply TwoSumLt2; auto.
rewrite H'10; auto.
intros H'13.
case (H'6 L0 y q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'10; auto.
intros H'14 H'15; split.
intros H'16.
case H'15; auto.
apply (NisFzeroComp radix) with (2 := H'1); auto.
replace f with (fst (TwoSum r y)); auto.
apply sym_eq; apply TwoSumOr1; auto.
rewrite H'10; auto.
intros H'17; apply Zlt_trans with (LSB radix y).
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
intros H'17; apply Zlt_le_trans with (LSB radix y).
rewrite <- H0; auto.
replace (LSB radix y) with (LSB radix f); auto.
apply sym_equal; apply LSB_comp; auto.
replace f with (fst (TwoSum r y)); auto.
apply sym_eq; apply TwoSumOr1; auto.
rewrite H'10; auto.
intros H'16; case (is_FzeroP f); intros Z1.
left; apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
case H'15; auto; intros H'17.
left; apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
cut (Zmin (LSB radix r) (LSB radix y) <= LSB radix (fst (TwoSum r y)))%Z.
rewrite H'10; simpl in |- *; auto.
unfold Zmin in |- *; case (LSB radix r ?= LSB radix y)%Z; auto.
intros H'18; right; apply Zle_trans with (1 := H'18); auto.
intros H'18; right; apply Zle_trans with (1 := H'18); auto.
intros H'18; left; apply Zlt_le_trans with (LSB radix y).
rewrite <- H0; auto.
apply Zle_trans with (1 := H'18); auto.
apply TwoSumLt1; auto.
rewrite H'10; auto.
Qed.
Theorem growExpIsExp :
forall L : list float,
IsExpansion b radix L ->
forall p : float, Fbounded b p -> IsExpansion b radix (growExp p L).
intros L; elim L; simpl in |- *; auto.
intros H' p H'0.
apply IsExpansionSingle; auto.
intros a l H' H'0 p H'1; CaseEq (TwoSum p a); auto.
intros f f0 H'2.
cut (Fbounded b a);
[ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
auto.
case (is_FzeroP f0); intros Z1.
apply IsExpansionTop1; auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
apply H'; auto.
apply expInv with (a := a); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
apply IsExpansionCons; auto.
apply H'; auto.
apply expInv with (a := a); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
intros q H'3 H'4.
cut (IsExpansion b radix (f0 :: l)); [ intros IsE1 | idtac ].
case (IsExpansionGrowConsInvAux (f0 :: l) IsE1 l f0 q f); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
intros H'5 H'6.
case (is_FzeroP f); intros Z2; auto.
case H'6; auto.
intros H'7; apply Zlt_le_trans with (2 := H'7).
generalize (TwoSumExp p a H'1 Fba); rewrite H'2; simpl in |- *; intros IsE2;
inversion IsE2; auto.
case Z1; auto.
case Z2; auto.
apply IsExpansionCons; auto.
apply expInv with (a := a); auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
intros q0 H'5 H'6.
apply Zle_lt_trans with (MSB radix a).
apply MSB_monotone; auto.
Contradict Z1.
apply (is_Fzero_rep2 radix); auto.
replace f0 with (snd (TwoSum p a)); auto.
apply TwoSumOl2; auto.
rewrite H'2; auto.
repeat rewrite Fabs_correct; auto with arith.
replace f0 with (snd (TwoSum p a)); auto.
rewrite TwoSum2; auto.
replace (FtoR radix a) with (p + a - p)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
cut (forall x y : R, Rabs (x - y) = Rabs (y - x));
[ intros Re1; repeat rewrite (Re1 (p + a)%R)
| intros x y; rewrite <- (Ropp_minus_distr x); rewrite Rabs_Ropp; auto ].
case (TwoSum1 _ _ H'1 Fba); auto.
rewrite H'2; auto.
apply IsExpansionConsInv with (L := l); auto.
Contradict Z1.
apply (is_Fzero_rep2 radix); auto.
replace f0 with (snd (TwoSum p a)); auto.
apply TwoSumOl2; auto.
rewrite H'2; auto.
Qed.
Fixpoint addExp (L1 L2 : list float) {struct L1} :
list float :=
match L1 with
| nil => L2
| x :: L'1 =>
match growExp x L2 with
| nil => L'1
| y :: L'2 => y :: addExp L'1 L'2
end
end.
Theorem addExpIsVal :
forall L1 L2 : list float,
IsExpansion b radix L1 ->
IsExpansion b radix L2 ->
expValue radix (addExp L1 L2) = (expValue radix L1 + expValue radix L2)%R
:>R.
intros L1; elim L1; simpl in |- *; auto.
intros L2 HL1 HL2; replace (FtoRradix (Fzero 0)) with 0%R;
[ ring
| apply sym_eq; apply (is_Fzero_rep1 radix); red in |- *; simpl in |- * ];
auto.
intros a l Rec L2 HL1 HL2.
cut (Fbounded b a);
[ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (growExpIsVal L2 HL2 a Fba);
generalize (growExpIsExp L2 HL2 a Fba); case (growExp a L2);
simpl in |- *; auto.
intros H' H'0; rewrite (Fplus_correct radix); auto with zarith.
replace (FtoR radix a + FtoR radix (expValue radix l) + expValue radix L2)%R
with (a + expValue radix L2 + expValue radix l)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
rewrite <- H'0; auto.
replace (FtoRradix (Fzero 0)) with 0%R;
[ ring
| apply sym_eq; apply (is_Fzero_rep1 radix); red in |- *; simpl in |- * ];
auto.
intros f l0 H' H'0; repeat rewrite (Fplus_correct radix); auto with zarith.
rewrite Rec; auto.
replace (FtoR radix a + FtoR radix (expValue radix l) + expValue radix L2)%R
with (a + expValue radix L2 + expValue radix l)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
rewrite <- H'0; repeat rewrite (Fplus_correct radix); auto with zarith.
unfold FtoRradix in |- *; ring.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
Qed.
Theorem IsExpansionAddInv :
forall (L1 L2 : list float) (p q : float),
~ is_Fzero p ->
~ is_Fzero q ->
IsExpansion b radix (p :: L1) ->
IsExpansion b radix (p :: L2) ->
In q (addExp L1 L2) -> (MSB radix p < LSB radix q)%Z.
intros L1; elim L1; simpl in |- *; auto.
intros L2 p q H' H'0 H'1 H'2 H'3.
apply IsExpansionConsInv with (L := L2); auto.
intros a l H' L2 p q H'0 H'1 H'2 H'3; CaseEq (growExp a L2); simpl in |- *.
intros H'4 H'5.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
intros f l0 H'4 H'5; elim H'5; clear H'5; intros H'5;
[ rewrite <- H'5 | idtac ]; auto.
generalize H'3 H'4; case L2; simpl in |- *; auto.
intros H'6 H'7; inversion H'7.
rewrite <- H0; auto.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
rewrite H0; auto.
rewrite H'5; auto.
intros f0 l1 H'6; CaseEq (TwoSum a f0).
intros f1 f2 H'7 H'8; inversion H'8.
cut (~ is_Fzero a); [ intros Za | idtac ].
cut (~ is_Fzero f0); [ intros Zf0 | idtac ].
apply Zlt_le_trans with (Zmin (LSB radix a) (LSB radix f0)).
unfold Zmin in |- *; case (LSB radix a ?= LSB radix f0)%Z.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
apply IsExpansionConsInv with (L := f0 :: l1); auto with datatypes.
replace f with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
apply TwoSumLt2; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
rewrite H'7; simpl in |- *.
rewrite H0.
rewrite H'5; auto.
Contradict H'1.
rewrite <- H'5.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
apply (is_Fzero_rep2 radix); auto; apply TwoSumOl2;
auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
Contradict H'1.
rewrite <- H'5.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
apply (is_Fzero_rep2 radix); auto; apply TwoSumOr2;
auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
apply (H' l0); auto.
apply IsExpansionSkip with (q := a); auto.
apply IsExpansionCons; auto.
apply expInv with (a := f); auto.
rewrite <- H'4.
apply growExpIsExp; auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := L2); auto.
intros q0 H'6 H'7.
case (IsExpansionGrowConsInvAux (p :: L2) H'3 L2 p q0 a); auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
rewrite H'4; auto with datatypes.
intros H'8 H'9; case (is_FzeroP a); auto.
intros H'10; case H'9; auto.
intros H'11; apply Zlt_le_trans with (2 := H'11); auto.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
Qed.
Theorem addExpIsExp :
forall L1 L2 : list float,
IsExpansion b radix L1 ->
IsExpansion b radix L2 -> IsExpansion b radix (addExp L1 L2).
intros L1; elim L1; simpl in |- *; auto.
intros a l Rec L2 HL1 HL2.
cut (Fbounded b a);
[ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (growExpIsVal L2 HL2 a Fba);
generalize (growExpIsExp L2 HL2 a Fba); CaseEq (growExp a L2);
simpl in |- *; auto.
intros H' H'0 H'1.
apply expInv with (a := a); auto.
intros f l0 H' H'0 H'1.
case (is_FzeroP f); intros Z1; auto.
apply IsExpansionTop1; auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
apply Rec; auto.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
apply IsExpansionCons; auto.
apply Rec; auto.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
intros q H'2 H'3.
apply IsExpansionAddInv with (L1 := l) (L2 := l0); auto.
generalize H' HL2; case L2; simpl in |- *; auto.
intros H'4; inversion H'4; auto.
rewrite <- H0; auto.
intros f0 l1; CaseEq (TwoSum a f0).
intros f1 f2 H'4 H'5; inversion H'5.
intros H'6.
cut (~ is_Fzero a); [ intros Z2 | idtac ].
apply IsExpansionCons; auto.
apply expInv with (a := a); auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
intros q0 H'7 H'8.
apply Zle_lt_trans with (MSB radix a).
apply MSB_monotone; auto.
rewrite <- H0; auto.
repeat rewrite (Fabs_correct radix); auto with arith.
replace (FtoR radix f2) with (FtoRradix (snd (TwoSum a f0)));
[ idtac | rewrite H'4; auto ].
rewrite TwoSum2; auto.
replace (FtoR radix a) with (a + f0 - f0)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
cut (forall x y z : R, Rabs (x + y - z) = Rabs (z - (x + y)));
[ intros Ra1; repeat rewrite Ra1
| intros; rewrite <- Ropp_minus_distr; rewrite Rabs_Ropp ];
auto.
case (TwoSum1 a f0); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
intros H'9 H'10; apply H'10; auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply IsExpansionConsInv with (L := l); auto.
Contradict Z1.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)).
apply (is_Fzero_rep2 radix); auto.
apply TwoSumOr2; auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
rewrite H'4; auto.
Qed.
End mf.
Section mf.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Coercion Local FtoRradix := FtoR radix.
Variable b : Fbound.
Variable precision : nat.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
Variable TwoSum : float -> float -> float * float.
Hypothesis
TwoSum1 :
forall p q : float,
Fbounded b p ->
Fbounded b q -> Closest b radix (p + q) (fst (TwoSum p q)).
Hypothesis
TwoSum2 :
forall p q : float,
Fbounded b p ->
Fbounded b q -> snd (TwoSum p q) = (p + q - fst (TwoSum p q))%R :>R.
Hypothesis
TwoSum3 :
forall p q : float,
Fbounded b p -> Fbounded b q -> Fbounded b (fst (TwoSum p q)).
Hypothesis
TwoSum4 :
forall p q : float,
Fbounded b p -> Fbounded b q -> Fbounded b (snd (TwoSum p q)).
Hypothesis
TwoSumEq1 :
forall p q r s : float,
Fbounded b p ->
Fbounded b q ->
Fbounded b r ->
Fbounded b s ->
p = q :>R -> r = s :>R -> fst (TwoSum p r) = fst (TwoSum q s) :>R.
Hypothesis
TwoSumEq2 :
forall p q r s : float,
Fbounded b p ->
Fbounded b q ->
Fbounded b r ->
Fbounded b s ->
p = q :>R -> r = s :>R -> snd (TwoSum p r) = snd (TwoSum q s) :>R.
Fixpoint growExp (p : float) (L : list float) {struct L} :
list float :=
match L with
| nil => p :: nil
| x :: L1 => match TwoSum p x with
| (h, c) => c :: growExp h L1
end
end.
Theorem TwoSumExp :
forall p q : float,
Fbounded b p ->
Fbounded b q ->
IsExpansion b radix (snd (TwoSum p q) :: fst (TwoSum p q) :: nil).
intros p q H' H'0.
case (Z_zerop (Fnum (snd (TwoSum p q)))); intros Z1.
apply IsExpansionTop1; auto.
apply IsExpansionSingle; auto.
case (Z_zerop (Fnum (fst (TwoSum p q)))); intros Z2.
apply IsExpansionTop2; auto.
apply IsExpansionSingle; auto.
apply IsExpansionTop; auto.
cut
(snd (TwoSum p q) = Fminus radix (Fplus radix p q) (fst (TwoSum p q)) :>R);
[ intros Eq1 | idtac ].
rewrite (MSB_comp radix) with (4 := Eq1); auto.
apply (MSBroundLSB b radix precision) with (P := Closest b radix); auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix (p + q)%R) with (p0 := fst (TwoSum p q));
auto.
apply sym_eq; apply (Fplus_correct radix); auto with arith.
apply NisFzeroComp with (radix := radix) (x := snd (TwoSum p q)); auto.
rewrite (Fminus_correct radix); auto with arith;
rewrite (Fplus_correct radix); auto with arith.
apply IsExpansionSingle; auto.
Qed.
Theorem TwoSumOl1 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero q -> fst (TwoSum p q) = p :>R.
intros p q H' H'0 H'1; generalize (TwoSum1 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f H'2 H'3.
apply sym_eq;
apply
(RoundedModeProjectorIdemEq b radix precision) with (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := H'3); auto.
replace (FtoRradix q) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
Qed.
Theorem TwoSumOl2 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero q -> snd (TwoSum p q) = 0%R :>R.
intros p q H' H'0 H'1; generalize (TwoSumOl1 p q H' H'0 H'1);
generalize (TwoSum2 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f f0 H'2 H'3.
rewrite H'2.
rewrite H'3.
replace (FtoRradix q) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
Qed.
Theorem TwoSumOr1 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero p -> fst (TwoSum p q) = q :>R.
intros p q H' H'0 H'1; generalize (TwoSum1 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f H'2 H'3.
apply sym_eq;
apply
(RoundedModeProjectorIdemEq b radix precision) with (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := H'3); auto.
replace (FtoRradix p) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
apply
RoundedModeBounded
with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
Qed.
Theorem TwoSumOr2 :
forall p q : float,
Fbounded b p -> Fbounded b q -> is_Fzero p -> snd (TwoSum p q) = 0%R :>R.
intros p q H' H'0 H'1; generalize (TwoSumOr1 p q H' H'0 H'1);
generalize (TwoSum2 p q H' H'0); case (TwoSum p q);
simpl in |- *; auto.
intros f f0 H'2 H'3.
rewrite H'2.
rewrite H'3.
replace (FtoRradix p) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
Qed.
Theorem growExpIsVal :
forall L : list float,
IsExpansion b radix L ->
forall p : float,
Fbounded b p -> expValue radix (growExp p L) = (p + expValue radix L)%R :>R.
intros L; elim L.
simpl in |- *; auto.
intros H' p H'0; rewrite (Fplus_correct radix); auto with arith.
intros a l H' H'0 p H'1; simpl in |- *.
CaseEq (TwoSum p a).
intros f f0 H'2; simpl in |- *.
repeat rewrite (Fplus_correct radix); auto with arith.
rewrite H'.
repeat rewrite <- Rplus_assoc.
cut (Fbounded b a);
[ intros Fb1 | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (TwoSum2 _ _ H'1 Fb1); rewrite H'2; simpl in |- *.
unfold FtoRradix in |- *; intros H'3; rewrite H'3; ring; ring.
apply expInv with (a := a); auto.
cut (Fbounded b a);
[ intros Fb1 | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (TwoSum3 _ _ H'1 Fb1); rewrite H'2; simpl in |- *; auto.
Qed.
Theorem IsExpansionCons :
forall L : list float,
IsExpansion b radix L ->
forall p : float,
~ is_Fzero p ->
Fbounded b p ->
(forall q : float, In q L -> ~ is_Fzero q -> (MSB radix p < LSB radix q)%Z) ->
IsExpansion b radix (p :: L).
intros L; elim L.
intros H' p H'0 H'1 H'2; apply IsExpansionSingle; auto.
intros a l H' H'0 p H'1 H'2 H'3.
case (is_FzeroP a); intros Z1.
apply IsExpansionTop2; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply H'; auto.
apply expInv with (a := a); auto.
intros q H'4 H'5; apply H'3; auto.
simpl in |- *; auto.
apply IsExpansionTop; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply H'3; auto with datatypes.
Qed.
Theorem IsExpansionConsInvAux :
forall L : list float,
IsExpansion b radix L ->
forall (L' : list float) (p q : float),
~ is_Fzero p ->
L = p :: L' -> In q L' -> ~ is_Fzero q -> (MSB radix p < LSB radix q)%Z.
intros L H'; elim H'; auto.
intros L' p q H'0 H'1; discriminate.
intros x H'0 L' p q H'1 H'2; inversion H'2; simpl in |- *.
intros H'3; elim H'3.
intros x L0 H'0 H'1 H'2 H'3 L' p q H'4 H'5; inversion H'5; auto.
case H'4; rewrite <- H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 L' p q H'5 H'6; inversion H'6.
simpl in |- *; auto.
intros H'7 H'8; case H'7; intros H'9.
case H'8; rewrite <- H'9; auto.
apply H'4 with (L' := L0); auto.
rewrite H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 L' p q H'7 H'8; inversion H'8; auto.
simpl in |- *; auto.
intros H'9 H'10; case H'9; intros H'11.
rewrite <- H'11; rewrite <- H0; auto.
apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
apply H'6 with (L' := L0); auto.
Qed.
Theorem IsExpansionConsInv :
forall (L : list float) (p q : float),
~ is_Fzero p ->
IsExpansion b radix (p :: L) ->
In q L -> ~ is_Fzero q -> (MSB radix p < LSB radix q)%Z.
intros L p q H' H'0 H'1 H'2.
apply IsExpansionConsInvAux with (L := p :: L) (L' := L); auto.
Qed.
Theorem IsExpansionSkip :
forall (L : list float) (p q : float),
IsExpansion b radix (p :: q :: L) -> IsExpansion b radix (p :: L).
intros L p q H'.
case (is_FzeroP p); intros Z1.
apply IsExpansionTop1; auto.
apply expBoundedInv with (radix := radix) (L := q :: L); auto.
apply expInv with (a := q); auto.
apply expInv with (a := p); auto.
apply IsExpansionCons; auto.
apply expInv with (a := q); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := q :: L); auto.
intros q0 H'0 H'1.
apply IsExpansionConsInv with (L := q :: L); auto with datatypes.
Qed.
Theorem TwoSumLt1 :
forall p q : float,
Fbounded b p ->
Fbounded b q ->
~ is_Fzero p ->
~ is_Fzero q ->
~ is_Fzero (fst (TwoSum p q)) ->
(Zmin (LSB radix p) (LSB radix q) <= LSB radix (fst (TwoSum p q)))%Z.
intros p q H'0 H'1 H'2 H'3 H'4.
apply Zle_trans with (LSB radix (Fplus radix p q)); auto.
case (LSB_rep_min radix radixMoreThanOne p); auto; intros p' Hp'.
case (LSB_rep_min radix radixMoreThanOne q); auto; intros q' Hq'.
apply LSBPlus; auto.
Contradict H'4; auto.
apply (is_Fzero_rep2 radix); auto.
rewrite <- (FzeroisZero radix b); auto.
apply sym_eq;
apply
RoundedModeProjectorIdemEq
with (b := b) (precision := precision) (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply FboundedFzero; auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H'0 H'1); auto.
rewrite (FzeroisZero radix b); auto.
replace 0%R with (FtoRradix (Fplus radix p q)); auto.
rewrite (Fplus_correct radix); auto with arith.
apply (is_Fzero_rep1 radix); auto.
repeat rewrite (Fplus_correct radix); auto with arith.
apply
RoundLSBMax with (b := b) (precision := precision) (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H'0 H'1); auto.
rewrite Fplus_correct; auto with arith.
Qed.
Theorem TwoSumLt2 :
forall p q : float,
Fbounded b p ->
Fbounded b q ->
~ is_Fzero p ->
~ is_Fzero q ->
~ is_Fzero (snd (TwoSum p q)) ->
(Zmin (LSB radix p) (LSB radix q) <= LSB radix (snd (TwoSum p q)))%Z.
intros p q H' H'0 H'1 H'2 H'3.
case (is_FzeroP (fst (TwoSum p q))); intros Z1.
cut (snd (TwoSum p q) = Fplus radix p q :>R); [ intros Eq1 | idtac ].
replace (LSB radix (snd (TwoSum p q))) with (LSB radix (Fplus radix p q));
auto.
apply LSBPlus; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
apply LSB_comp; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
rewrite TwoSum2; auto.
unfold FtoRradix in |- *; rewrite (is_Fzero_rep1 radix) with (1 := Z1); auto.
rewrite Fplus_correct; auto with arith; ring.
cut
(snd (TwoSum p q) = Fminus radix (Fplus radix p q) (fst (TwoSum p q)) :>R);
[ intros Eq1 | idtac ].
replace (LSB radix (snd (TwoSum p q))) with
(LSB radix (Fminus radix (Fplus radix p q) (fst (TwoSum p q)))).
apply
Zle_trans
with (Zmin (LSB radix (Fplus radix p q)) (LSB radix (fst (TwoSum p q))));
auto.
apply Zmin_Zle; auto.
apply LSBPlus; auto.
Contradict Z1; auto.
apply (is_Fzero_rep2 radix); auto.
rewrite <- (FzeroisZero radix b); auto.
apply sym_eq;
apply
RoundedModeProjectorIdemEq
with (b := b) (precision := precision) (P := Closest b radix);
auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply FboundedFzero; auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H' H'0); auto.
rewrite (FzeroisZero radix b); auto.
replace 0%R with (FtoRradix (Fplus radix p q)); auto.
rewrite (Fplus_correct radix); auto with arith.
apply (is_Fzero_rep1 radix); auto.
apply TwoSumLt1; auto.
apply LSBMinus; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
apply LSB_comp; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
rewrite TwoSum2; auto.
rewrite (Fminus_correct radix); auto with arith;
rewrite (Fplus_correct radix); auto with arith.
Qed.
Theorem IsExpansionGrowConsInvAux :
forall L : list float,
IsExpansion b radix L ->
forall (L' : list float) (p q r : float),
Fbounded b r ->
~ is_Fzero p ->
L = p :: L' ->
In q (growExp r L') ->
~ is_Fzero q ->
(is_Fzero r -> (MSB radix p < LSB radix q)%Z) /\
(~ is_Fzero r ->
(MSB radix p < LSB radix q)%Z \/ (LSB radix r <= LSB radix q)%Z).
intros L H'; elim H'; simpl in |- *; auto.
intros L' p q r H'0 H'1 H'2; discriminate.
intros x H'0 L' p q r H'1 H'2 H'3; inversion H'3; simpl in |- *; auto.
intros H'4 H'5; split; case H'4.
intros H'6 H'7; case H'5; rewrite <- H'6; auto.
intros H'6; elim H'6; auto.
intros H'6; rewrite <- H'6; auto with zarith.
intros H'6; elim H'6.
intros x L0 H'0 H'1 H'2 H'3 L' p q r H'4 H'5 H'6; inversion H'6; auto.
case H'5; rewrite <- H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 L' p q r H'5 H'6 H'7; inversion H'7.
simpl in |- *.
CaseEq (TwoSum r y); simpl in |- *; auto.
intros f f0 H'8 H'9; elim H'9; intros H'10.
intros H'11; case H'11; rewrite <- H'10.
apply (is_Fzero_rep2 radix); auto.
replace (FtoR radix f0) with (FtoRradix (snd (TwoSum r y))); auto.
apply TwoSumOl2; auto.
rewrite H'8; auto.
split.
intros H'11.
case (H'4 L0 p q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'8; auto.
rewrite <- H0; auto.
intros H'12 H'13; apply H'12; auto.
replace f with (fst (TwoSum r y)); auto.
apply (is_Fzero_rep2 radix); auto.
replace 0%R with (FtoRradix r).
apply TwoSumOl1; auto.
apply (is_Fzero_rep1 radix); auto.
rewrite H'8; auto.
intros H'11.
case (H'4 L0 p q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'8; auto.
rewrite <- H0; auto.
intros H'13 H'14.
case (is_FzeroP f); intros Z1; auto.
replace (LSB radix r) with (LSB radix f); auto.
apply LSB_comp; auto.
replace f with (fst (TwoSum r y)); auto.
apply TwoSumOl1; auto.
rewrite H'8; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 L' p q r H'7 H'8 H'9; inversion H'9.
simpl in |- *; auto.
CaseEq (TwoSum r y); simpl in |- *; auto.
intros f f0 H'10 H'11; case H'11; intros H'12.
rewrite <- H'12; auto.
intros H'13; split; auto.
intros H'14; case H'13.
replace f0 with (snd (TwoSum r y)); auto.
apply (is_Fzero_rep2 radix); auto.
apply TwoSumOr2; auto.
rewrite H'10; auto.
intros H'14.
cut (Zmin (LSB radix r) (LSB radix y) <= LSB radix (snd (TwoSum r y)))%Z.
rewrite H'10; simpl in |- *; auto.
unfold Zmin in |- *; case (LSB radix r ?= LSB radix y)%Z; auto.
intros H'15; left; apply Zlt_le_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply TwoSumLt2; auto.
rewrite H'10; auto.
intros H'13.
case (H'6 L0 y q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'10; auto.
intros H'14 H'15; split.
intros H'16.
case H'15; auto.
apply (NisFzeroComp radix) with (2 := H'1); auto.
replace f with (fst (TwoSum r y)); auto.
apply sym_eq; apply TwoSumOr1; auto.
rewrite H'10; auto.
intros H'17; apply Zlt_trans with (LSB radix y).
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
intros H'17; apply Zlt_le_trans with (LSB radix y).
rewrite <- H0; auto.
replace (LSB radix y) with (LSB radix f); auto.
apply sym_equal; apply LSB_comp; auto.
replace f with (fst (TwoSum r y)); auto.
apply sym_eq; apply TwoSumOr1; auto.
rewrite H'10; auto.
intros H'16; case (is_FzeroP f); intros Z1.
left; apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
case H'15; auto; intros H'17.
left; apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
cut (Zmin (LSB radix r) (LSB radix y) <= LSB radix (fst (TwoSum r y)))%Z.
rewrite H'10; simpl in |- *; auto.
unfold Zmin in |- *; case (LSB radix r ?= LSB radix y)%Z; auto.
intros H'18; right; apply Zle_trans with (1 := H'18); auto.
intros H'18; right; apply Zle_trans with (1 := H'18); auto.
intros H'18; left; apply Zlt_le_trans with (LSB radix y).
rewrite <- H0; auto.
apply Zle_trans with (1 := H'18); auto.
apply TwoSumLt1; auto.
rewrite H'10; auto.
Qed.
Theorem growExpIsExp :
forall L : list float,
IsExpansion b radix L ->
forall p : float, Fbounded b p -> IsExpansion b radix (growExp p L).
intros L; elim L; simpl in |- *; auto.
intros H' p H'0.
apply IsExpansionSingle; auto.
intros a l H' H'0 p H'1; CaseEq (TwoSum p a); auto.
intros f f0 H'2.
cut (Fbounded b a);
[ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
auto.
case (is_FzeroP f0); intros Z1.
apply IsExpansionTop1; auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
apply H'; auto.
apply expInv with (a := a); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
apply IsExpansionCons; auto.
apply H'; auto.
apply expInv with (a := a); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
intros q H'3 H'4.
cut (IsExpansion b radix (f0 :: l)); [ intros IsE1 | idtac ].
case (IsExpansionGrowConsInvAux (f0 :: l) IsE1 l f0 q f); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
intros H'5 H'6.
case (is_FzeroP f); intros Z2; auto.
case H'6; auto.
intros H'7; apply Zlt_le_trans with (2 := H'7).
generalize (TwoSumExp p a H'1 Fba); rewrite H'2; simpl in |- *; intros IsE2;
inversion IsE2; auto.
case Z1; auto.
case Z2; auto.
apply IsExpansionCons; auto.
apply expInv with (a := a); auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
intros q0 H'5 H'6.
apply Zle_lt_trans with (MSB radix a).
apply MSB_monotone; auto.
Contradict Z1.
apply (is_Fzero_rep2 radix); auto.
replace f0 with (snd (TwoSum p a)); auto.
apply TwoSumOl2; auto.
rewrite H'2; auto.
repeat rewrite Fabs_correct; auto with arith.
replace f0 with (snd (TwoSum p a)); auto.
rewrite TwoSum2; auto.
replace (FtoR radix a) with (p + a - p)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
cut (forall x y : R, Rabs (x - y) = Rabs (y - x));
[ intros Re1; repeat rewrite (Re1 (p + a)%R)
| intros x y; rewrite <- (Ropp_minus_distr x); rewrite Rabs_Ropp; auto ].
case (TwoSum1 _ _ H'1 Fba); auto.
rewrite H'2; auto.
apply IsExpansionConsInv with (L := l); auto.
Contradict Z1.
apply (is_Fzero_rep2 radix); auto.
replace f0 with (snd (TwoSum p a)); auto.
apply TwoSumOl2; auto.
rewrite H'2; auto.
Qed.
Fixpoint addExp (L1 L2 : list float) {struct L1} :
list float :=
match L1 with
| nil => L2
| x :: L'1 =>
match growExp x L2 with
| nil => L'1
| y :: L'2 => y :: addExp L'1 L'2
end
end.
Theorem addExpIsVal :
forall L1 L2 : list float,
IsExpansion b radix L1 ->
IsExpansion b radix L2 ->
expValue radix (addExp L1 L2) = (expValue radix L1 + expValue radix L2)%R
:>R.
intros L1; elim L1; simpl in |- *; auto.
intros L2 HL1 HL2; replace (FtoRradix (Fzero 0)) with 0%R;
[ ring
| apply sym_eq; apply (is_Fzero_rep1 radix); red in |- *; simpl in |- * ];
auto.
intros a l Rec L2 HL1 HL2.
cut (Fbounded b a);
[ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (growExpIsVal L2 HL2 a Fba);
generalize (growExpIsExp L2 HL2 a Fba); case (growExp a L2);
simpl in |- *; auto.
intros H' H'0; rewrite (Fplus_correct radix); auto with zarith.
replace (FtoR radix a + FtoR radix (expValue radix l) + expValue radix L2)%R
with (a + expValue radix L2 + expValue radix l)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
rewrite <- H'0; auto.
replace (FtoRradix (Fzero 0)) with 0%R;
[ ring
| apply sym_eq; apply (is_Fzero_rep1 radix); red in |- *; simpl in |- * ];
auto.
intros f l0 H' H'0; repeat rewrite (Fplus_correct radix); auto with zarith.
rewrite Rec; auto.
replace (FtoR radix a + FtoR radix (expValue radix l) + expValue radix L2)%R
with (a + expValue radix L2 + expValue radix l)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
rewrite <- H'0; repeat rewrite (Fplus_correct radix); auto with zarith.
unfold FtoRradix in |- *; ring.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
Qed.
Theorem IsExpansionAddInv :
forall (L1 L2 : list float) (p q : float),
~ is_Fzero p ->
~ is_Fzero q ->
IsExpansion b radix (p :: L1) ->
IsExpansion b radix (p :: L2) ->
In q (addExp L1 L2) -> (MSB radix p < LSB radix q)%Z.
intros L1; elim L1; simpl in |- *; auto.
intros L2 p q H' H'0 H'1 H'2 H'3.
apply IsExpansionConsInv with (L := L2); auto.
intros a l H' L2 p q H'0 H'1 H'2 H'3; CaseEq (growExp a L2); simpl in |- *.
intros H'4 H'5.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
intros f l0 H'4 H'5; elim H'5; clear H'5; intros H'5;
[ rewrite <- H'5 | idtac ]; auto.
generalize H'3 H'4; case L2; simpl in |- *; auto.
intros H'6 H'7; inversion H'7.
rewrite <- H0; auto.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
rewrite H0; auto.
rewrite H'5; auto.
intros f0 l1 H'6; CaseEq (TwoSum a f0).
intros f1 f2 H'7 H'8; inversion H'8.
cut (~ is_Fzero a); [ intros Za | idtac ].
cut (~ is_Fzero f0); [ intros Zf0 | idtac ].
apply Zlt_le_trans with (Zmin (LSB radix a) (LSB radix f0)).
unfold Zmin in |- *; case (LSB radix a ?= LSB radix f0)%Z.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
apply IsExpansionConsInv with (L := f0 :: l1); auto with datatypes.
replace f with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
apply TwoSumLt2; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
rewrite H'7; simpl in |- *.
rewrite H0.
rewrite H'5; auto.
Contradict H'1.
rewrite <- H'5.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
apply (is_Fzero_rep2 radix); auto; apply TwoSumOl2;
auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
Contradict H'1.
rewrite <- H'5.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
apply (is_Fzero_rep2 radix); auto; apply TwoSumOr2;
auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
apply (H' l0); auto.
apply IsExpansionSkip with (q := a); auto.
apply IsExpansionCons; auto.
apply expInv with (a := f); auto.
rewrite <- H'4.
apply growExpIsExp; auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := L2); auto.
intros q0 H'6 H'7.
case (IsExpansionGrowConsInvAux (p :: L2) H'3 L2 p q0 a); auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
rewrite H'4; auto with datatypes.
intros H'8 H'9; case (is_FzeroP a); auto.
intros H'10; case H'9; auto.
intros H'11; apply Zlt_le_trans with (2 := H'11); auto.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
Qed.
Theorem addExpIsExp :
forall L1 L2 : list float,
IsExpansion b radix L1 ->
IsExpansion b radix L2 -> IsExpansion b radix (addExp L1 L2).
intros L1; elim L1; simpl in |- *; auto.
intros a l Rec L2 HL1 HL2.
cut (Fbounded b a);
[ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
auto.
generalize (growExpIsVal L2 HL2 a Fba);
generalize (growExpIsExp L2 HL2 a Fba); CaseEq (growExp a L2);
simpl in |- *; auto.
intros H' H'0 H'1.
apply expInv with (a := a); auto.
intros f l0 H' H'0 H'1.
case (is_FzeroP f); intros Z1; auto.
apply IsExpansionTop1; auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
apply Rec; auto.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
apply IsExpansionCons; auto.
apply Rec; auto.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
intros q H'2 H'3.
apply IsExpansionAddInv with (L1 := l) (L2 := l0); auto.
generalize H' HL2; case L2; simpl in |- *; auto.
intros H'4; inversion H'4; auto.
rewrite <- H0; auto.
intros f0 l1; CaseEq (TwoSum a f0).
intros f1 f2 H'4 H'5; inversion H'5.
intros H'6.
cut (~ is_Fzero a); [ intros Z2 | idtac ].
apply IsExpansionCons; auto.
apply expInv with (a := a); auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
intros q0 H'7 H'8.
apply Zle_lt_trans with (MSB radix a).
apply MSB_monotone; auto.
rewrite <- H0; auto.
repeat rewrite (Fabs_correct radix); auto with arith.
replace (FtoR radix f2) with (FtoRradix (snd (TwoSum a f0)));
[ idtac | rewrite H'4; auto ].
rewrite TwoSum2; auto.
replace (FtoR radix a) with (a + f0 - f0)%R;
[ idtac | unfold FtoRradix in |- *; ring ].
cut (forall x y z : R, Rabs (x + y - z) = Rabs (z - (x + y)));
[ intros Ra1; repeat rewrite Ra1
| intros; rewrite <- Ropp_minus_distr; rewrite Rabs_Ropp ];
auto.
case (TwoSum1 a f0); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
intros H'9 H'10; apply H'10; auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply IsExpansionConsInv with (L := l); auto.
Contradict Z1.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)).
apply (is_Fzero_rep2 radix); auto.
apply TwoSumOr2; auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
rewrite H'4; auto.
Qed.
End mf.