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.
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.
intros p q H' H'0 H'1.
rewrite
(FcanonicUnique _ radixMoreThanOne b precision) with (p := p) (q := q);
auto with arith.
Qed.
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.
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.
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.